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