Scid  4.6.5
correspondence.tcl
Go to the documentation of this file.
1 ###
2 ### Correspondence.tcl: part of Scid.
3 ### Copyright (C) 2008 Alexander Wagner
4 ###
5 ### $Id: correspondence.tcl,v 4.3 2011/02/13 18:12:02 arwagner Exp $
6 ###
7 ### Last change: <Mon, 2014/10/27 19:29:26 arwagner agamemnon>
8 ###
9 ### Add correspondence chess via eMail or external protocol to scid
10 ###
11 #======================================================================
12 
13 # http and tdom are required for the Xfcc protocol
14 
15 #======================================================================
16 #
17 # Xfcc interface for scid
18 #
19 #======================================================================
20 namespace eval Xfcc {
21 
22  #----------------------------------------------------------------------
23  # Header and footer of the SOAP-messages. Linebreaking is important
24  #
25  set SOAPstart {<?xml version="1.0" encoding="utf-8"?>
26  <soap:Envelope xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/">
27  <soap:Body>
28  }
29 
30  set SOAPend {</soap:Body>
31  </soap:Envelope>}
32  #
33  #----------------------------------------------------------------------
34 
35  set xfccrc ""
36  set xfccstate {}
37 
38  # list of server names for config dialog
39  set lsrvname {}
40 
41  # when was the last update was retrieved online?
42  set lastupdate 0
43  set update 0
44 
45  array unset xfccsrv
46  # entry values for config dialog
47  set Oldnum 0
48  set Server ""
49  set Username ""
50  set Password ""
51  set URI ""
52 
53  # To pass on directories on windows with a backslash
54  set xfccrcfile ""
55 
56  # Set up a proper user agent
57  # Something like
58  # Scid/3.7 (x11; Linux i686; rv:Devel 2009) Tcl/Tk 8.5.2
59  set useragent "Scid/$::scidVersion ([tk windowingsystem]; $::tcl_platform(os) $::tcl_platform(machine); rv:$scidVersionDate) Tcl/Tk [info patchlevel]"
60 
61  #----------------------------------------------------------------------
62  # Replace XML entities by their normal characters
63  #----------------------------------------------------------------------
64  proc xmldecrypt {chdata} {
65  foreach from {{\&amp;} {\&lt;} {\&gt;} {\&quot;} {\&apos;}} \
66  to {{\&} < > {"} {'}} { ;# '"
67  regsub -all $from $chdata $to chdata
68  }
69  return $chdata
70  }
71 
72  #----------------------------------------------------------------------
73  # Replace normal characters by their XML entities
74  #----------------------------------------------------------------------
75  proc xmlencrypt {chdata} {
76  foreach from {{\&} < > {"} {'}} \
77  to {{\&amp;} {\&lt;} {\&gt;} {\&quot;} {\&apos;}} { ;# '"
78  regsub -all $from $chdata $to chdata
79  }
80  return $chdata
81  }
82 
83  #----------------------------------------------------------------------
84  # Configure Xfcc by means of rewriting the .xfccrc in xml
85  #----------------------------------------------------------------------
86  proc SaveXfcc {} {
87  global ::Xfcc::xfccrc ::Xfcc::xfccrcfile
88  # file delete $xfccrcfile
89  if {[catch {open $xfccrcfile w} optionF]} {
90  puts stderr "$xfccrcfile can not be created"
91  } else {
92  # devide by 4 as the size function returns all subarray entries
93  set size [expr [ array size ::Xfcc::xfccsrv] / 4]
94 
95  puts $optionF "<?xml version=\"1.0\" encoding=\"utf-8\"?>"
96  puts $optionF "<xfcc>"
97  for {set i 0} {$i < $size } {incr i} {
98  if { [regexp {^# } $::Xfcc::xfccsrv($i,0)] && \
99  [regexp {^# } $::Xfcc::xfccsrv($i,1)] && \
100  [regexp {^# } $::Xfcc::xfccsrv($i,2)] && \
101  [regexp {^# } $::Xfcc::xfccsrv($i,3)] } {
102  if {$size == 1} {
103  puts $optionF "\t<server>"
104  puts $optionF "\t\t<name>Server</name>"
105  puts $optionF "\t\t<uri>http://</uri>"
106  puts $optionF "\t\t<user>User_Name</user>"
107  puts $optionF "\t\t<pass>Password</pass>"
108  puts $optionF "\t\t<rating>Rating</rating>"
109  puts $optionF "\t</server>"
110  }
111  } else {
112  set ::Xfcc::xfccsrv($i,0) [::Xfcc::xmlencrypt $::Xfcc::xfccsrv($i,0)]
113  set ::Xfcc::xfccsrv($i,1) [::Xfcc::xmlencrypt $::Xfcc::xfccsrv($i,1)]
114  set ::Xfcc::xfccsrv($i,2) [::Xfcc::xmlencrypt $::Xfcc::xfccsrv($i,2)]
115  set ::Xfcc::xfccsrv($i,3) [::Xfcc::xmlencrypt $::Xfcc::xfccsrv($i,3)]
116  set ::Xfcc::xfccsrv($i,4) [::Xfcc::xmlencrypt $::Xfcc::xfccsrv($i,4)]
117  puts $optionF "\t<server>"
118  puts $optionF "\t\t<name>$::Xfcc::xfccsrv($i,0)</name>"
119  puts $optionF "\t\t<uri>$::Xfcc::xfccsrv($i,1)</uri>"
120  puts $optionF "\t\t<user>$::Xfcc::xfccsrv($i,2)</user>"
121  puts $optionF "\t\t<pass>$::Xfcc::xfccsrv($i,3)</pass>"
122  puts $optionF "\t\t<rating>$::Xfcc::xfccsrv($i,4)</rating>"
123  puts $optionF "\t</server>"
124  }
125  }
126  puts $optionF "</xfcc>"
127  close $optionF
128  ::Xfcc::ReadConfig $xfccrcfile
129  }
130  }
131 
132  #----------------------------------------------------------------------
133  # Delete the currently selected server entry
134  #----------------------------------------------------------------------
135  proc DeleteServer {} {
136  # mark a deleted server by '#' allows the user to manually
137  # undelete again by removing the '#' before hitting ok.
138  set ::Xfcc::Server "# $::Xfcc::xfccsrv($::Xfcc::Oldnum,0)"
139  set ::Xfcc::Username "# $::Xfcc::xfccsrv($::Xfcc::Oldnum,2)"
140  set ::Xfcc::Password "# $::Xfcc::xfccsrv($::Xfcc::Oldnum,3)"
141  set ::Xfcc::Rating "# $::Xfcc::xfccsrv($::Xfcc::Oldnum,4)"
142  set ::Xfcc::URI "# $::Xfcc::xfccsrv($::Xfcc::Oldnum,1)"
143  set ::Xfcc::xfccsrv($::Xfcc::Oldnum) $::Xfcc::Server
144  }
145 
146  #----------------------------------------------------------------------
147  # Add a new, empty server entry to xfccsrv array
148  #----------------------------------------------------------------------
149  proc AddServer {} {
150  set ::Xfcc::xfccsrv($::Xfcc::Oldnum,0) $::Xfcc::Server
151  set ::Xfcc::xfccsrv($::Xfcc::Oldnum,2) $::Xfcc::Username
152  set ::Xfcc::xfccsrv($::Xfcc::Oldnum,3) $::Xfcc::Password
153  set ::Xfcc::xfccsrv($::Xfcc::Oldnum,1) $::Xfcc::URI
154  set ::Xfcc::xfccsrv($::Xfcc::Oldnum,4) $::Xfcc::Rating
155 
156  set size [expr [ array size ::Xfcc::xfccsrv] / 4]
157 
158  # increement the list box with a new server entry
159  .configXfccSrv.xfccSrvList configure -height [expr $size+2]
160 
161  set ::Xfcc::xfccsrv($size,0) "Unique_ServerName"
162  set ::Xfcc::xfccsrv($size,2) "Your_Login"
163  set ::Xfcc::xfccsrv($size,3) "SeCrEt!"
164  set ::Xfcc::xfccsrv($size,4) "Rating"
165  set ::Xfcc::xfccsrv($size,1) "http://"
166 
167  set ::Xfcc::Server $::Xfcc::xfccsrv($size,0)
168  set ::Xfcc::Username $::Xfcc::xfccsrv($size,2)
169  set ::Xfcc::Password $::Xfcc::xfccsrv($size,3)
170  set ::Xfcc::Rating $::Xfcc::xfccsrv($size,4)
171  set ::Xfcc::URI $::Xfcc::xfccsrv($size,1)
172 
173  lappend ::Xfcc::lsrvname [list $::Xfcc::xfccsrv($size,0)]
174 
175  set ::Xfcc::Oldnum $size
176  }
177 
178  #----------------------------------------------------------------------
179  # Store the current values to the xfccsrv-array
180  #----------------------------------------------------------------------
181  proc xfccsrvstore {} {
182  set number [ .configXfccSrv.xfccSrvList curselection]
183  if {!($number > 0)} {
184  set number 0
185  }
186  set ::Xfcc::xfccsrv($::Xfcc::Oldnum,0) $::Xfcc::Server
187  set ::Xfcc::xfccsrv($::Xfcc::Oldnum,2) $::Xfcc::Username
188  set ::Xfcc::xfccsrv($::Xfcc::Oldnum,3) $::Xfcc::Password
189  set ::Xfcc::xfccsrv($::Xfcc::Oldnum,4) $::Xfcc::Rating
190  set ::Xfcc::xfccsrv($::Xfcc::Oldnum,1) $::Xfcc::URI
191 
192  set ::Xfcc::Server $::Xfcc::xfccsrv($number,0)
193  set ::Xfcc::Username $::Xfcc::xfccsrv($number,2)
194  set ::Xfcc::Password $::Xfcc::xfccsrv($number,3)
195  set ::Xfcc::Rating $::Xfcc::xfccsrv($number,4)
196  set ::Xfcc::URI $::Xfcc::xfccsrv($number,1)
197 
198  set ::Xfcc::Oldnum $number
199  .configXfccSrv.xfccSrvList selection set $number
200  }
201 
202  #----------------------------------------------------------------------
203  # Configure Xfcc by means of rewriting the .xfccrc in xml
204  #----------------------------------------------------------------------
205  proc config {configfile} {
206  global ::Xfcc::xfccrc ::Xfcc::xfccrcfile
207 
208  set xfccrcfile $configfile
209 
210  ::Xfcc::ReadConfig $xfccrcfile
211  set size [expr [array size ::Xfcc::xfccsrv] / 4]
212 
213  set w ".configXfccSrv"
214  if {[winfo exists $w]} {
215  focus $w
216  return
217  }
218 
219  set number 1
220  set ::Xfcc::Oldnum 0
221  set ::Xfcc::Server $::Xfcc::xfccsrv($::Xfcc::Oldnum,0)
222  set ::Xfcc::Username $::Xfcc::xfccsrv($::Xfcc::Oldnum,2)
223  set ::Xfcc::Password $::Xfcc::xfccsrv($::Xfcc::Oldnum,3)
224  set ::Xfcc::Rating $::Xfcc::xfccsrv($::Xfcc::Oldnum,4)
225  set ::Xfcc::URI $::Xfcc::xfccsrv($::Xfcc::Oldnum,1)
226  set ::Xfcc::showPass 0
227 
228  # create the window and buttons
229  toplevel $w
230  wm title $w "\[$xfccrcfile\]"
231  ttk::button $w.bOk -text OK -command "::Xfcc::xfccsrvstore; ::Xfcc::SaveXfcc; destroy .configXfccSrv"
232  ttk::button $w.bAdd -text [::tr "GlistAddField"] -command {
233  ::Xfcc::AddServer
234  }
235 
236  ttk::button $w.bDelete -text [::tr "GlistDeleteField"] -command {
237  ::Xfcc::DeleteServer
238  }
239  ttk::button $w.bCancel -text [::tr "Cancel"] -command "destroy $w"
240 
241  listbox $w.xfccSrvList -height [expr [ array size ::Xfcc::xfccsrv] / 4 + 1] -width 60 -selectmode single -list ::Xfcc::lsrvname
242  # select the first entry
243  $w.xfccSrvList selection set $::Xfcc::Oldnum
244 
245  ttk::label $w.lxfccSrv -text [::tr CCDlgServerName]
246  ttk::label $w.lxfccUid -text [::tr CCDlgLoginName]
247  ttk::label $w.lxfccPas -text [::tr CCDlgPassword]
248  ttk::checkbutton $w.showPass -text [::tr CCDlgShowPassword] -variable ::Xfcc::showPass -command {
249  if {$::Xfcc::showPass} {
250  .configXfccSrv.xfccPas configure -show {}
251  } else {
252  .configXfccSrv.xfccPas configure -show *
253  }
254  }
255  ttk::label $w.lxfccURI -text [::tr CCDlgURL]
256  ttk::label $w.lxfccrtype -text [::tr CCDlgRatingType]
257 
258  ttk::entry .configXfccSrv.xfccSrv -width 60 -textvariable ::Xfcc::Server
259  ttk::entry .configXfccSrv.xfccUid -width 60 -textvariable ::Xfcc::Username
260  ttk::entry .configXfccSrv.xfccPas -width 60 -textvariable ::Xfcc::Password -show *
261  ttk::entry .configXfccSrv.xfccURI -width 60 -textvariable ::Xfcc::URI
262 
263  if {$::tcl_version >= 8.5} {
264  ttk::combobox .configXfccSrv.xfccrtype -values [sc_info ratings] -width 7 -textvariable ::Xfcc::Rating
265  } else {
266  eval tk_optionMenu .configXfccSrv.xfccrtype ::Xfcc::Rating [sc_info ratings]
267  .configXfccSrv.xfccrtype configure -indicatoron 0 -width 7 -takefocus 1
268  }
269 
270  # Bind the change of selection to a proper update of variables
271  # and internal representation
272  bind .configXfccSrv.xfccSrvList <<ListboxSelect>> {
273  ::Xfcc::xfccsrvstore
274  }
275 
276  grid $w.xfccSrvList -sticky e -columnspan 6 -column 0 -row 0 -rowspan $number
277 
278  grid $w.lxfccSrv -sticky e -columnspan 2 -column 0 -row [expr {$number + 1}]
279  grid $w.lxfccUid -sticky e -columnspan 2 -column 0 -row [expr {$number + 2}]
280  grid $w.lxfccPas -sticky e -columnspan 2 -column 0 -row [expr {$number + 3}]
281  grid $w.showPass -sticky e -columnspan 2 -column 0 -row [expr {$number + 4}]
282  grid $w.lxfccURI -sticky e -columnspan 2 -column 0 -row [expr {$number + 5}]
283  grid $w.lxfccrtype -sticky e -columnspan 2 -column 0 -row [expr {$number + 6}]
284 
285  grid $w.xfccSrv -sticky w -columnspan 4 -column 2 -row [expr {$number + 1}]
286  grid $w.xfccUid -sticky w -columnspan 4 -column 2 -row [expr {$number + 2}]
287  grid $w.xfccPas -sticky w -columnspan 4 -column 2 -row [expr {$number + 3}]
288  grid $w.xfccURI -sticky w -columnspan 4 -column 2 -row [expr {$number + 5}]
289  grid $w.xfccrtype -sticky w -columnspan 4 -column 2 -row [expr {$number + 6}]
290 
291  # Add the buttons to the window
292  grid $w.bOk -column 2 -row [expr {$number + 6}]
293  grid $w.bAdd -column 3 -row [expr {$number + 6}]
294  grid $w.bDelete -column 4 -row [expr {$number + 6}]
295  grid $w.bCancel -column 5 -row [expr {$number + 6}]
296 
297  bind $w <Escape> "$w.bCancel invoke"
298  bind $w <F1> { helpWindow CCXfccSetupDialog}
299  }
300 
301  #----------------------------------------------------------------------
302  # Read xfccrcfile (xml) config file and stores the xml structure as
303  # is to the global $xfccrc
304  #----------------------------------------------------------------------
305  proc ReadConfig {xfccrcfile} {
306  global xfccrc
307 
308  ::CorrespondenceChess::updateConsole "info This is Scid's internal Xfcc-interface"
309  ::CorrespondenceChess::updateConsole "info Using $xfccrcfile..."
310  if {[catch {open $xfccrcfile r} optionF]} {
311  ::CorrespondenceChess::updateConsole "info ERROR: Unable to open config file $xfccrcfile";
312  } else {
313  set xfccrc [read $optionF]
314 
315  set dom [dom parse $xfccrc]
316  set doc [$dom documentElement]
317  set aNodes [$doc selectNodes {/xfcc/server}]
318  set number 0
319 
320  # reset the servernames before reading them in again
321  set ::Xfcc::lsrvname {}
322 
323  foreach srv $aNodes {
324  set name [$srv selectNodes {string(name)}]
325  set uri [$srv selectNodes {string(uri)}]
326  set username [$srv selectNodes {string(user)}]
327  set password [$srv selectNodes {string(pass)}]
328  set rating [$srv selectNodes {string(rating)}]
329 
330  set ::Xfcc::xfccsrv($number,0) $name
331  set ::Xfcc::xfccsrv($number,1) $uri
332  set ::Xfcc::xfccsrv($number,2) $username
333  set ::Xfcc::xfccsrv($number,3) $password
334  set ::Xfcc::xfccsrv($number,4) $rating
335 
336  lappend ::Xfcc::lsrvname [list $name]
337 
338  incr number
339  }
340  close $optionF
341  }
342  }
343 
344  #----------------------------------------------------------------------
345  # SOAPError: parses $xml and searches for error messages from the
346  # server to report them to the user.
347  #----------------------------------------------------------------------
348  proc SOAPError {server xml} {
349  # Remove the SOAP-Envelope and make all server responses to a
350  # common XML format as they use the same error messages anyway.
351  regsub -all {.*<soap:Fault>} $xml {<error>} xml
352  regsub -all {</soap:Fault>.*} $xml {</error>} xml
353 
354  regsub -all {.*<MakeAMoveResponse.*\">} $xml {<error>} xml
355  regsub -all {</MakeAMoveResponse>.*} $xml {</error>} xml
356  regsub -all {<MakeAMoveResult>} $xml {<faultstring>} xml
357  regsub -all {</MakeAMoveResult>} $xml {</faultstring>} xml
358 
359  set dom [dom parse $xml]
360  set doc [$dom documentElement]
361 
362  set aNodes [$doc selectNodes //error]
363  foreach game $aNodes {
364  set fcode [$game selectNodes {string(faultcode)}]
365  set fstring [$game selectNodes {string(faultstring)}]
366  switch -regexp -- $fstring \
367  "Success" {
368  ::CorrespondenceChess::updateConsole "info Processing successfull!"
369  } \
370  "ServerError" {
371  ::CorrespondenceChess::updateConsole "info Server Error!"
372  set Title "Scid Error"
373  set Error "$server reported an unknown error."
374  tk_messageBox -icon warning -type ok -parent . \
375  -title $Title -message $Error
376  } \
377  "FeatureUnavailable" {
378  ::CorrespondenceChess::updateConsole "info Feature unavailable!"
379  } \
380  "AuthenticationFailed" {
381  ::CorrespondenceChess::updateConsole "info Authentication failed!"
382  set Title "Scid Authentication Failure!"
383  set Error "Could not authenticate to the Xfcc-Server.\nPlease check Username and Password for $server."
384  tk_messageBox -icon warning -type ok -parent . \
385  -title $Title -message $Error
386  } \
387  "InvalidGameID" {
388  ::CorrespondenceChess::updateConsole "info Invalid Game-ID!"
389  } \
390  "NotYourGame" {
391  ::CorrespondenceChess::updateConsole "info Not your game!"
392  } \
393  "NotYourTurn" {
394  ::CorrespondenceChess::updateConsole "info Not your turn!"
395  } \
396  "InvalidMove" {
397  ::CorrespondenceChess::updateConsole "info Invalid move!"
398  } \
399  "InvalidMoveNumber" {
400  ::CorrespondenceChess::updateConsole "info Invalid move number!"
401  } \
402  "NoDrawWasOffered" {
403  ::CorrespondenceChess::updateConsole "info No draw was offered!"
404  } \
405  "LostOnTime" {
406  ::CorrespondenceChess::updateConsole "info Lost on time!"
407  } \
408  "YouAreOnLeave" {
409  ::CorrespondenceChess::updateConsole "info You are on leave!"
410  } \
411  "MoveIsAmbigous" {
412  ::CorrespondenceChess::updateConsole "info Move is ambigous!"
413  }
414  }
415  }
416 
417  #----------------------------------------------------------------------
418  # Process all servers found in the global xfccrc and store the
419  # games in path/.
420  #----------------------------------------------------------------------
421  proc ProcessAll {path} {
422  global xfccrc
423 
424  # empty the state array
425  set ::Xfcc::xfccstate {}
426 
427  set dom [dom parse $xfccrc]
428  set doc [$dom documentElement]
429 
430  set aNodes [$doc selectNodes {/xfcc/server}]
431 
432  foreach srv $aNodes {
433  set name [::Xfcc::xmlencrypt [$srv selectNodes {string(name)}]]
434  set uri [::Xfcc::xmlencrypt [$srv selectNodes {string(uri)}]]
435  set username [::Xfcc::xmlencrypt [$srv selectNodes {string(user)}]]
436  set password [::Xfcc::xmlencrypt [$srv selectNodes {string(pass)}]]
437  set rating [$srv selectNodes {string(rating)}]
438 
439  if {$rating == ""} {
440  set rating "ICCF"
441  }
442 
443  ::CorrespondenceChess::updateConsole "info Processing $username\@$name..."
444  set xml [::Xfcc::Receive $uri $username $password]
445  ::Xfcc::SOAPError $name $xml
446  ::Xfcc::WritePGN $path $name $rating $xml
447  ::Xfcc::PrintStatus $path $name $xml
448  }
449  }
450 
451  #----------------------------------------------------------------------
452  # Receive games via XFCC from the web service at uri using username
453  # and password provided
454  #----------------------------------------------------------------------
455  proc Receive {uri username password} {
456  # construct the SOAP-message for Xfcc Webservice
457  set xmlmessage $::Xfcc::SOAPstart
458  # generate the "Get my Games" call
459  append xmlmessage {<GetMyGames xmlns="http://www.bennedik.com/webservices/XfccBasic">}
460  append xmlmessage "<username>$username</username>"
461  append xmlmessage "<password>$password</password>"
462  append xmlmessage "</GetMyGames>"
463  append xmlmessage $::Xfcc::SOAPend
464 
465  # send it to the web service note the space before the charset
466  set token [::http::geturl $uri \
467  -type "text/xml; charset=\"utf-8\"" \
468  -query $xmlmessage]
469 
470  # retrieve result
471  set xmlresult [::http::data $token]
472  ::http::cleanup $token
473 
474  ###---###
475  # if {[catch {open "/tmp/xfcc.xml" w} dbg]} {
476  # ::CorrespondenceChess::updateConsole "info ERROR: Unable to open debug file";
477  # } else {
478  # puts $dbg $xmlresult
479  # }
480  # close $dbg
481  ###---###
482 
483  return $xmlresult
484  }
485 
486  #----------------------------------------------------------------------
487  # Send move via XFCC to the web service at uri using username
488  # and password provided. Gameid is the unique id on the server,
489  # move count the current move number, move the move to send in SAN,
490  # comment the comment sent to the opponent. The other variables are
491  # flags that might be true/false.
492  #----------------------------------------------------------------------
493  proc SendMove {uri username password gameid movecount move comment \
494  resign acceptdraw offerdraw claimdraw} {
495 
496  # Encrypt textual entities to conform to XML
497  set uri [::Xfcc::xmlencrypt $uri]
498  set username [::Xfcc::xmlencrypt $username]
499  set password [::Xfcc::xmlencrypt $password]
500  set comment [::Xfcc::xmlencrypt $comment]
501 
502  set xmlmessage $::Xfcc::SOAPstart
503  append xmlmessage {<MakeAMove xmlns="http://www.bennedik.com/webservices/XfccBasic">}
504  append xmlmessage "<username>$username</username>"
505  append xmlmessage "<password>$password</password>"
506  append xmlmessage "<gameId>$gameid</gameId>"
507  append xmlmessage "<resign>$resign</resign>"
508  append xmlmessage "<acceptDraw>$acceptdraw</acceptDraw>"
509  append xmlmessage "<movecount>$movecount</movecount>"
510  append xmlmessage "<myMove>$move</myMove>"
511  append xmlmessage "<offerDraw>$offerdraw</offerDraw>"
512  append xmlmessage "<claimDraw>$claimdraw</claimDraw>"
513  append xmlmessage "<myMessage>$comment</myMessage>"
514  append xmlmessage "</MakeAMove>"
515  append xmlmessage $::Xfcc::SOAPend
516 
517  # if {[catch {open "/tmp/send.xml" w} debug]} {
518  # ::CorrespondenceChess::updateConsole "info unable to open debug file..."
519  # } else {
520  # puts $debug $xmlmessage
521  # }
522  # close $debug
523 
524  # send it to the web service note the space before the charset
525  set token [::http::geturl $uri \
526  -type "text/xml; charset=\"utf-8\"" \
527  -query $xmlmessage]
528 
529  # retrieve result
530  set xmlresult [::http::data $token]
531  ::http::cleanup $token
532  return $xmlresult
533  }
534 
535  #----------------------------------------------------------------------
536  # Send move to server, extracting login data first from config file
537  #----------------------------------------------------------------------
538  proc Send {name gameid movecount move comment \
539  resign acceptdraw offerdraw claimdraw} {
540  global xfccrc
541 
542  set dom [dom parse $xfccrc]
543  set doc [$dom documentElement]
544 
545  set aNodes [$doc selectNodes {/xfcc/server}]
546 
547  foreach srv $aNodes {
548  set server [$srv selectNodes {string(name)}]
549  set uri [$srv selectNodes {string(uri)}]
550  set username [$srv selectNodes {string(user)}]
551  set password [$srv selectNodes {string(pass)}]
552 
553  if {$name == $server} {
554  ::CorrespondenceChess::updateConsole "info Processing $gameid for $username\@$name..."
555  ::CorrespondenceChess::updateConsole "info Sending $movecount\. $move \{$comment\}"
556 
557  if {$resign == "true"} {
558  ::CorrespondenceChess::updateConsole "info Resigning..."
559  }
560  if {$acceptdraw == "true"} {
561  ::CorrespondenceChess::updateConsole "info Accepting draw..."
562  }
563  if {$claimdraw == "true"} {
564  ::CorrespondenceChess::updateConsole "info Claiming draw..."
565  }
566  if {$offerdraw == "true"} {
567  ::CorrespondenceChess::updateConsole "info Offering draw..."
568  }
569 
570  set xml [::Xfcc::SendMove $uri $username $password \
571  $gameid $movecount $move $comment \
572  $resign $acceptdraw $offerdraw $claimdraw]
573  ::Xfcc::SOAPError $name $xml
574 
575  # if {[catch {open "/tmp/answer.xml" w} debug]} {
576  # ::CorrespondenceChess::updateConsole "info unable to open debug file..."
577  # } else {
578  # puts $debug $xml
579  # }
580  # close $debug
581  }
582  }
583  }
584 
585  #----------------------------------------------------------------------
586  # Given the name of the Xfcc-Server and the XML-result from the web
587  # server a PGN file with a single game is written. name is the name
588  # of the server used for generation of the CmailGameID, xml is the
589  # result from the web service. rating contains the string that
590  # should be used to specify the rating system. It could be
591  # something like Rating, Elo, ICCF, USCF, BCF etc. like usual in
592  # Scid
593  #----------------------------------------------------------------------
594  proc WritePGN {path name rating xml} {
595  # The following removes the SOAP-Envelope. tDOM does not seem to
596  # like it for whatever reason, but it's not needed anyway.
597  regsub -all {.*<GetMyGamesResult>} $xml {<GetMyGamesResult>} xml
598  regsub -all {</GetMyGamesResult>.*} $xml {</GetMyGamesResult>} xml
599 
600  set dom [dom parse $xml]
601  set doc [$dom documentElement]
602 
603  set aNodes [$doc selectNodes //XfccGame]
604  foreach game $aNodes {
605 
606  set id [::Xfcc::xmldecrypt [$game selectNodes {string(id)}]]
607  set Event [::Xfcc::xmldecrypt [$game selectNodes {string(event)}]]
608  set Site [::Xfcc::xmldecrypt [$game selectNodes {string(site)}]]
609  set Date [::Xfcc::xmldecrypt [$game selectNodes {string(eventDate)}]]
610  set White [::Xfcc::xmldecrypt [$game selectNodes {string(white)}]]
611  set Black [::Xfcc::xmldecrypt [$game selectNodes {string(black)}]]
612  set WhiteElo [::Xfcc::xmldecrypt [$game selectNodes {string(whiteElo)}]]
613  set BlackElo [::Xfcc::xmldecrypt [$game selectNodes {string(blackElo)}]]
614  set TimeControl [::Xfcc::xmldecrypt [$game selectNodes {string(timeControl)}]]
615  set GameId [::Xfcc::xmldecrypt [$game selectNodes {string(id)}]]
616  set Source [::Xfcc::xmldecrypt [$game selectNodes {string(gameLink)}]]
617  set Round [::Xfcc::xmldecrypt [$game selectNodes {string(round)}]]
618  set Result [::Xfcc::xmldecrypt [$game selectNodes {string(result)}]]
619  set drawOffered [::Xfcc::xmldecrypt [$game selectNodes {string(drawOffered)}]]
620  set setup [::Xfcc::xmldecrypt [$game selectNodes {string(setup)}]]
621  set fen [::Xfcc::xmldecrypt [$game selectNodes {string(fen)}]]
622  set myTurn [$game selectNodes {string(myTurn)}]
623  set moves [::Xfcc::xmldecrypt [$game selectNodes {string(moves)}]]
624  set mess [::Xfcc::xmldecrypt [$game selectNodes {string(message)}]]
625 
626  # These values may not be set, they were first introduced by
627  # SchemingMind as extension to Xfcc. If uppercase settings
628  # (usual default) exist: use them and they should take
629  # precedence. Note that the PNG header should use upper case
630  # by convention
631  set whiteCountry [::Xfcc::xmldecrypt [$game selectNodes {string(WhiteCountry)}]]
632  set blackCountry [::Xfcc::xmldecrypt [$game selectNodes {string(BlackCountry)}]]
633  set whiteIccfID [::Xfcc::xmldecrypt [$game selectNodes {string(WhiteIccfID)}]]
634  set blackIccfID [::Xfcc::xmldecrypt [$game selectNodes {string(BlackIccfID)}]]
635  set whiteFideID [::Xfcc::xmldecrypt [$game selectNodes {string(WhiteFideID)}]]
636  set blackFideID [::Xfcc::xmldecrypt [$game selectNodes {string(BlackFideID)}]]
637  set WhiteNA [::Xfcc::xmldecrypt [$game selectNodes {string(WhiteNA)}]]
638  set BlackNA [::Xfcc::xmldecrypt [$game selectNodes {string(BlackNA)}]]
639 
640  if {$whiteCountry == ""} {
641  set whiteCountry [::Xfcc::xmldecrypt [$game selectNodes {string(whiteCountry)}]]
642  }
643  if {$whiteIccfID == ""} {
644  set whiteIccfID [::Xfcc::xmldecrypt [$game selectNodes {string(whiteIccfID)}]]
645  }
646  if {$whiteFideID == ""} {
647  set whiteFideID [::Xfcc::xmldecrypt [$game selectNodes {string(whiteFideID)}]]
648  }
649  if {$blackCountry == ""} {
650  set blackCountry [::Xfcc::xmldecrypt [$game selectNodes {string(blackCountry)}]]
651  }
652  if {$blackIccfID == ""} {
653  set blackIccfID [::Xfcc::xmldecrypt [$game selectNodes {string(blackIccfID)}]]
654  }
655  if {$blackFideID == ""} {
656  set blackFideID [::Xfcc::xmldecrypt [$game selectNodes {string(blackFideID)}]]
657  }
658  # White/BlackNA are normally left blank but if the user
659  # allwos contain the mail addresses of the player
660  if {$WhiteNA == ""} {
661  set WhiteNA [::Xfcc::xmldecrypt [$game selectNodes {string(whiteNA)}]]
662  }
663  if {$BlackNA == ""} {
664  set BlackNA [::Xfcc::xmldecrypt [$game selectNodes {string(blackNA)}]]
665  }
666  if {$WhiteNA == ""} {
667  set WhiteNA "white@unknown.org"
668  }
669  if {$BlackNA == ""} {
670  set BlackNA "black@unknown.org"
671  }
672 
673 
674  # get the variant as scid can not handle many of them.
675  # a list of all possible tags can be found here:
676  # http://wiki.schemingmind.com/PGNVariantValues
677  # http://wiki.schemingmind.com/Variants
678  set variant [$game selectNodes {string(variant)}]
679 
680  set filename [file nativename [file join $path "$name-$id.pgn"]]
681  file delete $filename
682 
683  # Drop games that are not "normal" chess as scid can not
684  # handle variants. Note that the ICCF does not set the
685  # variant flag. Additionally, it is enough to drop variant
686  # games from the inbox to get proper playlists.
687  if { ($Result == "Cancelled") } {
688  ::CorrespondenceChess::updateConsole "info $name-$id was cancelled...";
689  } elseif {($variant == "chess") || ($variant == "") || ($variant == "randompieces") || ($variant == "upsidedown") || ($variant == "loosers") || ($variant == "nocastle")} {
690  ### --- Istvan --- ###
691  ### Racing Kings is not possible due to unambiguous moves
692  ### that are ambiguous if check is allowed
693  ### ($variant == "racingkings") ||
694  ### --- Istvan --- ###
695 
696  if {[catch {open $filename w} pgnF]} {
697  ::CorrespondenceChess::updateConsole "info ERROR: Unable to open config file $filename";
698  } else {
699  ::CorrespondenceChess::updateConsole "info $name-$id..."
700  puts $pgnF "\[Event \"$Event\"\]";
701  puts $pgnF "\[Site \"$Site\"\]";
702  puts $pgnF "\[Date \"$Date\"\]";
703  puts $pgnF "\[Round \"$Round\"\]";
704  puts $pgnF "\[White \"$White\"\]";
705  puts $pgnF "\[Black \"$Black\"\]";
706  puts $pgnF "\[White$rating \"$WhiteElo\"\]";
707  puts $pgnF "\[Black$rating \"$BlackElo\"\]";
708  puts $pgnF "\[TimeControl \"$TimeControl\"\]";
709  puts $pgnF "\[GameId \"$GameId\"\]";
710  puts $pgnF "\[Source \"$Source\"\]";
711  puts $pgnF "\[WhiteNA \"$WhiteNA\"]";
712  puts $pgnF "\[BlackNA \"$BlackNA\"]";
713  puts $pgnF "\[Mode \"XFCC\"\]";
714  puts $pgnF "\[CmailGameName \"$name-$id\"\]";
715 
716  if {$whiteCountry != ""} {
717  puts $pgnF "\[WhiteCountry \"$whiteCountry\"\]";
718  }
719  if {$blackCountry != ""} {
720  puts $pgnF "\[BlackCountry \"$blackCountry\"\]";
721  }
722  if {$whiteIccfID > 0} {
723  puts $pgnF "\[WhiteIccfID \"$whiteIccfID\"\]";
724  }
725  if {$blackIccfID > 0} {
726  puts $pgnF "\[BlackIccfID \"$blackIccfID\"\]";
727  }
728  if {$whiteFideID > 0} {
729  puts $pgnF "\[WhiteFideID \"$whiteFideID\"\]";
730  }
731  if {$blackFideID > 0} {
732  puts $pgnF "\[BlackFideID \"$blackFideID\"\]";
733  }
734  if {$setup == "true"} {
735  puts $pgnF "\[FEN \"$fen\"\]";
736  }
737 
738  # add result to the header
739  # Adjudication is handled like normal game results, that
740  # is WhiteWins == WhiteWinAdjudicated etc.
741  switch -regexp -- $Result \
742  "Ongoing" {
743  puts $pgnF "\[Result \"*\"\]\n";
744  } \
745  "AdjudicationPending" {
746  puts $pgnF "\[Result \"*\"\]\n";
747  } \
748  "WhiteWin*" {
749  puts $pgnF "\[Result \"1-0\"\]\n";
750  } \
751  "BlackWin*" {
752  puts $pgnF "\[Result \"0-1\"\]\n";
753  } \
754  "Draw*" {
755  puts $pgnF "\[Result \"1/2-1/2\"\]\n";
756  } \
757  "WhiteDefaulted" {
758  puts $pgnF "\[Result \"0-1\"\]\n";
759  } \
760  "BlackDefaulted" {
761  puts $pgnF "\[Result \"1-0\"\]\n";
762  } \
763  "BothDefaulted" {
764  puts $pgnF "\[Result \"1/2-1/2\"\]\n";
765  } \
766  default {
767  puts $pgnF "\[Result \"$Result\"\]\n";
768  }
769 
770  # Add the game-id as comment before starting the game.
771  # This might be helpful on certain mobile devices, that
772  # can not deal with extensive header information, e.g.
773  # OpenChess on PalmOS.
774  puts $pgnF "{$name-$id}"
775  puts $pgnF $moves
776 
777  # If the PGN already ends with a comment, do not place
778  # the message string afterwards as scid will then
779  # discard the comment in the movelist.
780  if {[string range $moves end end] != "\}"} {
781  if {($myTurn == "true") && ($mess != "")} {
782  puts -nonewline $pgnF "\{"
783  puts -nonewline $pgnF $mess
784  puts $pgnF "\}"
785  }
786  }
787  # If a game has finished and a message is sent always
788  # add it here.
789  if {($Result != "Ongoing") && ($mess != "")} {
790  puts -nonewline $pgnF "\{"
791  puts -nonewline $pgnF $mess
792  puts $pgnF "\}"
793  }
794 
795  # add result at the end
796  switch -regexp -- $Result \
797  "Ongoing" {
798  puts $pgnF "*";
799  } \
800  "AdjudicationPending" {
801  puts $pgnF "*";
802  } \
803  "WhiteWin*" {
804  puts $pgnF "1-0\n";
805  }\
806  "BlackWin*" {
807  puts $pgnF "0-1\n";
808  }\
809  "Draw*" {
810  puts $pgnF "1/2-1/2\n";
811  } \
812  "WhiteDefaulted" {
813  puts $pgnF "\{White Defaulted\} 0-1\n";
814  }\
815  "BlackDefaulted" {
816  puts $pgnF "\{Black Defaulted\} 1-0\n";
817  }\
818  "BothDefaulted" {
819  puts $pgnF "\{Both Defaulted\} 1/2-1/2\n";
820  }
821  close $pgnF
822  }
823  }
824  }
825  }
826 
827  #----------------------------------------------------------------------
828  # Prints all status flags of the games in xml for server name.
829  #----------------------------------------------------------------------
830  proc PrintStatus {path name xml} {
831  regsub -all {.*<GetMyGamesResult>} $xml {<GetMyGamesResult>} xml
832  regsub -all {</GetMyGamesResult>.*} $xml {</GetMyGamesResult>} xml
833 
834  set dom [dom parse $xml]
835  set doc [$dom documentElement]
836 
837  set aNodes [$doc selectNodes //XfccGame]
838  foreach game $aNodes {
839  set id [$game selectNodes {string(id)}]
840  set myTurn [$game selectNodes {string(myTurn)}]
841  set daysPlayer [$game selectNodes {string(daysPlayer)}]
842  set hoursPlayer [$game selectNodes {string(hoursPlayer)}]
843  set minutesPlayer [$game selectNodes {string(minutesPlayer)}]
844  set daysOpponent [$game selectNodes {string(daysOpponent)}]
845  set hoursOpponent [$game selectNodes {string(hoursOpponent)}]
846  set minutesOpponent [$game selectNodes {string(minutesOpponent)}]
847  set drawOffered [$game selectNodes {string(drawOffered)}]
848  set setup [$game selectNodes {string(setup)}]
849  set fen [$game selectNodes {string(fen)}]
850  set variant [$game selectNodes {string(variant)}]
851  set noOpeningBooks [$game selectNodes {string(noOpeningBooks)}]
852  set noDatabases [$game selectNodes {string(noDatabases)}]
853  set noTablebases [$game selectNodes {string(noTablebases)}]
854  set noEngines [$game selectNodes {string(noEngines)}]
855  set Result [$game selectNodes {string(result)}]
856  set TimeControl [$game selectNodes {string(timeControl)}]
857  set mess [::Xfcc::xmldecrypt [$game selectNodes {string(message)}]]
858  set serverinfo [::Xfcc::xmldecrypt [$game selectNodes {string(serverInfo)}]]
859 
860  # Set to official ICCF timing by default
861  # as ICCF does not send TimeControl
862  set TC "10/50d (?)"
863  if { [regexp {\+} $TimeControl] } {
864  set TC [split $TimeControl "+"]
865  set gametime [ expr {[lindex $TC 0] / 86400}]
866  set increment [ expr {[lindex $TC 1] / 86400}]
867 
868  set TC $gametime
869  append TC "d + "
870  append TC $increment
871  append TC "d (Fischer)"
872  } elseif { [regexp {\/} $TimeControl] } {
873  set TC [split $TimeControl "/"]
874  set moves [ expr {[lindex $TC 0]}]
875  set days [ expr {[lindex $TC 1] / 86400 }]
876  set TC $moves
877  append TC " / "
878  append TC $days
879  append TC "d"
880  # 10/50 is the official timing for ICCF
881  if { ($moves == 10) && ($days == 50) } {
882  set TC "$TC (ICCF)"
883  }
884  }
885 
886  set mytime [expr $daysPlayer*24*60+$hoursPlayer*60+$minutesPlayer]
887  set opptime [expr $daysOpponent*24*60+$hoursOpponent*60+$minutesOpponent]
888 
889  if {[$game selectNodes {string(hasWhite)}] == "true"} {
890  set clockW [format "%2ud %2u:%2u" $daysPlayer $hoursPlayer $minutesPlayer]
891  set clockB [format "%2ud %2u:%2u" $daysOpponent $hoursOpponent $minutesOpponent]
892  } else {
893  set clockB [format "%2ud %2u:%2u" $daysPlayer $hoursPlayer $minutesPlayer]
894  set clockW [format "%2ud %2u:%2u" $daysOpponent $hoursOpponent $minutesOpponent]
895  }
896  lappend ::Xfcc::xfccstate [list \
897  "$name-$id" \
898  [list "myTurn" $myTurn] \
899  [list "clockW" $clockW] \
900  [list "clockB" $clockB] \
901  [list "drawOffered" $drawOffered]\
902  [list "setup" $setup] \
903  [list "fen" $fen] \
904  [list "variant" $variant] \
905  [list "noOpeningBooks" $noOpeningBooks] \
906  [list "noTablebases" $noTablebases] \
907  [list "noDatabases" $noDatabases] \
908  [list "noEngines" $noEngines] \
909  [list "result" $Result] \
910  [list "TimeControl" $TC] \
911  [list "message" $mess] \
912  [list "mytime" $mytime] \
913  [list "opptime" $opptime] \
914  [list "serverInfo" $serverinfo]]
915  }
916 
917  set filename [scidConfigFile xfccstate]
918  file delete $filename
919 
920  if {[catch {open $filename w} stateF]} {
921  ::CorrespondenceChess::updateConsole "info ERROR: Unable to open state file $filename";
922  } else {
923  puts $stateF "# Scid options file"
924  puts $stateF "# State file for correspondence chess"
925  puts $stateF "# Version: $::scidVersion, $::scidVersionDate"
926  puts $stateF "# This file is generated automatically. Do NOT edit."
927 
928  set ::Xfcc::update 1
929  set ::Xfcc::lastupdate [clock seconds]
930  set curtime [clock format $::Xfcc::lastupdate]
931  puts $stateF "#"
932  puts $stateF "# Last Update: $curtime"
933  puts $stateF "#"
934  foreach i { ::Xfcc::lastupdate \
935  ::Xfcc::xfccstate } {
936  puts $stateF "set $i [list [set $i]]"
937  }
938  }
939  close $stateF
940  }
941 
942  #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
943  # source the options file to overwrite the above setup
944  if {[catch {source [scidConfigFile xfccstate]}]} {
945  } else {
946  ::splash::add "Xfcc state found and restored."
947  }
948 
949 }
950 
951 #======================================================================
952 #
953 # Correspondence chess menus, dialogs and functions
954 #
955 #======================================================================
956 
957 #----------------------------------------------------------------------
958 # Correspnodence Chess functions
959 namespace eval CorrespondenceChess {
960 
961  # whether the console is already open or not
962  set isOpen 0
963 
964  # default Database
965  set CorrBase [file nativename [file join $scidDataDir "Correspondence.si4"]]
966 
967  # incoming PGN files
968  set Inbox [file nativename [file join $scidDataDir "Inbox"]]
969  # outgoing PGN files
970  set Outbox [file nativename [file join $scidDataDir "Outbox"]]
971 
972  # Connector config for game relay
973  set Connector [file nativename [file join $scidDataDir "connector.xml"]]
974 
975  # use internal xfcc-support
976  set XfccInternal 1
977  set xfccrcfile [file nativename [file join $scidConfigDir "xfccrc"]]
978 
979  # Path for additional functions that should be available in the CC
980  # window only. All files from here are sourced once the CC window
981  # starts up.
982  set PluginPath [file nativename [file join $scidDataDir "Plugins/Correspondence"]]
983 
984  # external fetch tool (eg. Xfcc)
985  set XfccFetchcmd "./Xfcc-Receive.pl"
986  # external send tool (eg. Xfcc)
987  set XfccSendcmd "./Xfcc-Send.pl"
988 
989  # confirm before sending moves?
990  set XfccConfirm 1
991 
992  # Relay games from ICCF: this list contains all MakeAMove-URLs for
993  # the games to be relayed
994  set RelayGames {}
995 
996  # Show only games where the player has the move?
997  set ListOnlyOwnMove 0
998  # set sortoptlist [list "Site, Event, Round, Result, White, Black" "My Time" "Time per Move" "Opponent Time"]
999 
1000  # Sort criteria to use
1001  set CCOrderClassic 0
1002  set CCOrderMyTime 1
1003  set CCOrderTimePerMove 2
1004  set CCOrderStartDate 3
1005  set CCOrderOppTime 4
1006 
1007  # Which to use
1008  set ListOrder $CCOrderClassic
1009 
1010  # email-programm capable of SMTP auth and attachments
1011  set mailer "/usr/bin/nail"
1012  # mail a bcc of the outgoing mails to this address
1013  set bccaddr ""
1014  # mailermode might be: mailx, mozilla, claws or mailurl
1015  set mailermode "mailx"
1016  # parameter for attaching a file
1017  set attache "-a"
1018  # parameter for the subject line
1019  set subject "-s"
1020 
1021  set CorrSlot -1
1022 
1023  # current number in game list
1024  set num 0
1025 
1026  # Content of CC windows games list
1027  set clipboardText ""
1028 
1029  set glccstart 1
1030  set glgames 0
1031 
1032  #----------------------------------------------------------------------
1033  # Fetch a file via http
1034  #----------------------------------------------------------------------
1035  proc getPage { url } {
1036  set token [::http::geturl $url]
1037  set data [::http::data $token]
1038  ::http::cleanup $token
1039  return $data
1040  }
1041 
1042  #----------------------------------------------------------------------
1043  # Open a File select dialog and returns the file selected
1044  # $i: title text after "Scid Correspondence Chess: Select "
1045  # $filespecs: the specs of the file (currently ignored)
1046  #----------------------------------------------------------------------
1047  proc chooseFile {i filespecs} {
1048  set idir [pwd]
1049  set fullname [tk_getOpenFile -initialdir $idir -title "Scid Correspondence Chess: Select $i"]
1050  if {$fullname == ""} { return}
1051  return $fullname
1052  }
1053 
1054  #----------------------------------------------------------------------
1055  # Set the default correspondence base to the file selected.
1056  # Open Database works on that file, but in principle every other
1057  # DB of the type "Correspondence" can be used by just loading by
1058  # hand before using the CC features.
1059  #----------------------------------------------------------------------
1060  proc chooseCorrBase {} {
1061  global ::CorrespondenceChess::CorrBase
1062 
1063  set filetype { "Scid databases" {".si4" ".si"} }
1064  set CorrBase [chooseFile "default correspondence chess DB..." $filetype]
1065  }
1066 
1067  #----------------------------------------------------------------------
1068  # Choose the path where to fetch Xfcc-games to. All pgn-files in
1069  # this path are used as input so this offers a way to incorporate
1070  # cmail games as well.
1071  #----------------------------------------------------------------------
1072  proc chooseInbox {} {
1073  global ::CorrespondenceChess::Inbox
1074 
1075  set filetype { "All files" {".*"} }
1076  set Inbox [file dirname [chooseFile "default correspondence chess Inbox..." $filetype]]
1077  }
1078 
1079  #----------------------------------------------------------------------
1080  # In Outbox a pgn-version of the game after the users move is
1081  # stored. This includes all variations and comments! For
1082  # incorporation of cmail they need to be stripped.
1083  #----------------------------------------------------------------------
1084  proc chooseOutbox {} {
1085  global ::CorrespondenceChess::Outbox \
1086 
1087  set filetype { "All files" {".*"} }
1088  set Outbox [file dirname [chooseFile "default correspondence chess Outbox..." $filetype]]
1089  }
1090 
1091  #----------------------------------------------------------------------
1092  # Xfcc fetching is done by an external utility, currently perl as
1093  # this eases up XML parsing a lot. Having it natively would be
1094  # desireable though. On the other hand an external utility could
1095  # also fetch cmail games or whatever other source as it will be
1096  # transparent to scid. It just has to write the CmailGameName extra
1097  # tag within the header to a unique ID.
1098  #----------------------------------------------------------------------
1099  proc chooseFetch {} {
1100  global ::CorrespondenceChess::XfccFetchcmd
1101 
1102  set filetype { "All files" {".*"} }
1103  set XfccFetchcmd [chooseFile "default correspondence chess Fetch Tool..." $filetype]
1104  }
1105 
1106  #----------------------------------------------------------------------
1107  # Xfcc send utility. Similar to fetch but just the other way round
1108  # ;)
1109  #----------------------------------------------------------------------
1110  proc chooseSend {} {
1111  global ::CorrespondenceChess::XfccSendcmd
1112 
1113  set filetype { "All files" {".*"} }
1114  set XfccSendcmd [chooseFile "default correspondence chess Send Tool..." $filetype]
1115  }
1116 
1117  #----------------------------------------------------------------------
1118  # Check for xfccrc
1119  #----------------------------------------------------------------------
1120  proc checkXfccrc {} {
1121  global ::CorrespondenceChess::xfccrcfile
1122 
1123  if {![file exists $xfccrcfile]} {
1124  if {[catch {open $xfccrcfile w} optionF]} {
1125  tk_messageBox -title "Scid: Unable to write file" -type ok -icon warning \
1126  -message "Unable to write options file: $xfccrcfile\n$optionF"
1127  } else {
1128  puts $optionF "<?xml version=\"1.0\" encoding=\"utf-8\"?>"
1129  puts $optionF "<xfcc>"
1130  puts $optionF "<server>"
1131  puts $optionF " <name>ServerName</name>"
1132  puts $optionF " <uri>http://</uri>"
1133  puts $optionF " <user>UserName</user>"
1134  puts $optionF " <pass>PassWord</pass>"
1135  puts $optionF "</server>"
1136  puts $optionF "</xfcc>"
1137  close $optionF
1138  }
1139  }
1140  }
1141 
1142  #----------------------------------------------------------------------
1143  # Check for the default DB, create it if it does not exist.
1144  #----------------------------------------------------------------------
1145  proc checkCorrBase {} {
1146  global ::CorrespondenceChess::CorrBase
1147 
1148  if {![file exists $CorrBase]} {
1149  set currbase [sc_base current]
1150  set fName [file rootname $CorrBase]
1151  if {[catch {sc_base create $fName} newbase]} {
1152  ERROR::MessageBox "$fName\n"
1153  }
1154  # Type 6 == Correspondence chess
1155  sc_base extra $newbase type 6
1156  sc_base close $newbase
1157  sc_base switch $currbase
1158  }
1159  }
1160 
1161  #----------------------------------------------------------------------
1162  # Check for In-/Outbox directories and create them if not available
1163  #----------------------------------------------------------------------
1164  proc checkInOutbox {} {
1165  global scidDataDir ::CorrespondenceChess::Inbox ::CorrespondenceChess::Outbox
1166 
1167  if {[file exists $Inbox]} {
1168  if {[file isfile $Inbox]} {
1169  file rename -force $Inbox "$Inbox.bak"
1170  file mkdir $Inbox
1171  }
1172  } else {
1173  if {[catch { file mkdir "$Inbox"} result]} {
1174  set ::CorrespondenceChess::Inbox [file nativename [file join $scidDataDir "Inbox"]]
1175  file mkdir $Inbox
1176  }
1177  }
1178 
1179  if {[file exists $Outbox]} {
1180  if {[file isfile $Outbox]} {
1181  file rename -force $Outbox "$Outbox.bak"
1182  file mkdir $Outbox
1183  }
1184  } else {
1185  if {[catch { file mkdir "$Outbox"} result]} {
1186  set ::CorrespondenceChess::Inbox [file nativename [file join $scidDataDir "Outbox"]]
1187  file mkdir $Outbox
1188  }
1189  }
1190  }
1191 
1192  #----------------------------------------------------------------------
1193  # Save the Correspondence Chess options
1194  #----------------------------------------------------------------------
1195  proc saveCCoptions {} {
1196  set optionF ""
1197  if {[catch {open [scidConfigFile correspondence] w} optionF]} {
1198  tk_messageBox -title "Scid: Unable to write file" -type ok -icon warning \
1199  -message "Unable to write options file: [scidConfigFile correspondence]\n$optionF"
1200  } else {
1201  # Check all paths etc. exist and contain valid data
1205 
1206  puts $optionF "# Scid options file"
1207  puts $optionF "# Version: $::scidVersion, $::scidVersionDate"
1208  puts $optionF "# This file contains commands in the Tcl language format."
1209  puts $optionF "# If you edit this file, you must preserve valid Tcl"
1210  puts $optionF "# format or it will not set your Scid options properly."
1211  puts $optionF ""
1212 
1213  foreach i { ::CorrespondenceChess::CorrBase \
1214  ::CorrespondenceChess::Inbox \
1215  ::CorrespondenceChess::Outbox \
1216  ::CorrespondenceChess::XfccFetchcmd \
1217  ::CorrespondenceChess::XfccSendcmd \
1218  ::CorrespondenceChess::mailer \
1219  ::CorrespondenceChess::bccaddr \
1220  ::CorrespondenceChess::mailermode \
1221  ::CorrespondenceChess::attache \
1222  ::CorrespondenceChess::subject \
1223  ::CorrespondenceChess::PluginPath \
1224  ::CorrespondenceChess::Connector \
1225  ::CorrespondenceChess::RelayGames \
1226  ::CorrespondenceChess::ListOrder } {
1227  set path [set $i]
1228 
1229  puts $optionF "set $i [list [set $i]]"
1230 
1231  # If possible replace absolute path by a relative one to
1232  # $scidDataDir
1233 
1234  # first get rid of windows path separators as they get
1235  # interpreted by TCL
1236  # regsub -all {\\} $::scidDataDir "/" sdd
1237  # regsub -all {\\} $path "/" pd
1238 
1239  # if { [regexp $sdd $pd] } {
1240  # regsub -all $sdd $pd "scidDataDir" path
1241  # # now convert back to nativename
1242  # set path [file nativename $path]
1243  # puts $optionF "set $i \$$path"
1244  #} else {
1245  # puts $optionF "set $i [list [set $i]]"
1246  #}
1247 
1248  }
1249  foreach i { ::CorrespondenceChess::xfccrcfile \
1250  } {
1251  puts $optionF "set $i [list [set $i]]"
1252 
1253  # set path [set $i]
1254  # regsub -all {\\} $::scidConfigDir "/" sdd
1255  # regsub -all {\\} $path "/" pd
1256  # if { [regexp $sdd $pd] } {
1257  # regsub -all $sdd $pd "scidDataDir" path
1258  # set path [file nativename $path]
1259  # puts $optionF "set $i \$$path"
1260  #} else {
1261  # puts $optionF "set $i [list [set $i]]"
1262  #}
1263 
1264  }
1265  if {$::CorrespondenceChess::XfccInternal < 0} {
1266  puts $optionF {set ::CorrespondenceChess::XfccInternal 0}
1267  } else {
1268  puts $optionF "set ::CorrespondenceChess::XfccInternal $::CorrespondenceChess::XfccInternal"
1269  }
1270  if {$::CorrespondenceChess::XfccConfirm < 0} {
1271  puts $optionF {set ::CorrespondenceChess::XfccConfirm 0}
1272  } else {
1273  puts $optionF "set ::CorrespondenceChess::XfccConfirm $::CorrespondenceChess::XfccConfirm"
1274  }
1275  if {$::CorrespondenceChess::ListOnlyOwnMove < 0} {
1276  puts $optionF {set ::CorrespondenceChess::ListOnlyOwnMove 0}
1277  } else {
1278  puts $optionF "set ::CorrespondenceChess::ListOnlyOwnMove $::CorrespondenceChess::ListOnlyOwnMove"
1279  }
1280 
1281  }
1282  close $optionF
1283  set ::statusBar "Correspondence chess options were saved to: [scidConfigFile correspondence]"
1284  }
1285 
1286  #----------------------------------------------------------------------
1287  # yset / yview: enable synchronous scrolling of the CC game list, ie.
1288  # all text widgets involved scroll simultaneously by the same amount
1289  # in the vertical direction.
1290  #----------------------------------------------------------------------
1291  proc yset {args} {
1292  set w .ccWindow
1293  eval [linsert $args 0 $w.bottom.ysc set]
1294  yview moveto [lindex [$w.bottom.ysc get] 0]
1295  }
1296 
1297  proc yview {args} {
1298  set w .ccWindow
1299  eval [linsert $args 0 $w.bottom.id yview]
1300  eval [linsert $args 0 $w.bottom.toMove yview]
1301  eval [linsert $args 0 $w.bottom.event yview]
1302  eval [linsert $args 0 $w.bottom.site yview]
1303  eval [linsert $args 0 $w.bottom.white yview]
1304  eval [linsert $args 0 $w.bottom.black yview]
1305  eval [linsert $args 0 $w.bottom.clockW yview]
1306  eval [linsert $args 0 $w.bottom.clockB yview]
1307  eval [linsert $args 0 $w.bottom.var yview]
1308  eval [linsert $args 0 $w.bottom.feature yview]
1309  }
1310 
1311  #----------------------------------------------------------------------
1312  # Translate the local menu
1313  #----------------------------------------------------------------------
1314  proc doConfigMenus { } {
1315  set lang $::language
1316 
1317  if {! [winfo exists .ccWindow]} {
1318  raiseWin .ccWindow
1319  return
1320  }
1321 
1322  set m .ccWindow.menu
1323 
1324  foreach idx {0 1} tag {CorrespondenceChess Edit} {
1325  configMenuText $m $idx $tag $lang
1326  }
1327  foreach idx {0 1 3 4 6 7 8 9 10 11 13 14} tag {CCConfigure CCConfigRelay CCRetrieve CCInbox CCSend CCResign CCClaimDraw CCOfferDraw CCAcceptDraw CCGamePage CCNewMailGame CCMailMove } {
1328  configMenuText $m.correspondence $idx $tag $lang
1329  }
1330  foreach idx {0 } tag { CCEditCopy } {
1331  configMenuText $m.edit $idx $tag $lang
1332  }
1333  }
1334 
1335  #----------------------------------------------------------------------
1336  # Call the web page of the game. The URL is extracted from the
1337  # Source tag that is stored with each game.
1338  #----------------------------------------------------------------------
1339  proc CallWWWGame {} {
1340  ::CorrespondenceChess::updateConsole "Calling web page..."
1341  set Extra [sc_game tags get Extra]
1342  set extraTagsList [split $Extra "\n"]
1343  set source ""
1344  foreach i $extraTagsList {
1345  if { [string equal -nocase [lindex $i 0] "Source"] } {
1346  set source [string range $i 8 end-1]
1347  openURL $source
1348  }
1349  }
1350  }
1351 
1352  #----------------------------------------------------------------------
1353  # Store the relays list, but only those URLs that match
1354  # iccf-webchess' games page.
1355  #----------------------------------------------------------------------
1356  proc RelaysOK { } {
1357  global ::CorrespondenceChess::RelayGames
1358 
1359  set w .editCCRelays
1360 
1361  if {[catch {open $::CorrespondenceChess::Connector r} connectF]} {
1362  set Title "Error"
1363  append Error "$::CorrespondenceChess::Connector\n"
1364  append Error [::tr CCErrDirNotUsable]
1365  tk_messageBox -icon warning -type ok -parent . \
1366  -title $Title -message $Error
1367  return
1368  } else {
1369  set connectxml [read $connectF]
1370 
1371  set dom [dom parse $connectxml]
1372  set doc [$dom documentElement]
1373  set aNodes [$doc selectNodes {/connector/server}]
1374  set number 0
1375  foreach srv $aNodes {
1376  set stripforid [$srv selectNodes {string(stripforid)}]
1377 
1378  set text [string trim [$w.f.text get 1.0 end]]
1379  set ::CorrespondenceChess::RelayGames {}
1380  foreach game [split $text "\n"] {
1381  set game [string trim $game]
1382  if {[string match "*$stripforid*" $game]} {
1383  lappend ::CorrespondenceChess::RelayGames $game
1384  }
1385  }
1386  }
1387  close $connectF
1388  }
1389 
1391  destroy .editCCRelays
1392  }
1393 
1394  #----------------------------------------------------------------------
1395  # Configure the games to be relayed from ICCF Webchess
1396  #----------------------------------------------------------------------
1397  proc ConfigureRelay { } {
1398  global ::CorrespondenceChess::RelayGames
1399 
1400  puts stderr $::CorrespondenceChess::Connector
1401  if {![file exists $::CorrespondenceChess::Connector]} {
1402  if {[catch {open $::CorrespondenceChess::Connector w} connectF]} {
1403 
1404  } else {
1405  puts $connectF "<?xml version=\"1.0\" encoding=\"utf-8\"?>"
1406  puts $connectF "<connector>";
1407  puts $connectF "\t<server>";
1408  puts $connectF "\t\t<name>ICCF</name>";
1409  puts $connectF "\t\t<stripforid>http://www.iccf-webchess.com/MakeAMove.aspx\?id=</stripforid>";
1410  puts $connectF "\t\t<pgnbaseurl>http://www.iccf-webchess.com/GetPGN.aspx?id=</pgnbaseurl>";
1411  puts $connectF "\t\t<cmailprefix>game</cmailprefix>";
1412  puts $connectF "\t</server>";
1413  puts $connectF "</connector>";
1414  close $connectF
1415  }
1416  }
1417 
1418  if {[catch {open $::CorrespondenceChess::Connector r} connectF]} {
1419  set Title "Error"
1420  append Error "$::CorrespondenceChess::Connector\n"
1421  append Error [::tr CCErrDirNotUsable]
1422  tk_messageBox -icon warning -type ok -parent . \
1423  -title $Title -message $Error
1424  return
1425  } else {
1426  close $connectF
1427  set w .editCCRelays
1428  set oldRelays $::CorrespondenceChess::RelayGames
1429 
1430  if {[winfo exists $w]} { return}
1431  toplevel $w
1432  ::setTitle $w [::tr "CCDlgConfigRelay"]
1433 
1434  autoscrollframe $w.desc text $w.desc.text \
1435  -background gray90 -foreground black \
1436  -width 60 -height 7 -wrap word -cursor top_left_arrow
1437  $w.desc.text insert end [::tr "CCDlgConfigRelayHelp"]
1438  $w.desc.text configure -state disabled
1439  pack $w.desc -side top -fill x
1440 
1441  pack [ttk::frame $w.b] -side bottom -fill x
1442  autoscrollframe $w.f text $w.f.text -width 60 -height 10 -wrap none
1443 
1444  foreach g $::CorrespondenceChess::RelayGames {
1445  $w.f.text insert end "$g\n"
1446  }
1447  pack $w.f -side top -fill both -expand yes
1448 
1449  ttk::button $w.b.ok -text OK -command {
1450  ::CorrespondenceChess::RelaysOK
1451  }
1452  ttk::button $w.b.cancel -text $::tr(Cancel) -command "grab release $w; destroy $w"
1453  pack $w.b.cancel $w.b.ok -side right -padx 5 -pady 5
1454  }
1455  }
1456 
1457  #----------------------------------------------------------------------
1458  # Fetch PGN file of games to be relayed and put them with the
1459  # proper header tags into Scid's inbox for display
1460  # As parameter use the MakeAMove-URL from ICCF.
1461  # Currently only relaying from ICCF is supported.
1462  #----------------------------------------------------------------------
1463  proc RelayGames { gameurl } {
1464  global ::CorrespondenceChess::Inbox
1465 
1466  if {[catch {open $::CorrespondenceChess::Connector r} connectF]} {
1467  ::CorrespondenceChess::updateConsole "info ERROR: Unable to open connector $::CorrespondenceChess::Connector";
1468  } else {
1469 
1470  set connectxml [read $connectF]
1471 
1472  set dom [dom parse $connectxml]
1473  set doc [$dom documentElement]
1474  set aNodes [$doc selectNodes {/connector/server}]
1475  set number 0
1476  foreach srv $aNodes {
1477  set name [$srv selectNodes {string(name)}]
1478  set stripforid [$srv selectNodes {string(stripforid)}]
1479  set pgnbaseurl [$srv selectNodes {string(pgnbaseurl)}]
1480  set cmailprefix [$srv selectNodes {string(cmailprefix)}]
1481 
1482  if {[regexp "$stripforid" $gameurl]} {
1483 
1484  regsub -all "$stripforid" $gameurl {} gameid
1485 
1486  ::CorrespondenceChess::updateConsole "info Fetching $gameid from $name";
1487  set cmailgamename "$cmailprefix$gameid"
1488  set pgnurl "$pgnbaseurl$gameid"
1489 
1490  # convert from latin-1 to utf-8
1491  set pgn [encoding convertfrom iso8859-1 [::CorrespondenceChess::getPage $pgnurl]]
1492 
1493  # split by line endings for insertion of necessary header tags
1494  set gamelist [split $pgn "\n"]
1495 
1496  set filename [file nativename [file join $::CorrespondenceChess::Inbox "$cmailgamename.pgn"]]
1497 
1498  if {[catch {open $filename w} pgnF]} {
1499  ::CorrespondenceChess::updateConsole "info ERROR: Unable to open $filename";
1500  } else {
1501  foreach line $gamelist {
1502  if {[string match "*Result *" $line]} {
1503  puts $pgnF $line
1504  puts $pgnF "\[CmailGameName \"$cmailgamename\"\]"
1505  puts $pgnF "\[Source \"$gameurl\"\]"
1506  puts $pgnF "\[Mode \"Relay\"\]"
1507  } else {
1508  puts $pgnF $line
1509  }
1510  }
1511  close $pgnF
1512  }
1513  }
1514 
1515  }
1516  }
1517  close $connectF
1518  }
1519 
1520  #----------------------------------------------------------------------
1521  # Resize the console window
1522  #----------------------------------------------------------------------
1523  proc ConsoleResize {} {
1524  set w .ccWindow
1525 
1526  # unbind configure event
1527  bind $w <Configure> {}
1528 
1529  # get old window width and height
1530  set oldheight $::winHeight($w)
1531  set oldwidth $::winWidth($w)
1532 
1533  # get the new window width and height
1534  set temp [wm geometry $w]
1535  set n [scan $temp "%dx%d+%d+%d" width height x y]
1536 
1537  if {$height > 0 && $width > 0} {
1538  if {$height != $oldheight} {
1539  # resize the table of games
1540  foreach col {id toMove event site white black clockW clockB var feature} {
1541  $w.bottom.$col configure -height $height
1542  }
1543  # record the new size
1544  recordWinSize $w
1545  # set the windows size to this new size explicitly to
1546  # avoid flicker
1547  setWinSize $w
1548  }
1549  }
1550  recordWinSize $w
1551  # rebind the configure event
1552  bind $w <Configure> { ::CorrespondenceChess::ConsoleResize }
1553  }
1554 
1555  #----------------------------------------------------------------------
1556  # Allow to disable engine analysis in case engines are not allowed
1557  # for the ongoing game.
1558  #----------------------------------------------------------------------
1559  proc EnableEngineAnalysis {on} {
1560  # Broken: depends on the old menu structure
1561  # TODO: use the new callback mechanism ::setPlayMode()
1562  return
1563 
1564  if {$on == 0} {
1565  set m .menu.tools
1566  $m entryconfigure 0 -state disabled
1567  $m entryconfigure 1 -state disabled
1568  $m entryconfigure 2 -state disabled
1569  $m entryconfigure 3 -state disabled
1570 
1571  # disable hotkeys, needs to be done for each window
1572  foreach w { .maintWin .sortWin .playerInfoWin .repWin \
1573  .fics .metadataWindow .crosstabWin .ecograph \
1574  .glistWin .plist .statsWin .baseWin .tourney \
1575  .pgnWin .main .nedit .ccWindow } {
1576 
1577  if {[winfo exists $w]} {
1578  bind $w <Control-A> {}
1579  bind $w <Control-Shift-2> {}
1580  bind $w <F2> {}
1581  bind $w <F3> {}
1582  }
1583  }
1584  } else {
1585  set m .menu.tools
1586  $m entryconfigure 0 -state normal
1587  $m entryconfigure 1 -state normal
1588  $m entryconfigure 2 -state normal
1589  $m entryconfigure 3 -state normal
1590 
1591  # disable hotkeys, needs to be done for each window
1592  foreach w { .maintWin .sortWin .playerInfoWin .repWin \
1593  .fics .metadataWindow .crosstabWin .ecograph \
1594  .glistWin .plist .statsWin .baseWin .tourney \
1595  .pgnWin .main .nedit .ccWindow } {
1596 
1597  if {[winfo exists $w]} {
1598  bind $w <Control-A> makeAnalysisWin
1599  bind $w <Control-Shift-2> "makeAnalysisWin 2"
1600  bind $w <F2> "::makeAnalysisWin 1 0"
1601  bind $w <F3> "::makeAnalysisWin 2 0"
1602  }
1603  }
1604  }
1605  }
1606 
1607  #----------------------------------------------------------------------
1608  # Copy the games list as CSV (tab separated) to the clipboard
1609  #----------------------------------------------------------------------
1610  proc List2Clipboard {} {
1611  clipboard clear
1612  clipboard append $::CorrespondenceChess::clipboardText
1613  }
1614 
1615  #----------------------------------------------------------------------
1616  # Generate the Correspondence Chess Window. This Window offers a
1617  # console displaying whats going on and which game is displayed
1618  # plus a gmae list containing current games synced in and their
1619  # status. Xfcc offers quite some information here whereas eMail
1620  # relies mostly on the user.
1621  # Additionally this window contains the buttons for easy navigation
1622  # and in case of Xfcc the special moves available (resign etc.)
1623  #----------------------------------------------------------------------
1624  proc CCWindow {} {
1625  global scidDataDir helpMessage
1626 
1627  set w .ccWindow
1628  if {[winfo exists .ccWindow]} {
1629  focus .
1630  destroy .ccWindow
1631  set ::CorrespondenceChess::isOpen 0
1632  return
1633  }
1634  set ::CorrespondenceChess::isOpen 1
1635 
1636  ::createToplevel $w
1637  ::setTitle $w [::tr "CorrespondenceChess"]
1638 
1639  # hook up with scid's geometry manager
1640  setWinLocation $w
1641  setWinSize $w
1642 
1643  # enable the standard shortcuts
1645 
1647 
1648  # create the menu and add default CC menu items here as well
1649  menu $w.menu
1650  ::setMenu $w $w.menu
1651  set m $w.menu
1652  $w.menu add cascade -label CorrespondenceChess -menu $w.menu.correspondence
1653  $w.menu add cascade -label Edit -menu $w.menu.edit
1654  foreach i {correspondence edit} {
1655  menu $w.menu.$i -tearoff 0
1656  }
1657 
1658  $m.correspondence add command -label CCConfigure -command {::CorrespondenceChess::config}
1659  set helpMessage($m.correspondence,0) CCConfigure
1660  $m.correspondence add command -label CCConfigRelay -command {::CorrespondenceChess::ConfigureRelay}
1661  set helpMessage($m.correspondence,1) CCConfigRelay
1662 
1663  $m.correspondence add separator
1664  $m.correspondence add command -label CCRetrieve -command { ::CorrespondenceChess::FetchGames }
1665  set helpMessage($m.correspondence,3) CCRetrieve
1666 
1667  $m.correspondence add command -label CCInbox -command { ::CorrespondenceChess::ReadInbox }
1668  set helpMessage($m.correspondence,4) CCInbox
1669 
1670  $m.correspondence add separator
1671  $m.correspondence add command -label CCSend -command {::CorrespondenceChess::SendMove 0 0 0 0}
1672  set helpMessage($m.correspondence,6) CCSend
1673  $m.correspondence add command -label CCResign -command {::CorrespondenceChess::SendMove 1 0 0 0}
1674  set helpMessage($m.correspondence,7) CCResign
1675  $m.correspondence add command -label CCClaimDraw -command {::CorrespondenceChess::SendMove 0 1 0 0}
1676  set helpMessage($m.correspondence,8) CCClaimDraw
1677  $m.correspondence add command -label CCOfferDraw -command {::CorrespondenceChess::SendMove 0 0 1 0}
1678  set helpMessage($m.correspondence,9) CCOfferDraw
1679  $m.correspondence add command -label CCAcceptDraw -command {::CorrespondenceChess::SendMove 0 0 0 1}
1680  set helpMessage($m.correspondence,10) CCAcceptDraw
1681  $m.correspondence add command -label CCGamePage -command {::CorrespondenceChess::CallWWWGame}
1682  set helpMessage($m.correspondence,11) CCGamePage
1683  $m.correspondence add separator
1684  $m.correspondence add command -label CCNewMailGame -command {::CorrespondenceChess::newEMailGame}
1685  set helpMessage($m.correspondence,13) CCNewMailGame
1686  $m.correspondence add command -label CCMailMove -command {::CorrespondenceChess::eMailMove}
1687  set helpMessage($m.correspondence,14) CCMailMove
1688 
1689  $m.edit add command -label CCEditCopy -accelerator "Ctrl+C" -command { ::CorrespondenceChess::List2Clipboard }
1690 
1691  # Translate the menu
1693 
1694  ttk::frame $w.top
1695  ttk::frame $w.bottom
1696 
1697  pack $w.top -anchor w -expand no
1698  pack $w.bottom -fill both -expand yes
1699 
1700  ttk::scrollbar $w.top.ysc -command { .ccWindow.top.console yview }
1701  text $w.top.console -height 3 -width 80 -wrap word -yscrollcommand "$w.top.ysc set"
1702  ttk::button $w.top.retrieveCC -image tb_CC_Retrieve -command {::CorrespondenceChess::FetchGames}
1703  ttk::button $w.top.sendCC -image tb_CC_Send -command {::CorrespondenceChess::SendMove 0 0 0 0}
1704  ttk::button $w.top.delinbox -image tb_CC_delete -command {::CorrespondenceChess::EmptyInOutbox}
1705 
1706  ttk::button $w.top.openDB -text [::tr "CCOpenDB"] -command {::CorrespondenceChess::OpenCorrespondenceDB}
1707  ttk::button $w.top.inbox -text [::tr "CCInbox"] -command {::CorrespondenceChess::ReadInbox}
1708 
1709  ttk::button $w.top.resign -text [::tr "CCResign"] -state disabled -command {::CorrespondenceChess::SendMove 1 0 0 0}
1710  ttk::button $w.top.claimDraw -text [::tr "CCClaimDraw"] -state disabled -command {::CorrespondenceChess::SendMove 0 1 0 0}
1711  ttk::button $w.top.offerDraw -text [::tr "CCOfferDraw"] -state disabled -command {::CorrespondenceChess::SendMove 0 0 1 0}
1712  ttk::button $w.top.acceptDraw -text [::tr "CCAcceptDraw"] -state disabled -command {::CorrespondenceChess::SendMove 0 0 0 1}
1713 
1714  ttk::button $w.top.help -image tb_help -width 24 -command { helpWindow CCIcons }
1715 
1716  ttk::label $w.top.plugins -image tb_CC_spacer -takefocus 0
1717  ttk::label $w.top.onoffline -image tb_CC_offline -takefocus 0
1718 
1719 
1720  ::utils::tooltip::Set $w.top.retrieveCC [::tr "CCFetchBtn"]
1721  ::utils::tooltip::Set $w.top.sendCC [::tr "CCSendBtn"]
1722  ::utils::tooltip::Set $w.top.delinbox [::tr "CCEmptyBtn"]
1723  ::utils::tooltip::Set $w.top.help [::tr "CCHelpBtn"]
1724  ::utils::tooltip::Set $w.top.onoffline [clock format $::Xfcc::lastupdate]
1725 
1726  grid $w.top.retrieveCC -stick ewns -column 0 -row 0
1727  grid $w.top.openDB -stick ew -column 0 -row 1 -columnspan 2
1728  grid $w.top.inbox -stick ew -column 0 -row 2 -columnspan 2
1729 
1730  grid $w.top.sendCC -stick ewns -column 1 -row 0
1731 
1732  grid $w.top.console -column 4 -row 0 -columnspan 8
1733  grid $w.top.ysc -stick ns -column 13 -row 0
1734  grid $w.top.help -stick nsew -column 14 -row 0 -columnspan 2
1735 
1736  grid $w.top.delinbox -stick ewns -column 5 -row 1 -rowspan 2
1737  grid $w.top.onoffline -column 6 -row 1
1738  grid $w.top.plugins -column 6 -row 2
1739 
1740  grid $w.top.resign -stick ew -column 7 -row 1
1741 
1742  grid $w.top.claimDraw -stick ew -column 7 -row 2
1743  grid $w.top.offerDraw -stick ew -column 8 -row 2
1744  grid $w.top.acceptDraw -stick ew -column 9 -row 2
1745 
1746  # build the table in the bottom frame. This table of text widgets has to
1747  # scroll synchronously!
1748  ttk::scrollbar $w.bottom.ysc -command ::CorrespondenceChess::yview
1749 
1750  set height $::winHeight($w)
1751  set width $::winWidth($w)
1752 
1753  text $w.bottom.id -cursor top_left_arrow -font font_Small -height $height -width 15 -setgrid 1 -relief flat -wrap none -yscrollcommand ::CorrespondenceChess::yset
1754  text $w.bottom.toMove -cursor top_left_arrow -font font_Small -height $height -width 4 -setgrid 1 -relief flat -wrap none -yscrollcommand ::CorrespondenceChess::yset
1755  text $w.bottom.event -cursor top_left_arrow -font font_Small -height $height -width 10 -setgrid 1 -relief flat -wrap none -yscrollcommand ::CorrespondenceChess::yset
1756  text $w.bottom.site -cursor top_left_arrow -font font_Small -height $height -width 10 -setgrid 1 -relief flat -wrap none -yscrollcommand ::CorrespondenceChess::yset
1757  text $w.bottom.white -cursor top_left_arrow -font font_Small -height $height -width 15 -setgrid 1 -relief flat -wrap none -yscrollcommand ::CorrespondenceChess::yset
1758  text $w.bottom.black -cursor top_left_arrow -font font_Small -height $height -width 15 -setgrid 1 -relief flat -wrap none -yscrollcommand ::CorrespondenceChess::yset
1759  text $w.bottom.clockW -cursor top_left_arrow -font font_Small -height $height -width 10 -setgrid 1 -relief flat -wrap none -yscrollcommand ::CorrespondenceChess::yset
1760  text $w.bottom.clockB -cursor top_left_arrow -font font_Small -height $height -width 10 -setgrid 1 -relief flat -wrap none -yscrollcommand ::CorrespondenceChess::yset
1761  text $w.bottom.var -cursor top_left_arrow -font font_Small -height $height -width 3 -setgrid 1 -relief flat -wrap none -yscrollcommand ::CorrespondenceChess::yset
1762  text $w.bottom.feature -cursor top_left_arrow -font font_Small -height $height -width 16 -setgrid 1 -relief flat -wrap none -yscrollcommand ::CorrespondenceChess::yset
1763 
1764  grid $w.bottom.id -column 0 -row 1
1765  grid $w.bottom.toMove -column 1 -row 1
1766  grid $w.bottom.event -column 2 -row 1
1767  grid $w.bottom.site -column 3 -row 1
1768  grid $w.bottom.white -column 4 -row 1
1769  grid $w.bottom.black -column 5 -row 1
1770  grid $w.bottom.clockW -column 15 -row 1
1771  grid $w.bottom.clockB -column 16 -row 1
1772  grid $w.bottom.var -column 17 -row 1
1773  grid $w.bottom.feature -column 18 -row 1
1774  grid $w.bottom.ysc -column 19 -row 1 -stick ns
1775 
1776  # Copy games list to clipboard
1777  bind $w <Control-Insert> { ::CorrespondenceChess::List2Clipboard }
1778  bind $w <Control-c> { ::CorrespondenceChess::List2Clipboard }
1779 
1780  # Handle scrolling in the games list by keyboard
1781  bind $w <Control-Up> { ::CorrespondenceChess::PrevGame}
1782  bind $w <Control-Down> { ::CorrespondenceChess::NextGame}
1783  bind $w <Up> { ::CorrespondenceChess::yview scroll -1 units}
1784  bind $w <Down> { ::CorrespondenceChess::yview scroll 1 units}
1785  bind $w <Prior> { ::CorrespondenceChess::yview scroll -1 pages}
1786  bind $w <Next> { ::CorrespondenceChess::yview scroll 1 pages}
1787  bindMouseWheel $w "::CorrespondenceChess::yview scroll"
1788 
1789  # Help
1790  bind $w <F1> { helpWindow Correspondence}
1791  bind $w "?" { helpWindow CCIcons}
1792 
1793  bind $w <Configure> { ::CorrespondenceChess::ConsoleResize }
1794  bind $w <Destroy> { ::CorrespondenceChess::EnableEngineAnalysis 1
1795  set ::CorrespondenceChess::isOpen 0 }
1796 
1797  foreach f [glob -nocomplain [file join "$CorrespondenceChess::PluginPath" *]] {
1798  $w.top.plugins configure -image tb_CC_pluginactive
1799  source $f
1800  }
1801 
1803  }
1804 
1805  #--------------------------------------------------------------------------
1806  # Updates the game list with another event and all data available.
1807  # This just adds another line at the end of the current list, hence
1808  # the list has to be emptied if all games are resynced in.
1809  #--------------------------------------------------------------------------
1810  proc updateGamelist {id toMove event site date white black clockW \
1811  clockB var db books tb engines wc bc mess TC \
1812  lastmove drawoffer } {
1813  global ::CorrespondenceChess::num
1814  global ::CorrespondenceChess::clipboardText
1815 
1816  set w .ccWindow
1817 
1818  #----------------------------------------------------------------------
1819  # Layout for the gamelist: Xfcc offers more information about
1820  # the ongoing game then eMail, hence more is presented to the
1821  # user. ToMove and features use icons for easy reading.
1822  # Xfcc:
1823  # ID | ToMove? | White | Black | Event | Site | ClockW | ClockB # | Var | features
1824  # eMail:
1825  # ID | | White | Black | Event | Site | | | |
1826 
1827  foreach tag {id toMove event site white black clockW clockB var feature} {
1828  # enable additions
1829  $w.bottom.$tag configure -state normal
1830  # make each line high enough for the icons to be placed
1831  $w.bottom.$tag image create end -align center -image tb_CC_spacer
1832  }
1833 
1834  # Calculate the TimeDiff between the event date and the current
1835  # date. This diff is used to mark event that have not yet
1836  # started.
1837  set TimeDiff [expr [clock seconds] - [clock scan $date -format "%Y.%m.%d"]]
1838 
1839  if { $::Xfcc::update > 0 } {
1840  $w.top.onoffline configure -image tb_CC_online
1841  ::utils::tooltip::Set $w.top.onoffline [clock format $::Xfcc::lastupdate]
1842  }
1843 
1844  if {$mess != ""} {
1845  set curpos [$w.bottom.id index insert]
1846  $w.bottom.id image create end -align center -image tb_CC_message
1847  set endpos [$w.bottom.id index insert]
1848 
1849  $w.bottom.id tag add idmsg$id $curpos $endpos
1850  ::utils::tooltip::SetTag $w.bottom.id "$mess" idmsg$id
1851  }
1852  # add the game id. Note the \n at the end is necessary!
1853  set curpos [$w.bottom.id index insert]
1854  $w.bottom.id insert end "$id\n"
1855  set endpos [$w.bottom.id index insert]
1856  $w.bottom.id tag add id$id $curpos $endpos
1857  ::utils::tooltip::SetTag $w.bottom.id "$id" id$id
1858 
1859  # ToMove may contain a mixture of text for game results plus
1860  # several icons displaying the current game status.
1861  if { (($clockW == " 0d 0: 0") || ($clockB == " 0d 0: 0")) && (($toMove == "yes") || ($toMove == "no")) } {
1862  $w.bottom.toMove image create end -align center -image tb_CC_outoftime
1863  }
1864 
1865  set text ""
1866  switch -regexp -- $toMove \
1867  "1-0" {
1868  set curpos [$w.bottom.toMove index insert]
1869  $w.bottom.toMove image create end -align center -image $::board::letterToPiece(K)25
1870  $w.bottom.toMove insert end " $toMove"
1871  set endpos [$w.bottom.toMove index insert]
1872  set text "$lastmove ($toMove)"
1873  } \
1874  "0-1" {
1875  set curpos [$w.bottom.toMove index insert]
1876  $w.bottom.toMove image create end -align center -image $::board::letterToPiece(k)25
1877  $w.bottom.toMove insert end " $toMove"
1878  set endpos [$w.bottom.toMove index insert]
1879  set text "$lastmove ($toMove)"
1880  } \
1881  " = " {
1882  set curpos [$w.bottom.toMove index insert]
1883  $w.bottom.toMove image create end -align center -image tb_CC_draw
1884  $w.bottom.toMove insert end "$toMove"
1885  set endpos [$w.bottom.toMove index insert]
1886  set text "$lastmove ($toMove)"
1887  } \
1888  "yes" {
1889  set curpos [$w.bottom.toMove index insert]
1890  $w.bottom.toMove image create end -align center -image tb_CC_yourmove
1891  set endpos [$w.bottom.toMove index insert]
1892  set text "$lastmove"
1893  } \
1894  "no" {
1895  set curpos [$w.bottom.toMove index insert]
1896  $w.bottom.toMove image create end -align center -image tb_CC_oppmove
1897  set endpos [$w.bottom.toMove index insert]
1898  set text "$lastmove"
1899  } \
1900  " ? " {
1901  set curpos [$w.bottom.toMove index insert]
1902  $w.bottom.toMove insert end "$toMove"
1903  set endpos [$w.bottom.toMove index insert]
1904  set text "$lastmove"
1905  } \
1906  "POS" {
1907  set curpos [$w.bottom.toMove index insert]
1908  $w.bottom.toMove image create end -align center -image tb_CC_postal
1909  set endpos [$w.bottom.toMove index insert]
1910  set text "$lastmove"
1911  } \
1912  "EML" {
1913  set curpos [$w.bottom.toMove index insert]
1914  $w.bottom.toMove image create end -align center -image tb_CC_envelope
1915  set endpos [$w.bottom.toMove index insert]
1916  set text "$lastmove"
1917  } \
1918  "REL" {
1919  set curpos [$w.bottom.toMove index insert]
1920  $w.bottom.toMove image create end -align center -image tb_CC_relay
1921  set endpos [$w.bottom.toMove index insert]
1922  set text "$lastmove"
1923  }
1924  $w.bottom.toMove tag add toMove$id $curpos $endpos
1925  ::utils::tooltip::SetTag $w.bottom.toMove "$text" toMove$id
1926  $w.bottom.toMove insert end "\n"
1927 
1928 
1929  # Add textual information to the edit fields
1930  set curpos [$w.bottom.event index insert]
1931  $w.bottom.event insert end "$event\n"
1932  set endpos [$w.bottom.event index insert]
1933  $w.bottom.event tag add event$id $curpos $endpos
1934 
1935 
1936  set curpos [$w.bottom.site index insert]
1937  $w.bottom.site insert end "$site\n"
1938  set endpos [$w.bottom.site index insert]
1939  $w.bottom.site tag add site$id $curpos $endpos
1940  ::utils::tooltip::SetTag $w.bottom.site "$site" site$id
1941 
1942  if {$wc != ""} {
1943  if {[lsearch [image names] $wc] > -1} {
1944  $w.bottom.white image create end -align center -image $wc
1945  $w.bottom.white insert end " "
1946  } else {
1947  puts stderr "$wc does not exist"
1948  }
1949  }
1950  $w.bottom.white insert end "$white\n"
1951 
1952  if {$bc != ""} {
1953  if {[lsearch [image names] $bc] > -1} {
1954  $w.bottom.black image create end -align center -image $bc
1955  $w.bottom.black insert end " "
1956  } else {
1957  puts stderr "$bc does not exist"
1958  }
1959  }
1960  $w.bottom.black insert end "$black\n"
1961 
1962  $w.bottom.clockW insert end "$clockW\n"
1963  $w.bottom.clockB insert end "$clockB\n"
1964  $w.bottom.var insert end "$var\n"
1965 
1966  # Xfcc defines noDB, noTablebase no etc.pp. Hence check for
1967  # false to display the icons for allowed features.
1968  if {$db == "false"} {
1969  $w.bottom.feature image create end -align center -image tb_CC_database
1970  }
1971  if {$books == "false"} {
1972  $w.bottom.feature image create end -align center -image tb_CC_book
1973  }
1974  if {$tb == "false"} {
1975  $w.bottom.feature image create end -align center -image tb_CC_tablebase
1976  }
1977  if {!($engines == "true")} {
1978  $w.bottom.feature image create end -align center -image tb_CC_engine
1979  }
1980 
1981  $w.bottom.feature insert end "\n"
1982 
1983  # Link the click on each field to jump to this specific game
1984  # easily, then lock the entry field from changes by the user.
1985  # SetSelection just sets the global $num to the actual row the
1986  # user clicked. This has to be a global variable and it has to
1987  # be passed to the ProcessServerResult masqueraded to prevent
1988  # from interpretation. See also Scid's gamelist.
1989  foreach tag {id toMove event site white black clockW clockB var feature} {
1990  bind $w.bottom.$tag <Button-1> {
1991  ::CorrespondenceChess::SetSelection %x %y
1992  ::CorrespondenceChess::ProcessServerResult $::CorrespondenceChess::num
1993  break }
1994  # lock the area from changes
1995  $w.bottom.$tag configure -state disable
1996  }
1997 
1998  if {$TimeDiff < -1} {
1999  foreach col {id toMove event site} {
2000  $w.bottom.$col tag configure $col$id -foreground DarkGray -font font_Bold
2001  }
2002  ::utils::tooltip::SetTag $w.bottom.event "$event\nTime: $TC\n\nStart: $date" event$id
2003  } else {
2004  ::utils::tooltip::SetTag $w.bottom.event "$event\nTime: $TC" event$id
2005  }
2006 
2007  regsub -all "flag_" $wc "" wc1
2008  regsub -all "flag_" $bc "" bc1
2009 
2010  set wc1 [string toupper $wc1]
2011  set bc1 [string toupper $bc1]
2012 
2013  set ::CorrespondenceChess::clipboardText "$::CorrespondenceChess::clipboardText\n$id\t $event\t$site\t$date\t$white\t$black\t$wc1\t$bc1\t$clockW\t$clockB\t$toMove\t$mess\t$lastmove\t$var\t$db\t$books\t$tb\t$engines\t$TC"
2014  }
2015 
2016  #----------------------------------------------------------------------
2017  # Visually highlight line $::CorrespondenceChess::num
2018  #----------------------------------------------------------------------
2019  proc SetHighlightedLine {} {
2020  global ::CorrespondenceChess::num
2021  set gamecount $::CorrespondenceChess::glgames
2022 
2023  # remove old highlighting
2024  foreach col {id toMove event site white black clockW clockB var feature} {
2025  .ccWindow.bottom.$col tag remove highlight 1.0 end
2026  }
2027 
2028  # highlight current games line
2029  foreach col {id toMove event site white black clockW clockB var feature} {
2030  .ccWindow.bottom.$col tag add highlight $num.0 [expr {$num+1}].0
2031  .ccWindow.bottom.$col tag configure highlight -background lightYellow2 -font font_Bold
2032  }
2033  updateConsole "info: switched to game $num/$gamecount"
2034  }
2035 
2036  #----------------------------------------------------------------------
2037  # Set the global $num to the row the user clicked upon
2038  #----------------------------------------------------------------------
2039  proc SetSelection {xcoord ycoord} {
2040  global ::CorrespondenceChess::num
2041  set gamecount $::CorrespondenceChess::glgames
2042 
2043  set num [expr {int([.ccWindow.bottom.id index @$xcoord,$ycoord]) + $::CorrespondenceChess::glccstart - 1 }]
2044 
2045  # Prevent clicking beyond the last game
2046  if { $num > $gamecount } {
2047  set num $gamecount
2048  }
2049 
2051  }
2052 
2053  #----------------------------------------------------------------------
2054  # Empties the gamelist and reset global $num. This should be done
2055  # once the games are (re)synchronised.
2056  #----------------------------------------------------------------------
2057  proc emptyGamelist {} {
2058  set w .ccWindow
2059  foreach tag {id toMove event site white black clockW clockB var feature} {
2060  # unlock the list
2061  $w.bottom.$tag configure -state normal
2062  # delete it
2063  $w.bottom.$tag delete 1.0 end
2064  }
2065  # reset the number of processed games
2066  set ::CorrespondenceChess::num 0
2067  set ::CorrespondenceChess::clipboardText ""
2068 
2069  }
2070 
2071  #----------------------------------------------------------------------
2072  # Add a line to the status console
2073  #----------------------------------------------------------------------
2074  proc updateConsole {line} {
2075  set t .ccWindow.top.console
2076  if { [winfo exists $t] } {
2077  $t insert end "$line\n"
2078  $t yview moveto 1
2079  }
2080  }
2081 
2082  #----------------------------------------------------------------------
2083  # Opens a config dialog to set the default parameters. Currently
2084  # they are not stored to scid's setup though.
2085  #----------------------------------------------------------------------
2086  proc config {} {
2087  set w .correspondenceChessConfig
2088  if { [winfo exists $w]} {
2089  raiseWin $w
2090  return
2091  }
2092  toplevel $w
2093  wm title $w [::tr "CCDlgConfigureWindowTitle"]
2094 
2095  set ::CorrespondenceChess::sortoptlist [list \
2096  [::tr "CCOrderClassicTxt"] \
2097  [::tr "CCOrderMyTimeTxt"] \
2098  [::tr "CCOrderTimePerMoveTxt"] \
2099  [::tr "CCOrderStartDate"] \
2100  [::tr "CCOrderOppTimeTxt"]]
2101 
2102 
2103  ttk::button $w.bOk -text OK -command {
2104  ::CorrespondenceChess::saveCCoptions
2105  destroy .correspondenceChessConfig
2106  }
2107  ttk::button $w.bCancel -text [::tr "Cancel"] -command "destroy $w"
2108 
2109  ttk::label $w.lgeneral -text [::tr "CCDlgCGeneraloptions"]
2110  ttk::label $w.ldb -text [::tr "CCDlgDefaultDB"]
2111  ttk::label $w.linbox -text [::tr "CCDlgInbox"]
2112  ttk::label $w.loutbox -text [::tr "CCDlgOutbox"]
2113 
2114  ttk::label $w.lxfccrc -text [::tr "CCDlgXfcc"]
2115 
2116  ttk::label $w.lxfcc -text [::tr "CCDlgExternalProtocol"]
2117  ttk::label $w.lfetch -text [::tr "CCDlgFetchTool"]
2118  ttk::label $w.lsend -text [::tr "CCDlgSendTool"]
2119  ttk::label $w.lsortopt -text [::tr "CCDlgSortOption"]
2120 
2121  ttk::label $w.lemail -text [::tr "CCDlgEmailCommunication"]
2122  ttk::label $w.lmailx -text [::tr "CCDlgMailPrg"]
2123  ttk::label $w.lbccaddr -text [::tr "CCDlgBCCAddr"]
2124 
2125  ttk::label $w.lmoderb -text [::tr "CCDlgMailerMode"]
2126  ttk::label $w.lmoderb1 -text [::tr "CCDlgThunderbirdEg"]
2127  ttk::label $w.lmoderb2 -text [::tr "CCDlgMailUrlEg"]
2128  ttk::label $w.lmoderb3 -text [::tr "CCDlgClawsEg"]
2129  ttk::label $w.lmoderb4 -text [::tr "CCDlgmailxEg"]
2130 
2131  ttk::label $w.lattache -text [::tr "CCDlgAttachementPar"]
2132  ttk::label $w.lsubject -text [::tr "CCDlgSubjectPar"]
2133 
2134  ttk::checkbutton $w.internalXfcc -text [::tr "CCDlgInternalXfcc"] \
2135  -variable ::CorrespondenceChess::XfccInternal
2136 
2137  ttk::checkbutton $w.confirmXfcc -text [::tr "CCDlgConfirmXfcc"] \
2138  -variable ::CorrespondenceChess::XfccConfirm
2139 
2140  ttk::checkbutton $w.onlyOwnMove -text [::tr "CCDlgListOnlyOwnMove"] \
2141  -variable ::CorrespondenceChess::ListOnlyOwnMove
2142 
2143  ttk::scrollbar $w.ysc -command { .correspondenceChessConfig.sortopt yview }
2144  listbox $w.sortopt -height 3 -width 60 -exportselection 0 -selectmode single -list ::CorrespondenceChess::sortoptlist -yscrollcommand "$w.ysc set"
2145  $w.sortopt selection set $::CorrespondenceChess::ListOrder
2146  bind .correspondenceChessConfig.sortopt <<ListboxSelect>> {
2147  set ::CorrespondenceChess::ListOrder [ .correspondenceChessConfig.sortopt curselection ]
2148  }
2149 
2150  ttk::button $w.xfconf -text [::tr CCConfigure] -command { ::CorrespondenceChess::checkXfccrc
2151  ::Xfcc::config $::CorrespondenceChess::xfccrcfile}
2152 
2153  if {$::CorrespondenceChess::XfccInternal < 0} {
2154  $w.internalXfcc configure -state disabled
2155  $w.xfconf configure -state disabled
2156  }
2157 
2158  ttk::entry $w.db -width 60 -textvariable ::CorrespondenceChess::CorrBase
2159  ttk::entry $w.inbox -width 60 -textvariable ::CorrespondenceChess::Inbox
2160  ttk::entry $w.outbox -width 60 -textvariable ::CorrespondenceChess::Outbox
2161 
2162  ttk::entry $w.xfccrc -width 60 -textvariable ::CorrespondenceChess::xfccrcfile
2163  ttk::entry $w.fetch -width 60 -textvariable ::CorrespondenceChess::XfccFetchcmd
2164  ttk::entry $w.send -width 60 -textvariable ::CorrespondenceChess::XfccSendcmd
2165 
2166  ttk::entry $w.mailx -width 60 -textvariable ::CorrespondenceChess::mailer
2167  ttk::entry $w.bccaddr -width 60 -textvariable ::CorrespondenceChess::bccaddr
2168  ttk::entry $w.attache -width 30 -textvariable ::CorrespondenceChess::attache
2169  ttk::entry $w.subject -width 30 -textvariable ::CorrespondenceChess::subject
2170 
2171  ttk::radiobutton $w.moderb1 -text "Mozilla" -value "mozilla" -variable ::CorrespondenceChess::mailermode
2172  ttk::radiobutton $w.moderb2 -text "Mail-URL" -value "mailurl" -variable ::CorrespondenceChess::mailermode
2173  ttk::radiobutton $w.moderb3 -text "Claws" -value "claws" -variable ::CorrespondenceChess::mailermode
2174  ttk::radiobutton $w.moderb4 -text "mailx" -value "mailx" -variable ::CorrespondenceChess::mailermode
2175 
2176  ttk::button $w.bdb -text "..." -command {::CorrespondenceChess::chooseCorrBase }
2177  ttk::button $w.binbox -text "..." -command {::CorrespondenceChess::chooseInbox }
2178  ttk::button $w.boutbox -text "..." -command {::CorrespondenceChess::chooseOutbox }
2179  ttk::button $w.bfetch -text "..." -command {::CorrespondenceChess::chooseFetch }
2180  ttk::button $w.bsend -text "..." -command {::CorrespondenceChess::chooseSend }
2181 
2182  grid $w.lgeneral -column 0 -row 0 -columnspan 3 -pady 10
2183 
2184  grid $w.ldb -sticky e -column 0 -row 1
2185  grid $w.db -sticky w -column 1 -row 1 -columnspan 2
2186  grid $w.bdb -sticky w -column 3 -row 1
2187  grid $w.linbox -sticky e -column 0 -row 2
2188  grid $w.inbox -sticky w -column 1 -row 2 -columnspan 2
2189  grid $w.binbox -sticky w -column 3 -row 2
2190  grid $w.loutbox -sticky e -column 0 -row 3
2191  grid $w.outbox -sticky w -column 1 -row 3 -columnspan 2
2192  grid $w.boutbox -sticky w -column 3 -row 3
2193 
2194  grid $w.internalXfcc -sticky w -column 1 -row 4 -pady 10
2195  grid $w.xfconf -column 2 -row 4 -columnspan 2
2196  grid $w.lxfccrc -sticky e -column 0 -row 4
2197  grid $w.lxfcc -column 0 -row 5 -columnspan 3 -pady 10
2198  grid $w.xfccrc -sticky w -column 1 -row 5 -columnspan 2
2199 
2200  grid $w.lfetch -sticky e -column 0 -row 6
2201  grid $w.fetch -sticky w -column 1 -row 6 -columnspan 2
2202  grid $w.bfetch -sticky w -column 3 -row 6
2203  grid $w.lsend -sticky e -column 0 -row 7
2204  grid $w.send -sticky w -column 1 -row 7 -columnspan 2
2205  grid $w.bsend -sticky w -column 3 -row 7
2206 
2207 
2208  grid $w.confirmXfcc -sticky w -column 1 -row 8
2209  grid $w.onlyOwnMove -sticky w -column 2 -row 8
2210  grid $w.lsortopt -sticky e -column 0 -row 9
2211  grid $w.sortopt -sticky w -column 1 -row 9 -columnspan 2
2212  grid $w.ysc -sticky wns -column 3 -row 9
2213 
2214  grid $w.lemail -column 0 -row 10 -columnspan 3 -pady 10
2215 
2216  grid $w.lmailx -sticky e -column 0 -row 11
2217  grid $w.mailx -sticky w -column 1 -row 11 -columnspan 2
2218  grid $w.lbccaddr -sticky e -column 0 -row 12
2219  grid $w.bccaddr -sticky w -column 1 -row 12 -columnspan 2
2220 
2221  grid $w.lmoderb -sticky e -column 0 -row 13
2222  grid $w.lmoderb1 -sticky w -column 2 -row 13 -columnspan 2
2223  grid $w.lmoderb2 -sticky w -column 2 -row 14 -columnspan 2
2224  grid $w.lmoderb3 -sticky w -column 2 -row 15 -columnspan 2
2225  grid $w.lmoderb4 -sticky w -column 2 -row 16 -columnspan 2
2226  grid $w.moderb1 -sticky w -column 1 -row 13
2227  grid $w.moderb2 -sticky w -column 1 -row 14
2228  grid $w.moderb3 -sticky w -column 1 -row 15
2229  grid $w.moderb4 -sticky w -column 1 -row 16
2230 
2231  grid $w.lattache -sticky e -column 0 -row 18
2232  grid $w.attache -sticky w -column 1 -row 18 -columnspan 2
2233 
2234  grid $w.lsubject -sticky e -column 0 -row 19
2235  grid $w.subject -sticky w -column 1 -row 19 -columnspan 2
2236 
2237 
2238  # Buttons and ESC-key
2239  grid $w.bOk -column 0 -row 20 -pady 10 -columnspan 2
2240  grid $w.bCancel -column 1 -row 20 -pady 10
2241  bind $w <Escape> "$w.bCancel invoke"
2242 
2243  bind $w <F1> { helpWindow CCSetupDialog}
2244  }
2245 
2246  #----------------------------------------------------------------------
2247  # startEmailGame: create an empty new game and set the header for
2248  # to a cmail compatible format with the parameters entered by the
2249  # user (own and opponent names and mail addresses and unique id)
2250  #----------------------------------------------------------------------
2251  proc startEmailGame {ownname ownmail oppname oppmail gameid} {
2252  global ::CorrespondenceChess::Inbox
2253 
2254  # the following header tags have to be in this form for cmail to
2255  # recognise the mail as an eMail correspondence game.
2256  # Additionally scid searched for some of them to retrieve mail
2257  # addresses automagically and also to recognise this game as
2258  # eMail and not Xfcc.
2259  set Event "Email correspondence game"
2260  set Site "NET"
2261  set Round "-"
2262  set CmailGameName "CmailGameName \"$gameid\""
2263  set WhiteNA "WhiteNA \"$ownmail\""
2264  set BlackNA "BlackNA \"$oppmail\""
2265  set whiteCountry "WhiteCountry \"EUR\""
2266  set blackCountry "BlackCountry \"EUR\""
2267 
2268  set Mode "Mode \"EM\""
2269 
2270  set year [::utils::date::today year]
2271  set month [::utils::date::today month]
2272  set day [::utils::date::today day]
2273  set today "$year.$month.$day"
2274 
2275  # add a new game
2277 
2278  # set the header tags
2279  sc_game tags set -event $Event
2280  sc_game tags set -site $Site
2281  sc_game tags set -round $Round
2282  sc_game tags set -white $ownname
2283  sc_game tags set -black $oppname
2284  sc_game tags set -date $today
2285  sc_game tags set -eventdate $today
2286 
2287  # add cmails extra header tags
2288  sc_game tags set -extra [list $CmailGameName $WhiteNA $BlackNA $whiteCountry $blackCountry $Mode]
2289 
2290  updateBoard -pgn
2291  updateTitle
2292 
2293  # Call gameSave with argument 0 to append to the current
2294  # database. This also gives the Save-dialog for additional user
2295  # values.
2296  gameSave 0
2297 
2298  # construct a PGN in Inbox for CC gamelist to work
2299  set pgnfile "[file join $Inbox $gameid].pgn"
2300  sc_base export "current" "PGN" $pgnfile -append 0 -comments 0 -variations 0 \
2301  -space 1 -symbols 0 -indentC 0 -indentV 0 -column 0 -noMarkCodes 0 -convertNullMoves 1
2302 
2304  }
2305 
2306  #----------------------------------------------------------------------
2307  # Generate a new email correspondence game in the style of cmail,
2308  # but with a friendly dialog presented to the user instead of
2309  # somewhat cryptic command line parameters.
2310  # This procedure adds a new game to the Correspondence DB and fills
2311  # in the header appropriately.
2312  #----------------------------------------------------------------------
2313  proc newEMailGame {} {
2314  global ::CorrespondenceChess::CorrSlot
2315 
2316  # Regardless how the user opened this DB, find it! ;)
2318  # Only proceed if a correspondence DB is already loaded
2319  if {$CorrSlot > -1} {
2320  set w .wnewEMailGame
2321  if { [winfo exists $w]} { return}
2322  toplevel $w
2323  wm title $w [::tr "CCDlgStartEmail"]
2324 
2325  set ownemail ::CorrespondenceChess::bccaddr
2326  set ownname ""
2327  set oppemail ""
2328  set oppname ""
2329  set gameid ""
2330 
2331  ttk::label $w.lownname -text [::tr CCDlgYourName]
2332  ttk::label $w.lownmail -text [::tr CCDlgYourMail]
2333  ttk::label $w.loppname -text [::tr CCDlgOpponentName]
2334  ttk::label $w.loppmail -text [::tr CCDlgOpponentMail]
2335  ttk::label $w.lgameid -text [::tr CCDlgGameID]
2336 
2337  ttk::entry $w.ownname -width 40 -textvariable ownname
2338  ttk::entry $w.ownmail -width 40 -textvariable $ownemail
2339  ttk::entry $w.oppname -width 40 -textvariable oppname
2340  ttk::entry $w.oppmail -width 40 -textvariable oppemail
2341  ttk::entry $w.gameid -width 40 -textvariable gameid
2342 
2343  ttk::button $w.bOk -text OK -command {
2344  ::CorrespondenceChess::startEmailGame \
2345  [.wnewEMailGame.ownname get] \
2346  [.wnewEMailGame.ownmail get] \
2347  [.wnewEMailGame.oppname get] \
2348  [.wnewEMailGame.oppmail get] \
2349  [.wnewEMailGame.gameid get]
2350  destroy .wnewEMailGame
2351  }
2352  ttk::button $w.bCancel -text [::tr "Cancel"] -command "destroy $w"
2353 
2354  grid $w.lownname -sticky e -column 0 -row 0
2355  grid $w.lownmail -sticky e -column 0 -row 1
2356  grid $w.loppname -sticky e -column 0 -row 2
2357  grid $w.loppmail -sticky e -column 0 -row 3
2358  grid $w.lgameid -sticky e -column 0 -row 4
2359 
2360  grid $w.ownname -sticky w -column 1 -row 0 -columnspan 2
2361  grid $w.ownmail -sticky w -column 1 -row 1 -columnspan 2
2362  grid $w.oppname -sticky w -column 1 -row 2 -columnspan 2
2363  grid $w.oppmail -sticky w -column 1 -row 3 -columnspan 2
2364  grid $w.gameid -sticky w -column 1 -row 4 -columnspan 2
2365 
2366  # Buttons and ESC-key
2367  grid $w.bOk -column 1 -row 5 -pady 10
2368  grid $w.bCancel -column 2 -row 5 -pady 10
2369  bind $w <Escape> "$w.bCancel invoke"
2370  bind $w <F1> { helpWindow CCeMailChess}
2371  }
2372  }
2373 
2374  #----------------------------------------------------------------------
2375  # Call an external program via a proper shell
2376  # open and exec call the external without a shell environment
2377  # For Windows make sure that the executable uses its short name
2378  # catch {set mailer [file attributes $mailer -shortname]}
2379  # or it resides in a path without spaces
2380  # For Windows quoting is not possible as usual, < and > are not allowed
2381  # as textual arguments even if quoted properly.
2382  #----------------------------------------------------------------------
2383  proc CallExternal {callstring {param ""}} {
2384  global windowsOS
2385 
2386  if {$windowsOS} {
2387  # On Windows, use the "start" command:
2388  if {[string match $::tcl_platform(os) "Windows NT"]} {
2389  catch {exec $::env(COMSPEC) /c "$callstring $param" &}
2390  } else {
2391  catch {exec start "$callstring $param" &}
2392  }
2393  } else {
2394  # On Unix just call the shell with the converter tool
2395  catch {exec /bin/sh -c "$callstring $param" &}
2396  }
2397  }
2398 
2399  #----------------------------------------------------------------------
2400  # Check whether a Correspondence Database is loaded. Note that the
2401  # first one found is used as reference DB for game processing.
2402  #----------------------------------------------------------------------
2403  proc CheckForCorrDB {} {
2404  global ::windows::switcher::base_types
2405  global ::CorrespondenceChess::Inbox ::CorrespondenceChess::Outbox
2406  global ::CorrespondenceChess::CorrSlot
2407 
2408  set CorrSlot -1
2409  if {$CorrSlot < 0} {
2410  # check for the status window to exist, if not open it
2411  if {![winfo exists .ccWindow]} {
2413  }
2414 
2415  # check for In/Outbox to exist and be accessible
2416  if { [file exists $Inbox] == 0 && ([file isdirectory $Inbox] == 0) } {
2417  set Title [::tr CCDlgTitNoInbox]
2418  set Error [::tr CCErrInboxDir]
2419  append Error "\n $Inbox\n"
2420  append Error [::tr CCErrDirNotUsable]
2421  tk_messageBox -icon warning -type ok -parent . \
2422  -title $Title -message $Error
2423  return
2424  }
2425  if { ([file exists $Outbox] == 0) && ([file isdirectory $Outbox] == 0) } {
2426  set Title [::tr CCDlgTitNoOutbox]
2427  set Error [::tr CCErrOutboxDir]
2428  append Error "\n $Outbox\n"
2429  append Error [::tr CCErrDirNotUsable]
2430  tk_messageBox -icon warning -type ok -parent . \
2431  -title $Title -message $Error
2432  return
2433  }
2434 
2435  set typeCorr [lsearch $base_types {Correspondence chess}]
2436  foreach x [sc_base list] {
2437  set type [sc_base extra $x type]
2438  if {$type == $typeCorr} {
2439  .ccWindow.top.openDB configure -state disabled
2440  set CorrSlot $x
2441  break
2442  }
2443  }
2444  if {$CorrSlot < 0} {
2445  set Title [::tr CCDlgTitNoCCDB]
2446  set Error [::tr CCErrNoCCDB]
2447  tk_messageBox -icon warning -type ok -parent . \
2448  -title $Title -message $Error
2449  }
2450  }
2451  }
2452 
2453  #----------------------------------------------------------------------
2454  # Opens the DB holding the correspondence games
2455  #----------------------------------------------------------------------
2456  proc OpenCorrespondenceDB {} {
2457  global ::CorrespondenceChess::CorrBase
2458 
2459  ## set fName [file rootname $CorrBase]
2460  set fName $CorrBase
2461 
2462  if {[catch {::file::Open_ $fName} result]} {
2463  set err 1
2464  tk_messageBox -icon warning -type ok -parent . \
2465  -title "Scid: Error opening file" -message $result
2466  } else {
2467  if {[file extension $fName] == ".si3"} {
2468  # file has been converted to si4
2469  set CorrBase "[file rootname $CorrBase].si4"
2471  }
2472  set ::initialDir(base) [file dirname $fName]
2473  }
2474  updateBoard -pgn
2476 
2478  }
2479 
2480  #----------------------------------------------------------------------
2481  # Search for a game by Event, Site, White, Black and CmailGameName
2482  # This has to result in only one game matching the criteria.
2483  # No problem with cmail and Xfcc as GameIDs are unique.
2484  #----------------------------------------------------------------------
2485  proc SearchGame {Event Site White Black CmailGameName result refresh} {
2486  global ::CorrespondenceChess::CorrSlot
2487 
2488  # switch to the Correspondence Games DB
2489  sc_base switch $CorrSlot
2490  set move ""
2491 
2492  set sPgnlist {}
2493  lappend sPgnlist [string trim $CmailGameName]
2494 
2495  # Search the header for the game retrieved. Use as much info as
2496  # possible to get a unique result. In principle $sPgnList should
2497  # be enough. However searching indexed fields speeds up things
2498  # a lot in case of large DBs. Also: disregard deleted games,
2499  # this avoids the necessity to compact a db in case of
2500  # accidential duplication of a game.
2501  # -filter 2: Ignore previous searches
2502  set str [sc_search header \
2503  -event $Event \
2504  -site $Site \
2505  -white $White \
2506  -black $Black \
2507  -pgn $sPgnlist \
2508  -flag! D \
2509  -filter 2 \
2510  -gnum [list 1 -1]]
2511 
2512  CorrespondenceChess::updateConsole "info: search [sc_filter count]"
2513 
2514  # There should be only one result. If so, load it and place the
2515  # game pointer to the end of the game ::game::Load also handles
2516  # board rotation if Player Names are set up correctly.
2517  if {[sc_filter count] == 1} {
2518  set filternum [sc_filter first]
2519 
2520  # Refresh windows only if necessary
2521  if {$refresh == 1} {
2522  # ::game::Load also checks the dirty flag and asks to
2523  # save the game in case necessary.
2524  ::game::Load $filternum
2525  } else {
2526  sc_game load $filternum
2527  }
2528 
2530 
2531  sc_move end
2532  # Number of moves in the current DB game
2533  set mnCorr [expr {[sc_pos moveNumber]-1}]
2534  set side [sc_pos side]
2535 
2536  # Number of moves in the new game in Clipbase
2537  sc_base switch $::clipbase_db
2538  sc_move end
2539  set mnClip [sc_pos moveNumber]
2540 
2541  if {$side == "white"} {
2542  set plyStart [expr {$mnCorr*2-1}]
2543  } else {
2544  set plyStart [expr {$mnCorr*2}]
2545  }
2546 
2547  set side [sc_pos side]
2548  if {$side == "white"} {
2549  set plyEnd [expr {$mnClip*2-1}]
2550  } else {
2551  set plyEnd [expr {$mnClip*2}]
2552  }
2553 
2554  # Check if the games mainline in DB contains more ply than
2555  # the game in the clipbase. If so inform the user.
2556  if {($plyEnd-$plyStart < 2) && ($Mode == "XFCC") && ($result == "*")} {
2557  set Title [::tr CCDlgDBGameToLong]
2558  set Error [::tr CCDlgDBGameToLongError]
2559  tk_messageBox -icon warning -type ok -parent . \
2560  -title $Title -message "$Error $mnClip (= ply $plyEnd)"
2561  }
2562 
2563  # Add moves from the relayed games if the mode is not Postal.
2564  # On mixed ICCF Events also the ICCF server deliveres an
2565  # empty game via Xfcc, therefore this check is required
2566  if {$Mode != "Postal"} {
2567 
2568  # Add moves from clipbase to the DB game. This keeps
2569  # comments, but requires that tries are inserted as variants
2570  # as it is always appended to the end of the game
2571  for {set x $plyStart} {$x < $plyEnd} {incr x} {
2572  set basecomment ""
2573  set comment ""
2574 
2575  sc_base switch $::clipbase_db
2576 
2577  # move to the beginning of the new part
2578  sc_move start
2579  sc_move forward [expr {$x+1}]
2580 
2581  # Get the move in _untranslated_ form...
2582  set move [sc_game info nextMoveNT]
2583  # ... move on one ply ...
2584  sc_move forward
2585  # ... and get the comment
2586  set comment [sc_pos getComment]
2587 
2588  # switch to Correspondence DB and add the move and comment
2589  sc_base switch $CorrSlot
2590  sc_move addSan $move
2591 
2592  # Get the comment stored in the base for comparison
2593  set basecomment [sc_pos getComment]
2594 
2595  # Some servers keep old comments within the game
2596  # (SchemingMind) some don't (ICCF). Try to preserve
2597  # comments inserted by the user as well as add new
2598  # responses properly.
2599  set sbasecomment ""
2600  set scomment ""
2601 
2602  # Strip of [%ccsnt...] like comments (SchemingMind time stamps)
2603  regsub -all {\[.*\]} $basecomment "" sbasecomment
2604  regsub -all {^\s*} $sbasecomment "" sbasecomment
2605  # Strip of "Name: " to compare original text entered by
2606  # the user only.
2607  regsub -all "$White:" $sbasecomment "" sbasecomment
2608  regsub -all "$Black:" $sbasecomment "" sbasecomment
2609 
2610  # Same for the game delivered by Xfcc
2611  regsub -all {\[.*\]} $comment "" scomment
2612  regsub -all {^\s*} $scomment "" scomment
2613  regsub -all "$White:" $scomment "" scomment
2614  regsub -all "$Black:" $scomment "" scomment
2615 
2616  # Check what to preserve and which comment to set.
2617  if { [string length $sbasecomment] == 0} {
2618  sc_pos setComment "$comment"
2619  } elseif { [string length $scomment] < [string length $sbasecomment]} {
2620  # base contains more text than the one retrieved
2621  if { [string first $scomment $sbasecomment] < 0 } {
2622  sc_pos setComment "$basecomment $comment"
2623  }
2624  } else {
2625  # retrieved game contains more text than the stored
2626  if { [string first $sbasecomment $scomment] < 0 } {
2627  sc_pos setComment "$basecomment $comment"
2628  } else {
2629  sc_pos setComment "$comment"
2630  }
2631  }
2632  }
2633  sc_game tags set -result $result
2634  sc_base switch $CorrSlot
2635  sc_game save $filternum
2636 
2637  # Only refresh when SearchGame was triggered by the user,
2638  # otherwise just reload the game but leave the window in
2639  # state to save considerable amount of time
2640  if {$refresh == 1} {
2641  ::game::Load $filternum
2642  } else {
2643  sc_game load $filternum
2644  }
2645  } else {
2646  # only switch to base for postal games
2647  sc_base switch $CorrSlot
2648  }
2649  } elseif {[sc_filter count] == 0} {
2650  # No matching game found, add it as a new one
2651  # Clear the current game first, then just paste the clipboard
2652  # game as it is. No need to do something as complex as for
2653  # already existing games above.
2654  game::Clear
2655  sc_clipbase paste
2656  # append the current game without asking and the header
2657  # supplied
2658  # gameAdd gets confused here with with an altered game opeing
2659  # another dialogue besides the save game
2660  sc_game save 0
2661 
2662  CorrespondenceChess::updateConsole "info: new game added"
2663  } else {
2664  if {[winfo exists .glistWin]} {
2665  raise .glistWin
2666  } else {
2668  }
2669  set Title [::tr CCDlgDuplicateGame]
2670  set Error [::tr CCDlgDuplicateGameError]
2671  tk_messageBox -icon warning -type ok -parent . \
2672  -title $Title -message $Error
2673  }
2675  }
2676 
2677  #----------------------------------------------------------------------
2678  # If a Correspondence DB is loaded, switch to the clipbase and
2679  # use the game with the given id to find headers.
2680  # PGN file and jump to the game number given. Then extract the
2681  # header tags and call "SearchGame" to display the game in question
2682  # to the user.
2683  #----------------------------------------------------------------------
2684  proc ProcessServerResult {game} {
2685  global ::CorrespondenceChess::CorrSlot
2686  global emailData
2687 
2688  # Regardless how the user opened this DB, find it! ;)
2690  # Only proceed if a correspondence DB is already loaded
2691  if {$CorrSlot > -1} {
2692  sc_base switch $::clipbase_db
2693  sc_game load $game
2694 
2695  # get the header
2696  set Event [sc_game tags get Event]
2697  set Site [sc_game tags get Site]
2698  set White [sc_game tags get White]
2699  set Black [sc_game tags get Black]
2700  set Extra [sc_game tags get Extra]
2701  set result [sc_game tags get Result]
2702  # CmailGameName is an extra header :(
2703  set extraTagsList [split $Extra "\n"]
2704 
2705  # ... extract it as it contains the unique ID
2706  foreach i $extraTagsList {
2707  if { [string equal -nocase [lindex $i 0] "CmailGameName"] } {
2708  set CmailGameName [string range $i 15 end-1]
2709  }
2710  }
2711 
2712  # set these variables for email games where they get no
2713  # values otherwise
2714  set noENG "false"
2715  set drawoffer "false"
2716  # Search the game in the correspondence DB and display it
2717  foreach xfccextra $::Xfcc::xfccstate {
2718  if { [string equal -nocase [lindex $xfccextra 0] "$CmailGameName"] } {
2719  foreach i $xfccextra {
2720  if { [string equal -nocase [lindex $i 0] "noEngines"] } {
2721  set noENG [string range $i 10 end]
2722  }
2723  if { [string equal -nocase [lindex $i 0] "drawOffered"] } {
2724  set drawoffer [string range $i 12 end]
2725  }
2726  }
2727  }
2728  }
2729  if {$noENG == "true"} {
2731  } else {
2733  }
2734 
2735  # After this search the windows need to be refreshed to show
2736  # the current state
2737  SearchGame $Event $Site $White $Black $CmailGameName $result 1
2738 
2740 
2741  # hook up with the old email manager: this implements the
2742  # manual timestamping required
2743  if {($Mode == "EM") || ($Mode == "Relay") || ($Mode == "Postal")} {
2744  set emailData [::tools::email::readOpponentFile]
2745  set done 0
2746  set idx 0
2747  # search through the whole list and check if the current
2748  # game was already defined to be an email game.
2749  foreach dataset $emailData {
2750  if { [lindex $dataset 0] == $CmailGameName} {
2751  set done 1
2752  # add the received flag and date
2754  }
2755  incr idx
2756  }
2757  if {$done < 1} {
2758  set idx [llength $emailData]
2759  lappend emailData [list "" "" "" "" ""]
2760  set emailData [lreplace $emailData $idx $idx \
2761  [list "$CmailGameName" "somewhere@somehost.org" "scid game" [sc_filter first] "-- "]]
2764  # add the received flag and date
2766  }
2767  }
2768  # Jump to the end of the game and update the display
2769  ::move::End
2770  if {$drawoffer == "true"} {
2771  .ccWindow.top.acceptDraw configure -state normal
2772  set comment [sc_pos getComment]
2773  set drwstr "- [::tr Draw] -"
2774  if { [regexp "$drwstr" $comment] } {
2775  } else {
2776  sc_pos setComment "$comment $drwstr"
2777  updateBoard -pgn
2778  }
2779  } else {
2780  .ccWindow.top.acceptDraw configure -state disabled
2781  }
2782 
2783 
2784  # Set some basic info also to the button tooltips
2785  ::utils::tooltip::Set .ccWindow.top.resign "$CmailGameName: $Event\n$Site\n\n$White - $Black"
2786  ::utils::tooltip::Set .ccWindow.top.claimDraw "$CmailGameName: $Event\n$Site\n\n$White - $Black"
2787  ::utils::tooltip::Set .ccWindow.top.acceptDraw "$CmailGameName: $Event\n$Site\n\n$White - $Black"
2788  ::utils::tooltip::Set .ccWindow.top.offerDraw "$CmailGameName: $Event\n$Site\n\n$White - $Black"
2789  }
2790  }
2791 
2792  #----------------------------------------------------------------------
2793  # Checks the mode of the current game and return it (EM or XFCC).
2794  # Additionally update the button status in the Console window
2795  # accordingly and update the console itself with $Event, Mode and
2796  # $Site.
2797  #----------------------------------------------------------------------
2798  proc CheckMode {} {
2799  set Event [sc_game tags get Event]
2800  set Site [sc_game tags get Site]
2801  set Extra [sc_game tags get Extra]
2802  # CmailGameName is an extra header :(
2803  set extraTagsList [split $Extra "\n"]
2804 
2805  # ... extract it as it contains the unique ID
2806  foreach i $extraTagsList {
2807  if { [string equal -nocase [lindex $i 0] "Mode"] } {
2808  set Mode [string range $i 6 end-1]
2809  }
2810  }
2811 
2812  set m .menu.play.correspondence
2813 
2814  # do not set state of top.acceptDraw as this is set dynamically
2815  if {($Mode == "EM") || ($Mode == "Relay") || ($Mode == "Postal")} {
2816  if {$Mode == "EM"} {
2817  ::CorrespondenceChess::updateConsole "info Event: $Event (eMail-based)"
2818  } elseif {$Mode == "Relay"} {
2819  ::CorrespondenceChess::updateConsole "info Event: $Event (observed)"
2820  } elseif {$Mode == "Postal"} {
2821  ::CorrespondenceChess::updateConsole "info Event: $Event (postal)"
2822  }
2823 
2824  # eMail/postal games: manual handling for resign and draw is
2825  # needed, no standard way/protocol exists => disable the
2826  # buttons and menu entries accordingly
2827  .ccWindow.top.resign configure -state disabled
2828  .ccWindow.top.claimDraw configure -state disabled
2829  .ccWindow.top.offerDraw configure -state disabled
2830  # .ccWindow.top.acceptDraw configure -state disabled
2831 
2832  $m entryconfigure 8 -state disabled
2833  $m entryconfigure 9 -state disabled
2834  $m entryconfigure 10 -state disabled
2835  $m entryconfigure 11 -state disabled
2836  } else {
2837  .ccWindow.top.resign configure -state normal
2838  .ccWindow.top.claimDraw configure -state normal
2839  .ccWindow.top.offerDraw configure -state normal
2840  # .ccWindow.top.acceptDraw configure -state normal
2841  ::CorrespondenceChess::updateConsole "info Event: $Event (Xfcc-based)"
2842 
2843  $m entryconfigure 8 -state normal
2844  $m entryconfigure 9 -state normal
2845  $m entryconfigure 10 -state normal
2846  $m entryconfigure 11 -state normal
2847  }
2848  ::CorrespondenceChess::updateConsole "info Site: $Site"
2849 
2850  return $Mode
2851  }
2852 
2853  #----------------------------------------------------------------------
2854  # Search the previous game from the input file in the correspondence DB
2855  # If at last game already nothing happens
2856  #----------------------------------------------------------------------
2857  proc PrevGame {} {
2858  global ::CorrespondenceChess::CorrSlot ::CorrespondenceChess::num
2859  set gamecount $::CorrespondenceChess::glgames
2860 
2861  busyCursor .
2862  # Regardless how the user opened this DB, find it! ;)
2864  if {$CorrSlot > -1} {
2865  if {$num > 1} {
2866  set num [expr {$num - 1}]
2868  ::CorrespondenceChess::ProcessServerResult $::CorrespondenceChess::num
2869  }
2870  }
2871  unbusyCursor .
2872  }
2873 
2874  #----------------------------------------------------------------------
2875  # Search the next game from the input file in the correspondence DB
2876  # If at last game already nothing happens
2877  #----------------------------------------------------------------------
2878  proc NextGame {} {
2879  global ::CorrespondenceChess::CorrSlot ::CorrespondenceChess::num
2880  set gamecount $::CorrespondenceChess::glgames
2881 
2882  busyCursor .
2883  # Regardless how the user opened this DB, find it! ;)
2885  if {$CorrSlot > -1} {
2886  if {$num < $gamecount} {
2887  set num [expr {$num + 1}]
2889  ::CorrespondenceChess::ProcessServerResult $::CorrespondenceChess::num
2890  }
2891  }
2892  unbusyCursor .
2893  }
2894 
2895  #----------------------------------------------------------------------
2896  # FetchGames: retrieve games via Xfcc
2897  #----------------------------------------------------------------------
2898  proc FetchGames {} {
2899  global ::CorrespondenceChess::Inbox ::CorrespondenceChess::XfccFetchcmd ::CorrespondenceChess::CorrSlot
2900  busyCursor .
2901 
2902  # Regardless how the user opened this DB, find it! ;)
2904  # Only proceed if a correspondence DB is already loaded
2905  if {$CorrSlot > -1} {
2906  if {$::CorrespondenceChess::XfccInternal == 1} {
2907  # use internal Xfcc-handling
2908  ::Xfcc::ReadConfig $::CorrespondenceChess::xfccrcfile
2909  ::Xfcc::ProcessAll $::CorrespondenceChess::Inbox
2910  } else {
2911  # call external protocol handler
2912  if {[file executable "$XfccFetchcmd"]} {
2913  ::CorrespondenceChess::updateConsole "info Calling external fetch tool $XfccFetchcmd..."
2914  CallExternal "$XfccFetchcmd $Inbox"
2915  }
2916  }
2917  # Fetch games that should be relayed from the ICCF Server
2918  ::CorrespondenceChess::updateConsole "info Fetching relayed games from ICCF..."
2919  foreach g $::CorrespondenceChess::RelayGames {
2921  }
2922  # process what was just retrieved
2924  }
2925  unbusyCursor .
2926  }
2927 
2928  #----------------------------------------------------------------------
2929  # EmptyInOutbox: remove all pgn files currently stored in in- and
2930  # outbox directories to get a fresh fetch
2931  #----------------------------------------------------------------------
2932  proc EmptyInOutbox {} {
2933  global ::CorrespondenceChess::Inbox ::CorrespondenceChess::Outbox
2934  global windowsOS
2935 
2936  if {$windowsOS} {
2937  set inpath "$Inbox\\"
2938  set outpath "$Outbox\\"
2939  } else {
2940  set inpath "$Inbox/"
2941  set outpath "$Outbox/"
2942  }
2943  set result [tk_dialog .roDialog "Scid: [tr CCDlgDeleteBoxes]" \
2944  $::tr(CCDlgDeleteBoxesText) "" 1 $::tr(Yes) $::tr(No)]
2945  if {$result == 0} {
2946  foreach f [glob -nocomplain [file join $inpath *]] {
2947  file delete $f
2948  }
2949  foreach f [glob -nocomplain [file join $outpath *]] {
2950  file delete $f
2951  }
2952  set filename [scidConfigFile xfccstate]
2953  file delete $filename
2954 
2955  # clean also status information as they're now invalid!
2956  set ::Xfcc::xfccstate {}
2957 
2959  }
2960 
2961  }
2962 
2963  #----------------------------------------------------------------------
2964  # ReadInbox: process the inbox game per game by adding them one by
2965  # one to the clipboard.
2966  #----------------------------------------------------------------------
2967  proc ReadInbox {} {
2968  global ::CorrespondenceChess::Inbox ::CorrespondenceChess::CorrSlot
2969  global ::CorrespondenceChess::glccstart ::CorrespondenceChess::glgames windowsOS
2970  global ::Xfcc::lastupdate ::Xfcc::xfccstate
2971 
2972  set pgnopen 0
2973 
2974  busyCursor .
2975 
2976  if {$windowsOS} {
2977  set inpath "$Inbox\\"
2978  } else {
2979  set inpath "$Inbox/"
2980  }
2981 
2982  # Regardless how the user opened this DB, find it! ;)
2984 
2985  set games 0
2986  if {$CorrSlot > -1} {
2987 
2988  # extract the number of the last move using Scid's internal
2989  # PGN parser as comments etc. might appear, and this number
2990  # is not given via Xfcc. Similar for the event date.
2991  sc_clipbase clear
2992  sc_base switch $::clipbase_db"
2993  set game 0
2994  set gamemoves {}
2995  foreach f [glob -nocomplain [file join $inpath *]] {
2996  catch {sc_base import [sc_base current] $f}
2997  set game [expr {$game + 1}]
2998  sc_game load $game
2999  sc_move end
3000  set number [sc_pos moveNumber]
3001  set Date [sc_game tags get Date]
3002  set Extra [sc_game tags get Extra]
3003  set extraTagsList [split $Extra "\n"]
3004  foreach i $extraTagsList {
3005  if { [string equal -nocase [lindex $i 0] "CmailGameName"] } {
3006  set CmailGameName [string range $i 15 end-1]
3007  }
3008  }
3009  lappend gamemoves [list $CmailGameName $number $Date]
3010  }
3011 
3012  # generate a list of games retrieved by Xfcc. Add game-ID and
3013  # timing to two lists: one holds all games and one holds
3014  # those the user does not have the move (they may be skipped
3015  # in display)
3016  set xfcclist {}
3017  set filelist {}
3018  set skiplist {}
3019  set sortmode "-ascii"
3020 
3021  foreach xfccextra $::Xfcc::xfccstate {
3022  set CmailGameName [lindex $xfccextra 0]
3023  set criterion 0
3024  set timepermove 0
3025  set mytime 0
3026  set opptime 0
3027  set movestoTC 1
3028  set tincrement 0
3029  set moves 0
3030  set myTurn "false"
3031  set TimeControl "10/50"
3032  set idx [lsearch -exact -index 0 $gamemoves $CmailGameName]
3033  set number [lindex [lindex $gamemoves $idx] 1]
3034  set Date [lindex [lindex $gamemoves $idx] 2]
3035  regsub -all {\.} $Date "" Date
3036 
3037  foreach i $xfccextra {
3038  if { [string equal -nocase [lindex $i 0] "myTurn"] } {
3039  set myTurn [string range $i 7 end]
3040  }
3041  if { [string equal -nocase [lindex $i 0] "mytime"] } {
3042  set mytime [string range $i 7 end]
3043  }
3044  if { [string equal -nocase [lindex $i 0] "opptime"] } {
3045  set opptime [string range $i 8 end]
3046  }
3047  if { [string equal -nocase [lindex $i 0] "TimeControl"] } {
3048  set TCstr [string range $i 13 end]
3049  # Calculate the moves to the next time control.
3050  # Makes sense only if no Fischer Clock is used.
3051  if { [regexp {/} $TCstr]} {
3052  set TC [split $TCstr "/"]
3053  set moves [ lindex $TC 0]
3054  set tincrement [ lindex $TC 1]
3055  regsub -all "d.*" $tincrement "" tincrement
3056  set movestoTC [ expr {$moves - ($number % $moves)}]
3057  } else {
3058  # Fischer Clock
3059  set moves 1
3060  }
3061  }
3062  }
3063  set mytime [expr {int($mytime / 60.0 / 24.0)}]
3064 
3065  # Calculate the time per move till next TC: include also
3066  # the next time control periode in this calculation
3067  set timepermove1 [expr {($mytime+$tincrement) / ($movestoTC+$moves)}]
3068  set timepermove2 [expr {$mytime / $movestoTC}]
3069 
3070  # Time per move is the minimum of the two above
3071  set timepermove [expr min($timepermove1, $timepermove2)]
3072 
3073  # Define criteria to be added to the list to sort. Classic
3074  # mode is handled below by resorting the clipbase
3075  switch -regexp -- $::CorrespondenceChess::ListOrder \
3076  "$::CorrespondenceChess::CCOrderMyTime" {
3077  set criterion $mytime
3078  set sortmode "-integer"
3079  } \
3080  "$::CorrespondenceChess::CCOrderOppTime" {
3081  set criterion $opptime
3082  set sortmode "-integer"
3083  } \
3084  "$::CorrespondenceChess::CCOrderTimePerMove" {
3085  set criterion $timepermove
3086  set sortmode "-real"
3087  } \
3088  "$::CorrespondenceChess::CCOrderStartDate" {
3089  set criterion $Date
3090  set sortmode "-integer"
3091  }
3092 
3093  if {($myTurn == "false") && ($::CorrespondenceChess::ListOnlyOwnMove == 1) } {
3094  lappend skiplist [list $CmailGameName $criterion]
3095  } else {
3096  lappend filelist [list $CmailGameName $criterion]
3097  }
3098  lappend xfcclist [list $CmailGameName]
3099  }
3100 
3101  # sort file list by mytime, ascending
3102  set filelist [lsort -index 1 "$sortmode" $filelist]
3103  set skiplist [lsort -index 1 "$sortmode" $skiplist]
3104 
3106  sc_clipbase clear
3107  sc_base switch $::clipbase_db
3108 
3109  # Loop over all files and add all game files that are not
3110  # Xfcc (ie. eMail chess)
3111  foreach f [glob -nocomplain [file join $inpath *]] {
3112  set id [file tail $f]
3113  regsub -all ".pgn" $id "" id
3114  if { [lsearch $xfcclist "$id"] < 0 } {
3115  set filelist [concat $id $filelist]
3116  }
3117  }
3118 
3119  # import the games on basis of the sorted list created above
3120  foreach f $filelist {
3121  set filename "[file join $inpath [lindex $f 0]].pgn"
3122  if {[catch {sc_base import [sc_base current] $filename} result]} {
3123  ::CorrespondenceChess::updateConsole "info Error retrieving server response from $filename"
3124  } else {
3125  # count the games processed successfully
3126  set games [expr {$games+1}]
3127  }
3128  }
3129 
3130  set glgames $games
3131 
3132  # For Classic sorting: sort the clipbase, this is easier
3133  # to implement than individual sorting upon import.
3134  if {$::CorrespondenceChess::ListOrder == $::CorrespondenceChess::CCOrderClassic} {
3135  tk_messageBox -message "oops, 300+ lines functions are not maintainable"
3136  }
3137 
3138 
3139  if {$glgames > 0} {
3140  # work through all games processed and fill in the gamelist
3141  # in the console window
3142 
3143  for {set game $glccstart} {$game < [expr {$games+1}]} {incr game} {
3144 
3145  set clockW "no update"; set clockB "no update";
3146  set var ""; set noDB "";
3147  set noBK ""; set noTB "";
3148  set noENG ""; set mess ""
3149  set TC ""; set drawoffer "false";
3150  set wc ""; set bc "";
3151  set YM " ? ";
3152 
3153  sc_base switch $::clipbase_db
3154  sc_game load $game
3155  # get the header
3156  set Event [sc_game tags get Event]
3157  set Site [sc_game tags get Site]
3158  set Date [sc_game tags get Date]
3159  set White [sc_game tags get White]
3160  set Black [sc_game tags get Black]
3161  set Result [sc_game tags get Result]
3162  set Extra [sc_game tags get Extra]
3163  # CmailGameName is an extra header :(
3164  set extraTagsList [split $Extra "\n"]
3165  foreach i $extraTagsList {
3166  if { [string equal -nocase [lindex $i 0] "CmailGameName"] } {
3167  set CmailGameName [string range $i 15 end-1]
3168  }
3169  }
3170  #
3171  # Switch to the real database to retrieve locally
3172  # stored additions like addresses, countries etc.
3173  # Disable refresh for SearchGame to speed up the list
3174  # building considerably
3175  SearchGame $Event $Site $White $Black $CmailGameName $result 0
3176  sc_base switch $CorrSlot
3177  set Extra [sc_game tags get Extra]
3178  set extraTagsList [split $Extra "\n"]
3179 
3180  # ... extract it as it contains the unique ID
3181  foreach i $extraTagsList {
3182  if { [string equal -nocase [lindex $i 0] "CmailGameName"] } {
3183  set CmailGameName [string range $i 15 end-1]
3184  }
3185  if { [string equal -nocase [lindex $i 0] "Mode"] } {
3186  set Mode [string range $i 6 end-1]
3187  }
3188  if { [string equal -nocase [lindex $i 0] "whiteCountry"] } {
3189  set wc [string range $i 14 end-1]
3190  set wc [string tolower $wc]
3191  set wc "flag_$wc"
3192  }
3193  if { [string equal -nocase [lindex $i 0] "blackCountry"] } {
3194  set bc [string range $i 14 end-1]
3195  set bc [string tolower $bc]
3196  set bc "flag_$bc"
3197  }
3198  if { [string equal -nocase [lindex $i 0] "WhiteCountry"] } {
3199  set wc [string range $i 14 end-1]
3200  set wc [string tolower $wc]
3201  set wc "flag_$wc"
3202  }
3203  if { [string equal -nocase [lindex $i 0] "BlackCountry"] } {
3204  set bc [string range $i 14 end-1]
3205  set bc [string tolower $bc]
3206  set bc "flag_$bc"
3207  }
3208  if { [string equal -nocase [lindex $i 0] "TimeControl"] } {
3209  set TC [string range $i 13 end-1]
3210  }
3211  }
3212  sc_move end
3213  set number [sc_pos moveNumber]
3214  set move [sc_game info previousMoveNT]
3215  set side [sc_pos side]
3216 
3217  if {$side == "white"} {
3218  set number [expr {$number-1}]
3219  set lastmove "$number...$move"
3220  } else {
3221  set lastmove "$number. $move"
3222  }
3223  ::CorrespondenceChess::updateConsole "info TC (base): $TC..."
3224 
3225  if {$Mode == "EM"} {
3226  ::CorrespondenceChess::updateGamelist $CmailGameName "EML" \
3227  $Event $Site $Date $White $Black "" "" "" "" $TC "" "" \
3228  $wc $bc "" "" $lastmove "false"
3229  } elseif {$Mode == "Relay"} {
3230  ::CorrespondenceChess::updateGamelist $CmailGameName "REL" \
3231  $Event $Site $Date $White $Black "" "" "" "" $TC "" "" \
3232  $wc $bc "" "" $lastmove "false"
3233  } elseif {$Mode == "Postal"} {
3234  ::CorrespondenceChess::updateGamelist $CmailGameName "POS" \
3235  $Event $Site $Date $White $Black "" "" "" "" $TC "" "" \
3236  $wc $bc "" "" $lastmove "false"
3237  } else {
3238  # actually check the $xfccstate list for the current
3239  # values. If it is not set (e.g. only inbox processed
3240  # buy no current retrieval) set some default values.
3241  foreach xfccextra $::Xfcc::xfccstate {
3242  if { [string equal -nocase [lindex $xfccextra 0] "$CmailGameName"] } {
3243  foreach i $xfccextra {
3244  if { [string equal -nocase [lindex $i 0] "myTurn"] } {
3245  if {[string range $i 7 end] == "true"} {
3246  set YM "yes"
3247  } else {
3248  set YM "no"
3249  }
3250  }
3251  if { [string equal -nocase [lindex $i 0] "clockW"] } {
3252  set clockW [string range $i 7 end]
3253  regsub -all "\{" $clockW "" clockW
3254  regsub -all "\}" $clockW "" clockW
3255  }
3256  if { [string equal -nocase [lindex $i 0] "clockB"] } {
3257  set clockB [string range $i 7 end]
3258  regsub -all "\{" $clockB "" clockB
3259  regsub -all "\}" $clockB "" clockB
3260  }
3261  if { [string equal -nocase [lindex $i 0] "drawOffered"] } {
3262  set drawoffer [string range $i 12 end]
3263  }
3264  if { [string equal -nocase [lindex $i 0] "variant"] } {
3265  set var [string range $i 8 end]
3266  }
3267  if { [string equal -nocase [lindex $i 0] "noDatabases"] } {
3268  set noDB [string range $i 12 end]
3269  }
3270  if { [string equal -nocase [lindex $i 0] "noOpeningBooks"] } {
3271  set noBK [string range $i 15 end]
3272  }
3273  if { [string equal -nocase [lindex $i 0] "noTablebases"] } {
3274  set noTB [string range $i 13 end]
3275  }
3276  if { [string equal -nocase [lindex $i 0] "noEngines"] } {
3277  set noENG [string range $i 10 end]
3278  }
3279  if { [string equal -nocase [lindex $i 0] "TimeControl"] } {
3280  set TC [string range $i 13 end-1]
3281  }
3282  if { [string equal -nocase [lindex $i 0] "message"] } {
3283  set mess [string range $i 9 end-1]
3284  }
3285  }
3286  }
3287  }
3288  if {$Result == "1"} {
3289  set YM "1-0"
3290  } elseif {$Result == "0"} {
3291  set YM "0-1"
3292  } elseif {$Result == "="} {
3293  set YM " = "
3294  }
3295  ::CorrespondenceChess::updateConsole "info TC (xfcc): $TC..."
3296  ::CorrespondenceChess::updateGamelist $CmailGameName $YM \
3297  $Event $Site $Date $White $Black $clockW $clockB $var \
3298  $noDB $noBK $noTB $noENG $wc $bc $mess $TC $lastmove $drawoffer
3299  }
3300  }
3301  # ::CorrespondenceChess::num is the game currently shown
3302  set ::CorrespondenceChess::num 0
3303  # current game is game 0 -> go to game 1 in the list
3305  } else {
3306  set Title [::tr CCDlgTitNoGames]
3307  set Error [::tr CCErrInboxDir]
3308  append Error "\n $Inbox\n"
3309  append Error [::tr CCErrNoGames]
3310  tk_messageBox -icon warning -type ok -parent . \
3311  -title $Title -message $Error
3312  }
3313  }
3314  unbusyCursor .
3315  }
3316 
3317  #----------------------------------------------------------------------
3318  # Send the move to the opponent via eMail
3319  # This requires an external MTA that is capable of sending a pgn file
3320  # as attachment (content-type: application/x-chess-pgn). This can be
3321  # accomplished by nail with proper /etc/mime.types (default on debian).
3322  # Additionally the program has to handle SMTP-Auth in all its flavours
3323  # to be of any use in present days.
3324  # A stripped version of the game is placed in outbox and sent to the
3325  # opponent. As nail does not handle empty bodies it is sent as text
3326  # within the body and once attached for easy extraction with mail
3327  # programs that do not know a thing about piping.
3328  # After the mail is sent a full featured version of the pgn is placed
3329  #----------------------------------------------------------------------
3330  proc eMailMove { } {
3331  global ::CorrespondenceChess::Outbox \
3332  ::CorrespondenceChess::mailer ::CorrespondenceChess::mailermode \
3333  ::CorrespondenceChess::attache ::CorrespondenceChess::subject \
3334  ::CorrespondenceChess::bccaddr ::CorrespondenceChess::CorrSlot
3335  global emailData
3336  global windowsOS
3337 
3338  busyCursor .
3339 
3340  # Regardless how the user opened this DB, find it! ;)
3342 
3343  if {$CorrSlot > -1} {
3344  # move to end to show the location to send AND to get the right
3345  # side to move, ie. for the extraction of the correct To: address
3346  ::move::End
3347  set Event [sc_game tags get Event]
3348  set Site [sc_game tags get Site]
3349  set Date [sc_game tags get Date]
3350  set Round [sc_game tags get Round]
3351  set Result [sc_game tags get Result]
3352  set White [sc_game tags get White]
3353  set Black [sc_game tags get Black]
3354  set Extra [sc_game tags get Extra]
3355  set Extra [sc_game tags get Extra]
3356  set extraTagsList [split $Extra "\n"]
3357 
3358  foreach i $extraTagsList {
3359  if { [string equal -nocase [lindex $i 0] "CmailGameName"] } {
3360  set CmailGameName [string range $i 15 end-1]
3361  }
3362  if { [string equal -nocase [lindex $i 0] "WhiteNA"] } {
3363  set WhiteNA [string range $i 9 end-1]
3364  }
3365  if { [string equal -nocase [lindex $i 0] "BlackNA"] } {
3366  set BlackNA [string range $i 9 end-1]
3367  }
3368  }
3369 
3370  # construct a PGN in Outbox, stripped bare of comments and variations
3371  set pgnfile "[file join $Outbox $CmailGameName].pgn"
3372 
3373  sc_base export "current" "PGN" $pgnfile -append 0 -comments 0 -variations 0 \
3374  -space 1 -symbols 0 -indentC 0 -indentV 0 -column 0 -noMarkCodes 0 -convertNullMoves 1
3375 
3376  # sc_game pgn -gameNumber $i -width 70 -tags 0 -variations 0 -comments 0]
3377 
3378  # try to handle some obscure problem that the file is not
3379  # existent yet when calling the mailer
3380  while {! [file exists $pgnfile]} {
3381  after 1500 puts "waiting..."
3382  }
3383  # send the game to the side to move
3384  set toMove [sc_pos side]
3385 
3386  if {$toMove == "white"} {
3387  set to $WhiteNA
3388  set from $BlackNA
3389  } else {
3390  set from $WhiteNA
3391  set to $BlackNA
3392  }
3393 
3394  # get rid of spaces in names by using Windows internal real names
3395  if {$windowsOS} {
3396  catch {set mailer [file attributes $mailer -shortname]}
3397  }
3398 
3399  set title "scid mail 1 game ($CmailGameName)"
3400  set body "Final FEN: "
3401  append body [sc_pos fen]
3402  append body "\n\n"
3403  append body "Move List: "
3404  append body [sc_game moves]
3405  append body "\n\n"
3406 
3407  # Check what calling convention to use:
3408  # - mailx : something like mailx, mutt, nail or whatever via
3409  # commandline. This sends the mail without further
3410  # intervention by the user
3411  # - mozilla: call a mozilla or descendent like icedove or
3412  # thunderbird. This syntax is found somewhere in the
3413  # developers docs and almost entirely undocumented
3414  # - mailurl: the same syntax as for mailto:-links in webpages
3415  # (rfc 2368). This calling convention is supported by
3416  # evolution
3417  # -claws : Claws mailer, seems to be almost mailurl, but needs
3418  # a parameter for attachments
3419  switch -regexp -- $::CorrespondenceChess::mailermode \
3420  "mailx" {
3421  set callstring "$mailer $subject \"$title\" -b $bccaddr $attache \"$pgnfile\" $to <\"$pgnfile\""
3422  } \
3423  "mozilla" {
3424  if {$windowsOS} {
3425  set callstring "$mailer -compose subject='$title',bcc=$bccaddr,attachment='file:///$pgnfile',to=$to,body=$body"
3426  } else {
3427  set callstring "$mailer -compose subject='$title',bcc=$bccaddr,attachment='file://$pgnfile',to='$to',body='$body'"
3428  }
3429  } \
3430  "mailurl" {
3431  set callstring "$mailer \'mailto:<$to>?bcc=$bccaddr\&subject=$title\&attach=$pgnfile\&body=$body\'"
3432  } \
3433  "claws" {
3434  set callstring "$mailer --compose \'mailto:$to?subject=$title&cc=$bccaddr&body=$body\' --attach \"$pgnfile\""
3435  }
3436  ::CorrespondenceChess::updateConsole "info Calling eMail program: $mailer..."
3437  CallExternal $callstring
3438 
3439  # Save the game once the move is sent
3440  set num [sc_game number]
3441  sc_game save $num
3442 
3443  # Hook up with email manager: search the game in its internal
3444  # list and add the send flag automatically.
3445  set done 0
3446  set idx 0
3447  foreach dataset $emailData {
3448  if { [lindex $dataset 0] == $CmailGameName} {
3449  set done 1
3450  # add the sent flag and date
3452  }
3453  incr idx
3454  }
3455  }
3456 
3457  unbusyCursor .
3458  }
3459 
3460  #----------------------------------------------------------------------
3461  # Send the move to the opponent via XFCC or eMail
3462  #----------------------------------------------------------------------
3463  proc SendMove {resign claimDraw offerDraw acceptDraw } {
3464  global ::CorrespondenceChess::Outbox
3465  global ::CorrespondenceChess::XfccSendcmd
3466  global ::CorrespondenceChess::CorrSlot
3467  global ::CorrespondenceChess::XfccConfirm
3468  global ::CorrespondenceChess::num
3469 
3470  busyCursor .
3471 
3473  if {$CorrSlot > -1} {
3474  sc_move end
3475 
3476  set Extra [sc_game tags get Extra]
3477  set extraTagsList [split $Extra "\n"]
3478 
3479  # ... extract it as it contains the unique ID
3480  foreach i $extraTagsList {
3481  if { [string equal -nocase [lindex $i 0] "CmailGameName"] } {
3482  set CmailGameName [string range $i 15 end-1]
3483  }
3484  if { [string equal -nocase [lindex $i 0] "WhiteAddress"] } {
3485  set WhiteAdr [split [string range $i 14 end-1] ";"]
3486  set WhiteAdr [split [string range $i 14 end-1] ";"]
3487  }
3488  if { [string equal -nocase [lindex $i 0] "BlackAddress"] } {
3489  set BlackAdr [string range $i 14 end-1]
3490  set BlackAdr [split [string range $i 14 end-1] ";"]
3491  }
3492  }
3493 
3494  set pgnfile "[file join $Outbox $CmailGameName].pgn"
3495 
3496  set IdList [split $CmailGameName "-"]
3497  set name [lindex $IdList 0]
3498  set gameid [lindex $IdList 1]
3499  set movecount [sc_pos moveNumber]
3500  set ply [sc_pos location]
3501  set move [sc_game info previousMoveNT]
3502  set comment [sc_pos getComment]
3503  set Event [sc_game tags get Event]
3504 
3505  # Throw away everything in [] as often as it exists
3506  # This matches [%ccsnt] as well as scid marker codes
3507  regsub -all {\[[^\]]*\]} $comment {} comment
3508 
3509  # moveNumber gives the number of the next full move. This is
3510  # one to high in case of playing black. Note that for this
3511  # ply it is _white_ to move!
3512  if {[sc_pos side] == "white"} {
3513  set movecount [expr {$movecount-1}]
3514  }
3515 
3516  # Mark the ID background:
3517  # yellow while sending in progress,
3518  # green if the move was sent in the
3519  # current session (ie. without update)
3520  .ccWindow.bottom.id tag add hlsent$CmailGameName $num.0 [expr {$num+1}].0
3521  .ccWindow.bottom.id tag configure hlsent$CmailGameName -background yellow -font font_Bold
3522 
3523  set DlgBoxText "[::tr CCDlgConfirmMoveText]\n\n$name-$gameid:\n\t$movecount. $move\n\t{$comment}"
3524  if {$resign == 1} {
3525  set DlgBoxText "$DlgBoxText\n\n[::tr CCResign]"
3526  # When resigning usually no move is made before.
3527  # Therefore, we have to increase the ply by one (faking a
3528  # move) and recalculate the resulting move number if White
3529  # is to move.
3530  # This gives:
3531  # 1. e4 <resign> => ply 2 => no ply increment => move
3532  # number = 1, move number to send = 1
3533  # 1. e4 e5 <resign> => increment ply => ply = 3 => move
3534  # number = 1, move number to send = 2
3535  if {[sc_pos side] == "white"} {
3536  set movecount [expr {$ply / 2 + 1}]
3537  ::CorrespondenceChess::updateConsole "info Increment ply $movecount"
3538  }
3539  } elseif {$acceptDraw == 1} {
3540  set DlgBoxText "$DlgBoxText\n\n[::tr CCAcceptDraw]"
3541  } elseif {$offerDraw == 1} {
3542  set DlgBoxText "$DlgBoxText\n\n[::tr CCofferDraw]"
3543  } elseif {$claimDraw == 1} {
3544  set DlgBoxText "$DlgBoxText\n\n[::tr CCClaimDraw]"
3545  }
3546 
3547  set result 0
3548  if {$::CorrespondenceChess::XfccConfirm == 1} {
3549  set result [tk_dialog .roDialog "Scid: [tr CCDlgConfirmMove]" \
3550  $DlgBoxText "" 1 $::tr(Yes) $::tr(No)]
3551  }
3552  if {$result == 0} {
3553  # Go to the last move is important to send the comment for
3554  # the last move only not the comment for the current game
3555  # position!
3556 
3557  # If Event = "Email correspondence game"
3558  # treat it as cmail game that is send by mail, otherwise it is
3559  # Xfcc and sent accordingly
3561  if {$Mode == "EM"} {
3562  eMailMove
3563  } elseif {$Mode == "XFCC"} {
3564 
3565  if {$::CorrespondenceChess::XfccInternal == 1} {
3566  # use internal Xfcc-handling
3567  ::Xfcc::ReadConfig $::CorrespondenceChess::xfccrcfile
3568  ::Xfcc::Send $name $gameid $movecount $move $comment \
3569  $resign $acceptDraw $offerDraw $claimDraw
3570  } else {
3571  if {[file executable "$XfccSendcmd"]} {
3572  set callstring "$XfccSendcmd $Outbox $name $gameid $movecount $move \"$comment\" $resign $claimDraw $offerDraw $acceptDraw &"
3573 
3574  ::CorrespondenceChess::updateConsole "info Spawning external send tool $XfccSendcmd..."
3575  CallExternal $callstring
3576  }
3577  }
3578  } elseif {$Mode == "Postal"} {
3579  # produce a postcard
3580  }
3581 
3582  # Save the game once the move is sent
3583  sc_game save [sc_game number]
3584 
3585  # setting "noMarkCodes" to 1 would drop the timing comments
3586  # inserted e.g. by SchemingMind. Do not overwrite eMail based
3587  # games as the mailer might not have sent them and most
3588  # mailers load the file right before transmission.
3589  if {!(($Mode == "EM") || ($Mode == "Relay"))} {
3590  sc_base export "current" "PGN" $pgnfile -append 0 -comments 1 -variations 1 \
3591  -space 1 -symbols 1 -indentC 0 -indentV 0 -column 0 -noMarkCodes 0 -convertNullMoves 1
3592  }
3593 
3594  # Everything done, set background to green
3595  .ccWindow.bottom.id tag configure hlsent$CmailGameName -background green -font font_Bold
3596  } else {
3597  # mark games with unconfirmed moves in gray:
3598  .ccWindow.bottom.id tag configure hlsent$CmailGameName -background gray -font font_Small
3599  }
3600  }
3601  unbusyCursor .
3602  }
3603 
3604  #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3605  # source the options file to overwrite the above setup
3606  if {[catch {source [scidConfigFile correspondence]}]} {
3607  #::splash::add "Unable to find the options file: [file tail $optionsFile]"
3608  } else {
3609  ::splash::add "Correspondence Chess configuration was found and loaded."
3610  }
3611 
3612  if {[catch { package require http}]} {
3613  ::splash::add "http package not found, disabling internal Xfcc support"
3614  set XfccInternal -1
3615  } else {
3616  ::http::config -useragent $::Xfcc::useragent
3617  if {![catch { package require tls}]} {
3618  ::tls::init -ssl3 false -ssl2 false -tls1 true
3619  http::register https 443 ::tls::socket
3620  }
3621  }
3622 
3623  if {[catch {package require tdom}]} {
3624  ::splash::add "tDOM package not found, disabling internal Xfcc support"
3625  set XfccInternal -1
3626  }
3627 
3631  #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3632 }
3633 
3634 
3635 ###
3636 ### End of file: Correspondence.tcl
3637 ###