Scid  4.7.0
email.tcl
Go to the documentation of this file.
1 ###
2 ### tools/email.tcl: part of Scid.
3 ### Copyright (C) 1999-2003 Shane Hudson.
4 ###
5 
6 # Email manager window: closed by default
7 set emailWin 0
8 
9 
10 # ::tools::email
11 #
12 # Opens the email chess manager window, for sending moves to opponents.
13 #
14 proc ::tools::email {} {
15  global emailWin emailData
16  set w .emailWin
17  if {[winfo exists $w]} {
18  destroy .emailWin
19  set emailWin 0
20  return
21  }
22  set emailWin 1
24  wm title $w "Scid: Email Manager"
25  wm minsize $w 25 10
26 
27  bind $w <Destroy> { set .emailWin 0 }
28  bind $w <F1> { helpWindow Email }
29 
30  ttk::frame $w.f
31  ttk::frame $w.b
32  pack $w.f -side left -fill y
33  pack $w.b -side right -fill y
34 
35  set f $w.f
36  ttk::label $f.title -text "Opponent list" -font font_Bold
37  listbox $f.list -height 16 -width 40 -exportselection false \
38  -selectmode browse -selectbackground lightBlue -font font_Fixed \
39  -yscrollcommand "$f.scroll set" -background white -setgrid 1
40  ttk::scrollbar $f.scroll -command "$w.list yview" -takefocus 0
41  pack $f -side left -expand true -fill both
42  pack $f.title -side top
43  pack $f.scroll -side right -fill y
44  pack $f.list -side right -expand true -fill both
45 
46  bind $f.list <ButtonRelease-1> ::tools::email::refreshButtons
47  bind $f.list <Enter> ::tools::email::refreshButtons
48  bind $f.list <Key-Up> ::tools::email::refreshButtons
49  bind $f.list <Key-Down> ::tools::email::refreshButtons
50 
51  bind $f.list <Key-a> {.emailWin.b.add invoke}
52  bind $f.list <Key-e> {.emailWin.b.edit invoke}
53  bind $f.list <Key-d> {.emailWin.b.delete invoke}
54  bind $f.list <Key-l> {.emailWin.b.load invoke}
55  bind $f.list <Key-s> {.emailWin.b.send invoke}
56  bind $f.list <Key-t> {.emailWin.b.time.m post [winfo pointerx .] [winfo pointery .]}
57 
58  set b .emailWin.b
59 
60  ttk::button $b.add -text "Add..." -underline 0 -command {
61  set idx [llength $emailData]
62  lappend emailData [list "" "" "" "" ""]
63  modifyEmailDetails $idx
64  ::tools::email::refresh
65  }
66 
67  ttk::button $b.edit -text [tr Edit] -underline 0 -command ::tools::email::EditButton
68  ttk::button $b.delete -text "$::tr(Delete)..." -underline 0 -command ::tools::email::DeleteButton
69  ttk::button $b.load -text $::tr(LoadGame) -underline 0 -command ::tools::email::LoadButton
70  ttk::button $b.send -text "Send email..." -underline 0 -command ::tools::email::SendButton
71  ttk::menubutton $b.time -text $::tr(Time) -menu $b.time.m
72  menu $b.time.m
73  $b.time.m add command -label "Received today" -underline 0 \
74  -command {::tools::email::TimesButton r}
75  $b.time.m add command -label "Sent today" -underline 0 \
76  -command {::tools::email::TimesButton s}
77  $b.time.m add command -label [tr Edit] -underline 0 \
78  -command {::tools::email::TimesButton e}
79 
80  ttk::button $b.config -text "$::tr(GlistEditField)..." -command ::tools::email::config
81  ttk::button $b.help -text $::tr(Help) -command { helpWindow Email }
82  ttk::button $b.close -text $::tr(Close) -command { destroy .emailWin }
83  pack $b.add $b.edit $b.delete $b.load $b.send $b.time \
84  -side top -pady 2 -padx "10 0" -fill x
85  pack $b.close $b.help $b.config -side bottom -pady 2 -padx "10 0" -fill x
86 
87  bind $w <Destroy> { set emailWin 0 }
88  set emailData [::tools::email::readOpponentFile]
89  focus $w.f.list
91 }
92 
93 proc ::tools::email::config {} {
94  global email
95  set w .emailConfig
97  wm title $w "Scid"
98  ttk::labelframe $w.use -text "Send email using"
99  ttk::frame $w.smtp
100  ttk::radiobutton $w.smtp.b -text "SMTP server:" -variable email(smtp) -value 1
101  ttk::entry $w.smtp.s -width 30 -textvar email(server)
102  ttk::frame $w.sm
103  ttk::radiobutton $w.sm.b -text "sendmail process:" -variable email(smtp) -value 0
104  ttk::entry $w.sm.s -width 30 -textvar email(smproc)
105  pack $w.use -side top -fill x
106  pack $w.smtp $w.sm -side top -anchor e -in $w.use
107  pack $w.smtp.s $w.smtp.b -side right
108  pack $w.sm.s $w.sm.b -side right
109 
110  ttk::labelframe $w.addr -text "Email address fields"
111  ttk::frame $w.from
112  ttk::label $w.from.lab -text "From:"
113  ttk::entry $w.from.e -textvar email(from) -width 30
114  ttk::frame $w.bcc
115  ttk::label $w.bcc.lab -text "Bcc:"
116  ttk::entry $w.bcc.e -textvar email(bcc) -width 30
117  pack $w.addr -side top -fill x -pady "10 0"
118  pack $w.from $w.bcc -side top -fill x -in $w.addr
119  pack $w.from.e $w.from.lab -side right
120  pack $w.bcc.e $w.bcc.lab -side right
121 
122  pack [ttk::frame $w.b] -side top -fill x
123  ttk::button $w.b.ok -text [tr OptionsSave] -command {
124  options.write
125  catch {grab release .emailConfig}
126  destroy .emailConfig
127  }
128  ttk::button $w.b.cancel -text $::tr(Cancel) \
129  -command "catch {grab release $w}; destroy $w"
130  packdlgbuttons $w.b.cancel $w.b.ok
131  wm resizable $w 1 0
132  catch {grab $w}
133 }
134 
135 proc ::tools::email::EditButton {} {
136  global emailData
137  set sel [.emailWin.f.list curselection]
138  if {[llength $sel] == 1} {
139  set idx [lindex $sel 0]
140  if {[llength $emailData] > $idx} {
141  modifyEmailDetails $idx
142  }
143  }
145 }
146 
147 proc ::tools::email::DeleteButton {} {
148  global emailData
149  set sel [.emailWin.f.list curselection]
150  if {[llength $sel] != 1} { return}
151  set idx [lindex $sel 0]
152  if {[llength $emailData] <= $idx} { return}
153  set confirm [tk_messageBox -icon question -type yesno -default yes \
154  -parent .emailWin -title "Really delete opponent?" \
155  -message "Do you really want to delete this opponent?"]
156  if {$confirm == "yes"} {
157  set emailData [lreplace $emailData $idx $idx]
160  }
161 }
162 
163 proc ::tools::email::LoadButton {} {
164  global emailData
165  set sel [.emailWin.f.list curselection]
166  if {[llength $sel] != 1} { return}
167  set idx [lindex $sel 0]
168  if {[llength $emailData] <= $idx} { return}
169  set details [lindex $emailData $idx]
170  if {[llength [lindex $details 3]] > 0} {
171  if {[catch {::game::Load [lindex [lindex $details 3] 0]} result]} {
172  tk_messageBox -type ok -icon warning -title "Scid" -message $result
173  } else {
174  sc_move end
175  }
176  }
177 }
178 
179 proc ::tools::email::SendButton {} {
180  global emailData
181  set sel [.emailWin.f.list curselection]
182  if {[llength $sel] != 1} { return}
183  set idx [lindex $sel 0]
184  if {[llength $emailData] <= $idx} { return}
185  set details [lindex $emailData $idx]
186  emailMessageEditor $idx [lindex $details 0] [lindex $details 1] \
187  [lindex $details 2] [lindex $details 3] [lindex $details 4]
188 }
189 
190 set emailTimesIdx 0
191 
192 proc ::tools::email::TimesButton {type} {
193  global emailData emailTimesIdx
194  set sel [.emailWin.f.list curselection]
195  if {[llength $sel] != 1} { return}
196  set idx [lindex $sel 0]
197  if {[llength $emailData] <= $idx} { return}
198  set details [lindex $emailData $idx]
199  while {[llength $details] < 6} { lappend details {}}
200  set timeList [lindex $details 5]
201  set last [lindex $timeList end]
202 
203  if {$type == "r" || $type == "s"} {
205  return
206  }
207 
208  set emailTimesIdx $idx
209  set w .emailTimesWin
210  if {[winfo exists $w]} { return}
212  wm title $w "Scid: Email Times"
213  ttk::label $w.title -text "Email Times for [lindex $details 0]"
214  ttk::frame $w.t
215  text $w.t.text -height 15 -width 30 -font font_Fixed -setgrid 1 \
216  -yscrollcommand "$w.t.ybar set" -bg white -fg black
217  ttk::scrollbar $w.t.ybar -command "$w.t.text yview"
218  ttk::frame $w.b
219  ttk::button $w.b.ok -text "OK" -command {
220  set details [lindex $emailData $emailTimesIdx]
221  set timeList [split [string trim [.emailTimesWin.t.text get 1.0 end]] "\n"]
222  set details [lreplace $details 5 5 $timeList]
223  set emailData [lreplace $emailData $emailTimesIdx $emailTimesIdx $details]
224  ::tools::email::writeOpponentFile $emailData
225  grab release .emailTimesWin
226  ::tools::email::refresh 0
227  catch {focus .emailWin}
228  destroy .emailTimesWin
229  }
230  ttk::button $w.b.cancel -text $::tr(Cancel) \
231  -command "grab release $w; catch {focus .emailWin}; destroy $w"
232  pack $w.title -side top -fill x
233  pack $w.t -side top -fill both
234  pack $w.t.ybar -side right -fill y
235  pack $w.t.text -side left -fill both -expand yes
236  pack $w.b -side bottom -fill x
237  packdlgbuttons $w.b.cancel $w.b.ok
238  foreach i $timeList {
239  $w.t.text insert end "$i\n"
240  }
241  grab $w
242 }
243 
244 proc ::tools::email::addSentReceived {idx type} {
245  global emailData
246  if {[llength $emailData] <= $idx} { return}
247  set details [lindex $emailData $idx]
248  while {[llength $details] < 6} { lappend details {}}
249  set timeList [lindex $details 5]
250  set last [lindex $timeList end]
251 
252  set new ""
253  if {$type == "r"} { append new "Received "} else { append new "Sent "}
254 
255  set oppGList [lindex $details 3]
256  if {[llength $oppGList] > 0} {
257  set oppGNum [lindex $oppGList 0]
258  sc_game push
259  set mnum " "
260  if {[catch {::game::Load $oppGNum}]} {
261  } else {
262  sc_move end
263  set m [llength [split [sc_game moves coord list]]]
264  if {$m > 0} {
265  set m [expr int(($m+1)/2)]
266  set mnum [format "%3d " $m]
267  }
268  }
269  sc_game pop
270  append new $mnum
271  }
272  append new [::utils::date::today]
273  if {! [string compare $last $new]} { return}
274  lappend timeList $new
275  set details [lreplace $details 5 5 $timeList]
276  set emailData [lreplace $emailData $idx $idx $details]
279 }
280 
281 proc ::tools::email::refreshButtons {} {
282  set sel [.emailWin.f.list curselection]
283  if {[llength $sel] > 0} {
284  .emailWin.b.edit configure -state normal
285  .emailWin.b.delete configure -state normal
286  .emailWin.b.load configure -state normal
287  .emailWin.b.send configure -state normal
288  } else {
289  .emailWin.b.edit configure -state disabled
290  .emailWin.b.delete configure -state disabled
291  .emailWin.b.load configure -state disabled
292  .emailWin.b.send configure -state disabled
293  }
294 }
295 
296 proc ::tools::email::refresh {{clearSelection 1}} {
297  global emailWin emailData
298  if {! [winfo exists .emailWin]} { return}
299  if {$clearSelection} {
300  set sel ""
301  .emailWin.f.list selection clear 0 end
302  } else {
303  set sel [lindex [.emailWin.f.list curselection] 0]
304  }
305  .emailWin.f.list delete 0 end
306  # set emailData [lsort -dictionary -index 0 $emailData]
307  foreach i $emailData {
308  set name [lindex $i 0]
309  set time ""
310  if {[llength $i] == 6} {
311  set timeList [lindex $i 5]
312  set time [lindex $timeList end]
313  }
314  .emailWin.f.list insert end [format "%-14s %s" $name $time]
315  }
316  if {$sel != ""} {
317  .emailWin.f.list selection set $sel
318  }
320 }
321 
322 #Initial values for globals:
323 set emailData {}
324 set emailData_index 0
325 set emailData_name ""
326 set emailData_addr ""
327 set emailData_subj ""
328 set emailData_glist ""
329 set emailData_dates ""
330 set emailData_helpBar {}
331 array set ::tools::email::helpBar ""
332 
333 # Force the game numbers list to be digits and spaces only:
334 trace variable emailData_glist w {::utils::validate::Regexp {^[0-9\ ]*$}}
335 
336 
337 # emailCount: counter to give each email window a unique name.
338 set emailCount 0
339 
340 # emailMessageEditor:
341 # Constructs the email message to the opponent and
342 # creates the editor window for editing and sending the message.
343 #
344 proc emailMessageEditor {idx name addr subj gamelist sig} {
345  global emailCount emailData email
346  incr emailCount
347  if {$emailCount >= 10000} { set emailCount 1}
348 
349  set w ".emailMessageWin$emailCount"
351  wm title $w "Send email to $name"
352  set f [ttk::frame $w.fields]
353 
354  ttk::label $f.fromlab -text "From: "
355  ttk::entry $f.from
356  $f.from insert end $email(from)
357 
358  ttk::label $f.tolab -text "To: "
359  ttk::entry $f.to
360  $f.to insert end $addr
361 
362  ttk::label $f.subjlab -text "Subject: "
363  ttk::entry $f.subj
364  $f.subj insert end $subj
365 
366  ttk::label $f.bcclab -text "Bcc: "
367  ttk::entry $f.bcc
368  $f.bcc insert end $email(bcc)
369 
370  grid $f.fromlab -row 0 -column 0 -sticky e
371  grid $f.from -row 0 -column 1 -sticky ew
372  grid $f.tolab -row 1 -column 0 -sticky e
373  grid $f.to -row 1 -column 1 -sticky ew
374  grid $f.subjlab -row 2 -column 0 -sticky e
375  grid $f.subj -row 2 -column 1 -sticky ew
376  grid $f.bcclab -row 3 -column 0 -sticky e
377  grid $f.bcc -row 3 -column 1 -sticky ew
378  grid columnconfigure $f 1 -weight 1
379 
380  set f [ttk::frame $w.message]
381  pack $w.fields -fill x -padx 4 -pady 4
382  pack $w.message -expand yes -fill both -padx 4 -pady 4
383 
384  ttk::scrollbar $f.ybar -command "$f.text yview"
385  ttk::scrollbar $f.xbar -orient horizontal -command "$f.text xview"
386  text $f.text -yscrollcommand "$f.ybar set" -xscrollcommand "$f.xbar set" \
387  -setgrid 1 -width 72 -height 20 -background white -wrap none
388 
389  grid $f.text -row 0 -column 0 -sticky news
390  grid $f.ybar -row 0 -column 1 -sticky nse
391  grid $f.xbar -row 1 -column 0 -sticky news
392  ttk::frame $f.buttons
393  ttk::button $f.send -text " Send " -command "::tools::email::processMessage $w $idx"
394  ttk::button $f.cancel -text $::tr(Cancel) -command "destroy $w"
395  grid $f.buttons -row 2 -column 0 -columnspan 2 -sticky e
396  packdlgbuttons $f.cancel $f.send -side right -in $f.buttons
397 
398  grid rowconfig $w.message 0 -weight 1 -minsize 0
399  grid columnconfig $w.message 0 -weight 1 -minsize 0
400 
401  # Right-mouse button cut/copy/paste menu:
402  menu $f.text.edit -tearoff 0
403  $f.text.edit add command -label "Cut" -command "tk_textCut $f.text"
404  $f.text.edit add command -label "Copy" -command "tk_textCopy $f.text"
405  $f.text.edit add command -label "Paste" -command "tk_textPaste $f.text"
406  bind $f.text <ButtonPress-$::MB3> "tk_popup $f.text.edit %X %Y"
407 
408  set text $w.message.text
409  # $text insert end "Hi $name,\n\n"
410  $text insert end "\n"
411  foreach i $gamelist {
412  catch {set gamePgn [sc_game pgn -gameNumber $i -width 70 -tags 0 \
413  -variations 0 -comments 0]}
414  $text insert end "$gamePgn\n"
415  }
416  $text insert end $sig
417  return
418 }
419 
420 proc ::tools::email::processMessage {w idx} {
421  global emailData
422  set from [$w.fields.from get]
423  set to [$w.fields.to get]
424  set subj [$w.fields.subj get]
425  set bcc [$w.fields.bcc get]
426  set message [$w.message.text get 1.0 end]
427  if {[string trim $to] == ""} {
428  tk_messageBox -icon error -type ok -title "Empty email address" \
429  -message "You must specify an email address."
430  return
431  }
432  set cmd {::tools::email::sendMessage $from $to $subj $bcc $message}
433  if {[catch $cmd result] != 0} {
434  tk_messageBox -icon error -type ok -title "Error sending email" \
435  -message "Error sending email: $result"
436  } else {
438  tk_messageBox -icon info -type ok -title "Scid" -message $result
439  destroy $w
440  }
441 }
442 
443 proc ::tools::email::sendMessage {from to subject bcc message} {
444  global email
445 
446  ### Uncomment following line for testing, to avoid sending email:
447  # return "Testing, no email was actually sent"
448 
449  set copy_id ""
450  catch {set copy_id [open [file nativename $email(logfile)] "a+"]}
451  if {$copy_id == ""} {
452  return -code error "Unable to open $email(logfile)"
453  }
454  if {$email(smtp)} {
455  set cmdargs "-to {$to} -subject {$subject} "
456  if {$email(server) != ""} { ::ezsmtp::config -mailhost $email(server)}
457  if {$email(from) != ""} {
458  if {[catch {::ezsmtp::config -from $from} result]} {
459  close $copy_id
460  return -code error "Error configuring SMTP: $result"
461  }
462  append cmdargs "-from {$from} "
463  }
464  if {$email(bcc) != ""} {
465  append cmdargs "-bcc {$bcc} "
466  }
467  if {[catch {eval "::ezsmtp::send $cmdargs -body {$message}"} result]} {
468  close $copy_id
469  return -code error "Error sending mail with SMTP: $result"
470  }
471  } else {
472  if {[catch {open "| $email(smproc) -oi -t" "w"} ::tools::email::id]} {
473  close $copy_id
474  return -code error "Scid could not find the sendmail program: $email(smproc)"
475  }
476  if {[string trim $from] != ""} {
477  puts $::tools::email::id "From: $from"
478  }
479  puts $::tools::email::id "To: $to"
480  puts $::tools::email::id "Subject: $subject"
481  if {[string trim $bcc] != ""} {
482  puts $::tools::email::id "Bcc: $bcc"
483  }
484  puts $::tools::email::id ""
485  puts $::tools::email::id $message
486  close $::tools::email::id
487  }
488  puts $copy_id "To: $to"
489  puts $copy_id "Subject: $subject"
490  puts $copy_id ""
491  puts $copy_id $message
492  close $copy_id
493  return "The email message was sent; a copy was appended to $email(logfile)"
494 }
495 
496 proc modifyEmailDetails {i} {
497  global emailData emailData_name emailData_addr emailData_glist emailData_subj
498  global emailData_sig emailData_index emailData_helpBar ::tools::email::helpBar
499 
500  win::createDialog .emailEditor
501  set w .emailEditor
502  bind $w <F1> { helpWindow Email }
503  set emailData_index $i
504  if {[lindex [lindex $emailData $i] 0] == ""} {
505  wm title $w "Add opponent details"
506  } else {
507  wm title $w "Edit opponent details"
508  }
509  set f [ttk::frame $w.name]
510  ttk::label $f.label -text "Name: "
511  ttk::entry $f.entry -width 30 -textvariable emailData_name
512  set ::tools::email::helpBar(name) "Enter the opponent's name"
513 
514  set f [ttk::frame $w.addr]
515  ttk::label $f.label -text "Email address: "
516  ttk::entry $f.entry -width 30 -textvariable emailData_addr
517  set ::tools::email::helpBar(addr) "Enter the opponent's email address"
518 
519  set f [ttk::frame $w.subj]
520  ttk::label $f.label -text "Subject: "
521  ttk::entry $f.entry -width 30 -textvariable emailData_subj
522  set ::tools::email::helpBar(subj) "Enter the subject for each message"
523 
524  set f [ttk::frame $w.glist]
525  ttk::label $f.label -text "Game Numbers: "
526  ttk::entry $f.entry -width 30 -textvariable emailData_glist
527  set ::tools::email::helpBar(glist) \
528  "Enter opponent's game numbers, separated by spaces"
529 
530  foreach f {name addr subj glist} {
531  pack $w.$f -side top -fill x
532  pack $w.$f.entry $w.$f.label -side right -anchor e
533  set e $w.$f.entry
534  bind $e <FocusIn> "$e configure -background lightYellow;
535  set emailData_helpBar \$::tools::email::helpBar($f)"
536  bind $e <FocusOut> "$e configure -background white"
537  }
538 
540 
541  set f [ttk::frame $w.sig]
542  ttk::label $f.label -text "Signature: " -anchor n
543  text $f.entry -width 30 -height 5 -background white
544  bind $f.entry <FocusIn> "$f.entry configure -background lightYellow
545  set emailData_helpBar {Enter the closing text for each message}"
546  bind $f.entry <FocusOut> "$f.entry configure -background white"
547 
548  pack $f -side top -fill x -pady 5
549  pack $f.entry $f.label -side right -anchor n
550 
552 
553  set f [ttk::frame $w.buttons]
554  ttk::button $w.buttons.save -text "OK" -command {
555  set gNumberErr [::tools::email::validGameNumbers $emailData_glist]
556  if {$gNumberErr != -1} {
557  set nGames [sc_base numGames [sc_base current]]
558  tk_messageBox -icon error -type ok -title "Invalid data" \
559  -message "The games list contains an invalid game number: $gNumberErr; there are only $nGames games in this database."
560  } else {
561  set emailData [lreplace $emailData $emailData_index \
562  $emailData_index \
563  [list $emailData_name $emailData_addr $emailData_subj \
564  $emailData_glist \
565  [.emailEditor.sig.entry get 1.0 end-1c]]]
566  ::tools::email::writeOpponentFile $emailData
567  destroy .emailEditor
568  ::tools::email::refresh
569  }
570  }
571  ttk::button $f.cancel -text $::tr(Cancel) -command {
572  set emailData [::tools::email::readOpponentFile]
573  destroy .emailEditor
574  ::tools::email::refresh
575  }
576 
577  ttk::label $w.helpBar -width 1 -textvariable emailData_helpBar \
578  -font font_Small -anchor w
579  pack $w.helpBar -side top -fill x
580  pack $f -side top -anchor e
581  packdlgbuttons $f.cancel $f.save
582 
583  # Set up the initial values in the entry boxes:
584  set details [lindex $emailData $emailData_index]
585  set emailData_name [lindex $details 0]
586  set emailData_addr [lindex $details 1]
587  set emailData_subj [lindex $details 2]
588  set emailData_glist [lindex $details 3]
589  $w.sig.entry insert 1.0 [lindex $details 4]
590  grab .emailEditor
591 }
592 
593 proc ::tools::email::validGameNumbers {numberList} {
594  set nGames [sc_base numGames [sc_base current]]
595  foreach i $numberList {
596  if {$i < 1 || $i > $nGames} { return $i}
597  }
598  return -1
599 }
600 
601 proc ::tools::email::opponentFilename {} {
602  set filename [sc_base filename $::curr_db]
603  append filename ".sem"
604  return $filename
605 }
606 
607 proc ::tools::email::readOpponentFile {} {
608  set filename [::tools::email::opponentFilename]
609  if {[catch {set f [open $filename "r"]}]} {
610  # puts "Unable to open opponent file"
611  return {}
612  }
613  set data [read -nonewline $f]
614  close $f
615  return $data
616 }
617 
618 proc ::tools::email::writeOpponentFile {data} {
619  set filename [::tools::email::opponentFilename]
620  if {[catch {set f [open $filename "w"]}]} {
621  # puts "Unable to write opponent file"
622  return {}
623  }
624  puts $f $data
625  close $f
626 }
627