Scid  4.6.5
start.tcl
Go to the documentation of this file.
1 #!/bin/sh
2 
3 # Scid (Shane's Chess Information Database)
4 #
5 # Copyright (C) 1999-2004 Shane Hudson
6 # Copyright (C) 2006-2009 Pascal Georges
7 # Copyright (C) 2008-2011 Alexander Wagner
8 # Copyright (C) 2013-2015 Fulvio Benini
9 #
10 # Scid is free software: you can redistribute it and/or modify
11 # it under the terms of the GNU General Public License as published by
12 # the Free Software Foundation.
13 
14 #
15 # The following few comments are only for Unix versions of Scid:
16 #
17 
18 # The "\" at the end of the comment line below is necessary! It means
19 # that the "exec" line is a comment to Tcl/Tk, but not to /bin/sh.
20 # The next line restarts using tkscid: \
21 exec `dirname $0`/tkscid "$0" "$@"
22 # exec tkscid "$0" "$@"
23 
24 # The above launches tkscid from the same directory that this startup
25 # script was launched from (which feels as a suitable default scenario).
26 # Alternatively, you can change the top line of this startup script
27 # to start tkscid directly from a specific location, e.g.:
28 
29 # For the above to work, tkscid must be in a directory in your PATH.
30 # Alternatively, you can set the first line to start tkscid directly
31 # by specifying the full name of tkscid, eg:
32 # #!/home/myname/bin/tkscid
33 
34 ############################################################
35 
36 package require Tcl 8.5
37 package require Tk 8.5
38 if {$tcl_version == 8.5} { catch {package require img::png}}
39 
40 set scidVersion [sc_info version]
41 set scidVersionDate [sc_info version date]
42 set scidVersionExpected "4.6.5"
43 
44 # Check that the version of c++ code matches the version of tcl code
45 #
46 if {[string compare $::scidVersion $::scidVersionExpected]} {
47  wm withdraw .
48  set msg "This is Scid version $::scidVersion, but the scid GUI (tcl/tk code)\n"
49  append msg "has the version number $scidVersionExpected.\n"
50  tk_messageBox -type ok -icon error -title "Scid: Version Error" -message $msg
51  exit 1
52 }
53 
54 # Determine operating system platform: unix, windows or macos
55 #
56 set windowsOS 0
57 if {$tcl_platform(platform) == "windows"} { set windowsOS 1}
58 set unixOS 0
59 if {$tcl_platform(platform) == "unix"} { set unixOS 1}
60 set macOS 0
61 if {![catch {tk windowingsystem} wsystem] && $wsystem == "aqua"} { set macOS 1}
62 
63 proc InitDirs {} {
64  global scidExeDir scidUserDir scidConfigDir scidDataDir scidLogDir scidShareDir scidImgDir scidTclDir
65  global scidBooksDir scidBasesDir ecoFile
66 
67  # scidExeDir: contains the directory of the Scid executable program.
68  # Used to determine the location of various relative data directories.
69  set scidExecutable [info nameofexecutable]
70  if {[file type $scidExecutable] == "link"} {
71  set scidExeDir [file dirname [file readlink $scidExecutable]]
72  if {[file pathtype $scidExeDir] == "relative"} {
73  set scidExeDir [file dirname [file join [file dirname $scidExecutable]\
74  [file readlink $scidExecutable]]]
75  }
76  } else {
77  set scidExeDir [file dirname $scidExecutable]
78  }
79 
80  # scidUserDir: location of user-specific Scid files.
81  # This is "~/.scid" on Unix, and the Scid executable dir on Windows.
82  if {$::windowsOS} {
83  set scidUserDir $scidExeDir
84  } else {
85  regexp {(\d+\.\d+).*} $::scidVersion -> version
86  set scidUserDir [file nativename "~/.scid$version"]
87  }
88 
89  # scidConfigDir, scidDataDir, scidLogDir:
90  # Location of Scid configuration, data and log files.
91  set scidConfigDir [file nativename [file join $scidUserDir "config"]]
92  set scidDataDir [file nativename [file join $scidUserDir "data"]]
93  set scidLogDir [file nativename [file join $scidUserDir "log"]]
94 
95  # scidShareDir, scidImgDir, scidTclDir, scidBooksDir, scidBasesDir, ecoFile:
96  # Location of Scid resources
97  set scidShareDir [file normalize [file join $scidExeDir "../share/scid"]]
98  if {! [file isdirectory $::scidShareDir]} {
99  set scidShareDir $::scidExeDir
100  }
101  set scidTclDir [file nativename [file join $scidShareDir "tcl"]]
102  if {! [file isdirectory $scidTclDir]} {
103  set scidTclDir [file dirname [info script]]
104  set scidShareDir [file normalize "$scidTclDir/../"]
105  }
106  set scidImgDir [file nativename [file join $scidShareDir "img"]]
107 
108  #Default values, can be overwritten by file option
109  set scidBooksDir [file nativename [file join $scidShareDir "books"]]
110  set scidBasesDir [file nativename [file join $scidShareDir "bases"]]
111  set ecoFile [file nativename [file join $scidShareDir "scid.eco"]]
112 
113  proc moveOldConfigFiles {} {
114  # Moves configuration files from the old (3.4 and earlier) names
115  # to the new file names used since Scid 3.5.
116  global scidUserDir scidConfigDir
117 
118  # Since the options file used to be ".scid", rename it:
119  if {[file isfile $scidUserDir]} {
120  file rename -force $scidUserDir "$scidUserDir.old"
121  }
122 
123  # Rename old "~/.scid_sent_emails" if necessary:
124  if {[file isfile [file nativename "~/.scid_sent_emails"]]} {
125  catch {file rename [file nativename "~/.scid_sent_emails"] $email(logfile)}
126  }
127 
128  foreach {oldname newname} {
129  scidrc options.dat
130  scid.opt options.dat
131  scid.bkm bookmarks.dat
132  scid.rfl recentfiles.dat
133  engines.lis engines.dat
134  } {
135  set oldpath [file nativename [file join $scidUserDir $oldname]]
136  set newpath [file nativename [file join $scidConfigDir $newname]]
137  if {[file readable $oldpath] && ![file readable $newpath]} {
138  if {[catch {file rename $oldpath $newpath} err]} {
139  tk_messageBox -message "Error moving $oldpath to $newpath: $err"
140  }
141  }
142  }
143  }
145 
146  # Create the config, data and log directories if they do not exist:
147  proc makeScidDir {dir} {
148  if {! [file isdirectory $dir]} {
149  file mkdir $dir
150  }
151  }
152  makeScidDir $scidUserDir
153  makeScidDir $scidConfigDir
154  makeScidDir $scidDataDir
155  makeScidDir $scidLogDir
156 }
157 InitDirs
158 
159 #############################################################
160 #
161 # NAMESPACES
162 #
163 # The main Tcl/Tk namespaces used in the Scid application are
164 # initialized here, so that default values can be set up and
165 # altered when the user options file is loaded.
166 #
167 foreach ns {
168  ::splash
169  ::utils
170  ::utils::date ::utils::font ::utils::history ::utils::pane ::utils::string
171  ::utils::sound ::utils::validate ::utils::win
172  ::file
173  ::file::finder ::file::maint ::maint
174  ::bookmarks
175  ::edit
176  ::game
177  ::gbrowser
178  ::search
179  ::search::filter ::search::board ::search::header ::search::material
180  ::windows
181  ::windows::gamelist ::windows::stats ::tree ::tree::mask ::windows::tree
182  ::windows::switcher ::windows::eco ::crosstab ::pgn ::book
183  ::windows::commenteditor
184  ::tools
185  ::tools::analysis ::tools::email
186  ::tools::graphs
187  ::tools::graphs::filter ::tools::graphs::absfilter ::tools::graphs::rating ::tools::graphs::score
188  ::tb ::optable
189  ::board ::move
190  ::tacgame ::sergame ::opening ::tactics ::calvar ::uci ::fics ::reviewgame ::novag
191  ::config ::docking
192  ::pinfo
193  ::unsafe
194  ::utils::tooltip
195 } {
196  namespace eval $ns {}
197 }
198 
199 proc ::splash::add {text} {
200 #TODO: decide what to do with all the splash messages (delete?)
201 }
202 
203 # Platform specific operations
204 if { $unixOS } {
205  # adds a checkbox to show hidden files
206  catch {tk_getOpenFile -with-invalid-argument}
207  namespace eval ::tk::dialog::file {
208  variable showHiddenBtn 1
209  variable showHiddenVar 0
210  }
211 }
212 
213 # Reversed mouse buttons in mac (::MB2 and ::MB3 are middle and right mouse buttons respectively.):
214 if { $macOS } {
215  set ::MB2 3
216  set ::MB3 2
217 } else {
218  set ::MB2 2
219  set ::MB3 3
220 }
221 
222 
223 ####################################################
224 # safeSource() - source a file using a safe interpreter
225 # @filename: the absolute path to the file to source (load and execute)
226 # @args: pairs of varname value that are visible to the sourced code
227 #
228 # This function execute the code inside a safe tcl interpreter and override
229 # "set" to import the variables of the executed code in the ::unsafe namespace.
230 # Attention must be paid to not evaluate ::unsafe vars, for example:
231 # set ::unsafe::badcode {tk_messageBox -message executeme}
232 # eval $::unsafe::badcode
233 # after idle $::unsafe::badcode
234 
235 proc safeSource {filename args} {
236  if {![info exists ::safeInterp]} {
237  set ::safeInterp [::safe::interpCreate]
238  interp hide $::safeInterp set
239  interp alias $::safeInterp set {} ::safeSet $::safeInterp
240  }
241  set f [file nativename "$filename"]
242  set d [file dirname $f]
243  set n [file tail $f]
244  foreach {varname value} $args {
245  $::safeInterp eval [list set $varname $value]
246  }
247  $::safeInterp eval [list set vdir [::safe::interpAddToAccessPath $::safeInterp $d]]
248  $::safeInterp eval "source \$vdir/$n"
249  foreach {varname value} $args {
250  $::safeInterp eval [list unset $varname]
251  }
252 }
253 proc safeSet {i args} {
254  #TODO: do not import local variables
255  #if {[$::safeInterp eval info level] == 0}
256  foreach {varname value} $args {
257  set ::unsafe::$varname $value
258  }
259  interp invokehidden $i set {*}$args
260 }
261 
262 ####################################################
263 # Load default/saved values
264 source [file nativename [file join $::scidTclDir "options.tcl"]]
265 
266 
267 # Check for old (single-directory) tablebase option:
268 if {[info exists initialDir(tablebase)]} {
269  set initialDir(tablebase1) $initialDir(tablebase)
270 }
271 
272 set ::docking::USE_DOCKING $windowsDock
273 
274 proc createFonts {} {
275  foreach name {Regular Menu Small Tiny Fixed} {
276  set opts $::fontOptions($name)
277  font create font_$name \
278  -family [lindex $opts 0] -size [lindex $opts 1] \
279  -weight [lindex $opts 2] -slant [lindex $opts 3]
280  }
281 
282  set fontsize [font configure font_Regular -size]
283  set font [font configure font_Regular -family]
284  font create font_Bold -family $font -size $fontsize -weight bold
285  font create font_BoldItalic -family $font -size $fontsize -weight bold -slant italic
286  font create font_Italic -family $font -size $fontsize -slant italic
287  font create font_H1 -family $font -size [expr {$fontsize + 8}] -weight bold
288  font create font_H2 -family $font -size [expr {$fontsize + 6}] -weight bold
289  font create font_H3 -family $font -size [expr {$fontsize + 4}] -weight bold
290  font create font_H4 -family $font -size [expr {$fontsize + 2}] -weight bold
291  font create font_H5 -family $font -size [expr {$fontsize + 0}] -weight bold
292 
293  set fontsize [font configure font_Small -size]
294  set font [font configure font_Small -family]
295  font create font_SmallBold -family $font -size $fontsize -weight bold
296  font create font_SmallItalic -family $font -size $fontsize -slant italic
297 
298  set ::utils::tooltip::font font_Small
299 }
301 
302 # Load theme
303 ttk::style theme use $::lookTheme
304 
305 # Use default font everywhere
306 ttk::style configure TLabel -font font_Regular
307 ttk::style configure TButton -font font_Regular
308 ttk::style configure TRadiobutton -font font_Regular
309 ttk::style configure TCheckbutton -font font_Regular
310 ttk::style configure TMenubutton -font font_Regular
311 ttk::style configure TCombobox -font font_Regular
312 ttk::style configure TEntry -font font_Regular
313 ttk::style configure TNotebook.Tab -font font_Regular
314 
315 # Style definitions
316 ttk::style configure Bold.TCheckbutton -font font_Bold
317 ttk::style configure Small.TCheckbutton -font font_Small
318 
319 ttk::style configure Small.TButton -font font_Small
320 ttk::style configure Bold.TButton -font font_Bold
321 ttk::style configure Pad0.Small.TButton -padding 0
322 
323 ttk::style configure Small.TRadiobutton -font font_Small
324 ttk::style configure Regular.TRadiobutton -font font_Regular
325 ttk::style configure Bold.TRadiobutton -font font_Bold
326 ttk::style configure SmallBold.TRadiobutton -font font_SmallBold
327 
328 ttk::style configure pad0.TMenubutton -padding 0 -indicatorwidth 0 -indicatorheight 0 -font font_Small
329 
330 # font_Regular is the default font for widgets:
331 option add *Font font_Regular
332 
333 # Use font_Menu for menu entries:
334 option add *Menu*Font font_Menu
335 
336 proc InitImg {} {
337  global scidImgDir boardStyle boardStyles textureSquare
338 
339  #Set app icon
340  set scidIconFile [file nativename [file join $scidImgDir "scid.gif"]]
341  if {[file readable $scidIconFile]} {
342  wm iconphoto . -default [image create photo -file "$scidIconFile"]
343  }
344 
345  #Load all img/buttons/_filename_.gif
346  set dname [file join $::scidImgDir buttons]
347  foreach {fname} [glob -directory $dname *.gif] {
348  set iname [string range [file tail $fname] 0 end-4]
349  image create photo $iname -file $fname
350  }
351 
352  #Load all img/buttons/_filename_.png
353  set dname [file join $::scidImgDir buttons]
354  foreach {fname} [glob -directory $dname *.png] {
355  set iname [string range [file tail $fname] 0 end-4]
356  image create photo $iname -format png -file $fname
357  }
358 
359  #Load all img/boards/_filename_.gif
360  set textureSquare {}
361  set dname [file join $::scidImgDir boards]
362  foreach {fname} [glob -directory $dname *.gif] {
363  set iname [string range [file tail $fname] 0 end-4]
364  image create photo $iname -file $fname
365  if {[string range $iname end-1 end] == "-l"} {
366  lappend textureSquare [string range $iname 0 end-2]
367  }
368  }
369 
370  #Search available piece sets
371  set boardStyles {}
372  set dname [file join $::scidImgDir pieces]
373  foreach {piecetype} [glob -directory $dname *] {
374  if {[file isdirectory $piecetype] == 1} {
375  lappend boardStyles [file tail $piecetype]
376  }
377  }
378 
379  #Load all img/flags/_filename_.gif
380  set dname [file join $::scidImgDir flags]
381  foreach {fname} [glob -directory $dname *.gif] {
382  set iname [string range [file tail $fname] 0 end-4]
383  image create photo $iname -file $fname
384  }
385 }
386 if {[catch {InitImg}]} {
387  tk_messageBox -type ok -icon error -title "Scid: Error" \
388  -message "Cannot load images.\n$::errorCode\n\n$::errorInfo"
389  exit
390 }
391 
392 # Set numeric format
393 sc_info decimal $::locale(numeric)
394 
395 # Start in the clipbase, if no database is loaded at startup.
396 set ::clipbase_db [sc_info clipbase]
397 sc_base switch $::clipbase_db
398 set ::curr_db [sc_base current]
399 
400 
401 set tcl_files {
402 language.tcl
403 errors.tcl
404 utils.tcl
405 utils/date.tcl
406 utils/font.tcl
407 utils/graph.tcl
408 utils/history.tcl
409 utils/pane.tcl
410 utils/sound.tcl
411 utils/string.tcl
412 utils/tooltip.tcl
413 utils/validate.tcl
414 utils/win.tcl
415 misc.tcl
416 htext.tcl
417 file.tcl
418 file/finder.tcl
419 file/bookmark.tcl
420 file/recent.tcl
421 file/spellchk.tcl
422 file/maint.tcl
423 edit.tcl
424 game.tcl
425 windows.tcl
426 windows/browser.tcl
427 windows/gamelist.tcl
428 windows/pgn.tcl
429 windows/book.tcl
430 windows/comment.tcl
431 windows/eco.tcl
432 windows/stats.tcl
433 windows/tree.tcl
434 windows/crosstab.tcl
435 windows/pfinder.tcl
436 windows/tourney.tcl
437 windows/switcher.tcl
438 search/search.tcl
439 search/board.tcl
440 search/header.tcl
441 search/material.tcl
442 contrib/ezsmtp/ezsmtp.tcl
443 tools/email.tcl
444 tools/import.tcl
445 tools/optable.tcl
446 tools/preport.tcl
447 tools/pinfo.tcl
448 tools/analysis.tcl
449 tools/wbdetect.tcl
450 tools/graphs.tcl
451 tools/tablebase.tcl
452 tools/ptracker.tcl
453 help/help.tcl
454 help/tips.tcl
455 keyboard.tcl
456 menus.tcl
457 board.tcl
458 move.tcl
459 main.tcl
460 tools/correspondence.tcl
461 tools/uci.tcl
462 end.tcl
463 tools/tacgame.tcl
464 tools/sergame.tcl
465 tools/calvar.tcl
466 tools/fics.tcl
467 tools/opening.tcl
468 tools/tactics.tcl
469 tools/reviewgame.tcl
470 utils/metadata.tcl
471 tools/inputengine.tcl
472 tools/novag.tcl
473 utils/bibliography.tcl
474 }
475 
476 foreach f $tcl_files {
477  source -encoding utf-8 [file nativename [file join $::scidTclDir "$f"]]
478 }
479 
480 ###
481 ### End of file: start.tcl