Scid  4.6.5
menus.tcl
Go to the documentation of this file.
1 ### Menus.tcl: part of Scid.
2 ### Copyright (C) 2001-2003 Shane Hudson.
3 ### Copyright (C) 2015 Fulvio Benini
4 
5 
6 ############################################################
7 ### Main window menus:
8 
9 option add *Menu*TearOff 0
10 
11 menu .menu
12 
13 ## Mac Application menu has to be before any call to configure.
14 if { $macOS } {
15  # Application menu:
16  .menu add cascade -label Scid -menu .menu.apple
17  menu .menu.apple
18 
19  set m .menu.apple
20 
21  $m add command -label HelpAbout -command helpAbout
22 
23  $m add separator
24 
25  # To Quit
26  bind all <Command-q> "exit"
27  bind all <Command-Q> "exit"
28 
29  ## To get Help
30  bind all <Command-?> {helpWindow Contents}
31  bind all <Help> {helpWindow Contents}
32 }
33 
34 
35 ### File menu:
36 set m .menu.file
37 menu $m -postcommand "updateMenuStates $m"
38 .menu add cascade -label File -menu $m
39 $m add command -label FileNew -command ::file::New
40 $m add command -label FileOpen -acc "Ctrl+O" -command ::file::Open
41 $m add command -label FileFinder -acc "Ctrl+/" -command ::file::finder::Open
42 menu $m.bookmarks
43 $m add cascade -label FileBookmarks -menu $m.bookmarks
44 $m add separator
45 # naming is weird because the menus are moved from Tools to File menus
46 $m add command -label ToolsOpenBaseAsTree -command ::file::openBaseAsTree
47 menu $m.recenttrees
48 $m add cascade -label ToolsOpenRecentBaseAsTree -menu $m.recenttrees
49 $m add separator
50 set ::menuFileRecentIdx [expr [$m index end] +1]
51 $m add command -label FileExit -accelerator "Ctrl+Q" -command ::file::Exit
52 
53 
54 ### Database menu:
55 set m .menu.db
56 menu $m
57 .menu add cascade -label Database -menu $m
58 $m add command -label FileClose -acc "Ctrl+W" -command ::file::Close
59 $m add separator
60 menu $m.exportfilter
61  $m.exportfilter add command -label ToolsExpFilterPGN \
62  -command {exportGames filter PGN}
63  $m.exportfilter add command -label ToolsExpFilterHTML \
64  -command {exportGames filter HTML}
65  $m.exportfilter add command -label ToolsExpFilterHTMLJS \
66  -command {::html::exportCurrentFilter}
67  $m.exportfilter add command -label ToolsExpFilterLaTeX \
68  -command {exportGames filter LaTeX}
69  $m.exportfilter add separator
70  set ::menuDbExportFilterIdx [expr [$m.exportfilter index end] +1]
71 $m add cascade -label ToolsExpFilter -menu $m.exportfilter
72 $m add command -label ToolsImportFile -command { importPgnFile $::curr_db }
73 $m add separator
74 menu $m.utils
75  $m.utils add checkbutton -label FileMaintWin -accelerator "Ctrl+M" -variable maintWin -command ::maint::OpenClose
76  $m.utils add command -label FileMaintCompact -command compactDB
77  $m.utils add command -label FileMaintClass -command classifyAllGames
78  $m.utils add checkbutton -label FileMaintNameEditor -command nameEditor -variable nameEditorWin -accelerator "Ctrl+Shift+N"
79  $m.utils add separator
80  $m.utils add command -label FileMaintDelete -state disabled -command markTwins
81  $m.utils add command -label FileMaintTwin -command updateTwinChecker
82 $m add cascade -label FileMaint -menu $m.utils
83 menu $m.spell
84  $m.spell add command -label FileMaintNamePlayer -command {openSpellCheckWin Player}
85  $m.spell add command -label FileMaintNameEvent -command {openSpellCheckWin Event}
86  $m.spell add command -label FileMaintNameSite -command {openSpellCheckWin Site}
87  $m.spell add command -label FileMaintNameRound -command {openSpellCheckWin Round}
88  $m.spell add command -label AddEloRatings -command {allocateRatings}
89 $m add cascade -label FileMaintName -menu $m.spell
90 $m add separator
91 set ::menuDbSwitchIdx [expr [$m index end] +1]
92 
93 
94 ### Edit menu:
95 set m .menu.edit
96 menu $m
97 .menu add cascade -label Edit -menu $m
98 $m add command -label EditUndo -accelerator "Ctrl+z" -command { undoFeature undo }
99 $m add command -label EditRedo -accelerator "Ctrl+y" -command { undoFeature redo }
100 $m add separator
101 $m add command -label EditSetup -accelerator "S" -command setupBoard
102 $m add command -label EditCopyBoard -accelerator "Ctrl+Shift+C" -command copyFEN
103 $m add command -label EditPasteBoard -accelerator "Ctrl+Shift+V" -command pasteFEN
104 $m add command -label PgnFileCopy -command ::pgn::PgnClipboardCopy
105 $m add command -label EditPastePGN -command importClipboardGame
106 $m add separator
107 menu $m.strip
108  $m.strip add command -label EditStripComments -command {::game::Strip comments}
109  $m.strip add command -label EditStripVars -command {::game::Strip variations}
110  $m.strip add command -label EditStripBegin -command {::game::TruncateBegin}
111  $m.strip add command -label EditStripEnd -command {::game::Truncate}
112 $m add cascade -label EditStrip -menu $m.strip
113 $m add separator
114 $m add command -label EditReset -command ::windows::gamelist::ClearClipbase
115 $m add command -label EditCopy -command ::gameAddToClipbase
116 $m add command -label EditPaste -command {
117  sc_clipbase paste
118  ::notify::GameChanged
119 }
120 
121 
122 ### Game menu:
123 set m .menu.game
124 menu $m -postcommand "updateMenuStates $m"
125 .menu add cascade -label Game -menu $m
126 $m add command -label GameNew -accelerator "Ctrl+N" -command ::game::Clear
127 $m add command -label GameReload -command ::game::Reload
128 $m add separator
129 $m add command -label GameReplace -command gameReplace -accelerator "Ctrl+S"
130 $m add command -label GameAdd -command gameAdd -accelerator "Ctrl+Shift+S"
131 menu $m.exportcurrent
132  $m.exportcurrent add command -label ToolsExpCurrentPGN \
133  -command {exportGames current PGN}
134  $m.exportcurrent add command -label ToolsExpCurrentHTML \
135  -command {exportGames current HTML}
136  $m.exportcurrent add command -label ToolsExpCurrentHTMLJS \
137  -command {::html::exportCurrentGame}
138  $m.exportcurrent add command -label ToolsExpCurrentLaTeX \
139  -command {exportGames current LaTeX}
140 $m add cascade -label ToolsExpCurrent -menu $m.exportcurrent
141 $m add separator
142 $m add command -label GameFirst -accelerator "Ctrl+Shift+Up" -command {::game::LoadNextPrev first}
143 $m add command -label GamePrev -accelerator "Ctrl+Up" -command {::game::LoadNextPrev previous}
144 $m add command -label GameNext -accelerator "Ctrl+Down" -command {::game::LoadNextPrev next}
145 $m add command -label GameLast -accelerator "Ctrl+Shift+Down" -command {::game::LoadNextPrev last}
146 $m add command -label GameRandom -command ::game::LoadRandom -accelerator "Ctrl+?"
147 $m add separator
148 $m add command -label GameDeepest -accelerator "Ctrl+Shift+D" -command {
149  sc_move ply [sc_eco game ply]
150  updateBoard
151 }
152 $m add command -label GameGotoMove -accelerator "Ctrl+U" -command ::game::GotoMoveNumber
153 $m add command -label GameNovelty -accelerator "Ctrl+Shift+Y" -command findNovelty
154 
155 
156 ### Search menu:
157 set m .menu.search
158 menu $m
159 .menu add cascade -label Search -menu $m
160 $m add command -label SearchCurrent -command ::search::board -accelerator "Ctrl+Shift+B"
161 $m add command -label SearchHeader -command ::search::header -accelerator "Ctrl+Shift+H"
162 $m add command -label SearchMaterial -command ::search::material -accelerator "Ctrl+Shift+M"
163 $m add separator
164 $m add checkbutton -label WindowsPList -variable plistWin -command ::plist::toggle -accelerator "Ctrl+Shift+P"
165 $m add checkbutton -label WindowsTmt -variable tourneyWin -command ::tourney::toggle -accelerator "Ctrl+Shift+T"
166 $m add separator
167 $m add command -label SearchUsing -accel "Ctrl+Shift+U" -command ::search::usefile
168 
169 
170 ### Play menu:
171 set m .menu.play
172 menu $m -postcommand "updateMenuStates $m"
173 .menu add cascade -label Play -menu $m
174 $m add command -label ToolsSeriousGame -command ::sergame::config
175 $m add command -label ToolsTacticalGame -command ::tacgame::config
176 $m add command -label ToolsTrainFics -command ::fics::config
177 $m add separator
178 menu $m.training
179  $m.training add command -label ToolsTrainOpenings -command ::opening::config
180  $m.training add command -label ToolsTrainTactics -command ::tactics::config
181  $m.training add command -label ToolsTrainReviewGame -command ::reviewgame::start
182  $m.training add command -label ToolsTrainCalvar -command ::calvar::config
183 $m add cascade -label ToolsTraining -menu $m.training
184 $m add separator
185 menu $m.correspondence
186  $m.correspondence add command -label CCConfigure -command {::CorrespondenceChess::config}
187  $m.correspondence add command -label CCConfigRelay -command {::CorrespondenceChess::ConfigureRelay}
188  $m.correspondence add separator
189  $m.correspondence add command -label CCOpenDB -command {::CorrespondenceChess::OpenCorrespondenceDB; ::CorrespondenceChess::ReadInbox} \
190  -accelerator "Ctrl+F12"
191  $m.correspondence add separator
192  $m.correspondence add command -label CCRetrieve -command { ::CorrespondenceChess::FetchGames }
193  $m.correspondence add command -label CCInbox -command { ::CorrespondenceChess::ReadInbox }
194  $m.correspondence add separator
195  $m.correspondence add command -label CCSend -command {::CorrespondenceChess::SendMove 0 0 0 0}
196  $m.correspondence add command -label CCResign -command {::CorrespondenceChess::SendMove 1 0 0 0}
197  $m.correspondence add command -label CCClaimDraw -command {::CorrespondenceChess::SendMove 0 1 0 0}
198  $m.correspondence add command -label CCOfferDraw -command {::CorrespondenceChess::SendMove 0 0 1 0}
199  $m.correspondence add command -label CCAcceptDraw -command {::CorrespondenceChess::SendMove 0 0 0 1}
200  $m.correspondence add command -label CCGamePage -command {::CorrespondenceChess::CallWWWGame}
201  $m.correspondence add separator
202  $m.correspondence add command -label CCNewMailGame -command {::CorrespondenceChess::newEMailGame}
203  $m.correspondence add command -label CCMailMove -command {::CorrespondenceChess::eMailMove}
204 $m add cascade -label CorrespondenceChess -menu $m.correspondence
205 
206 
207 ### Windows menu:
208 set m .menu.windows
209 menu $m
210 .menu add cascade -label Windows -menu $m
211 $m add checkbutton -label WindowsComment -var ::windows::commenteditor::isOpen -command "::makeCommentWin toggle" -accelerator "Ctrl+E"
212 $m add checkbutton -label WindowsPGN -variable pgnWin -command ::pgn::OpenClose -accelerator "Ctrl+P"
213 $m add checkbutton -label OptionsWindowsShowGameInfo -variable showGameInfo -command ::toggleGameInfo
214 $m add separator
215 $m add command -label WindowsGList -command ::windows::gamelist::Open -accelerator "Ctrl+L"
216 $m add checkbutton -label WindowsSwitcher -variable baseWin -accelerator "Ctrl+D" -command ::windows::switcher::Open
217 $m add command -label ToolsCross -accelerator "Ctrl+Shift+X" -command crosstabWin
218 $m add checkbutton -label WindowsECO -accelerator "Ctrl+Y" -variable ::windows::eco::isOpen -command {::windows::eco::OpenClose}
219 $m add checkbutton -label WindowsStats -variable ::windows::stats::isOpen -accelerator "Ctrl+I" -command ::windows::stats::Open
220 $m add checkbutton -label WindowsTree -variable treeWin -command ::tree::make -accelerator "Ctrl+T"
221 $m add checkbutton -label WindowsTB -variable ::tb::isOpen -command ::tb::Open -accelerator "Ctrl+="
222 $m add checkbutton -label WindowsBook -variable ::book::isOpen -command ::book::open -accelerator "F6"
223 $m add checkbutton -label WindowsCorrChess -variable ::CorrespondenceChess::isOpen \
224  -command ::CorrespondenceChess::CCWindow -accelerator "F12"
225 
226 
227 ### Tools menu:
228 set m .menu.tools
229 menu $m
230 .menu add cascade -label Tools -menu $m
231 $m add command -label ToolsAnalysis \
232  -command makeAnalysisWin -accelerator "Ctrl+Shift+A"
233 $m add command -label ToolsAnalysis2 \
234  -command "makeAnalysisWin 2" -accelerator "Ctrl+Shift+2"
235 $m add checkbutton -label ToolsStartEngine1 -variable analysisWin1 \
236  -command "makeAnalysisWin 1 0" -accelerator "F2"
237 $m add checkbutton -label ToolsStartEngine2 -variable analysisWin2 \
238  -command "makeAnalysisWin 2 0" -accelerator "F3"
239 $m add separator
240 $m add checkbutton -label ToolsEmail \
241  -accelerator "Ctrl+Shift+E" -variable emailWin -command ::tools::email
242 $m add checkbutton -label ToolsFilterGraph \
243  -accelerator "Ctrl+Shift+G" -variable filterGraph -command tools::graphs::filter::Open
244 $m add checkbutton -label ToolsAbsFilterGraph \
245  -accelerator "Ctrl+Shift+J" -variable absfilterGraph -command tools::graphs::absfilter::Open
246 $m add command -label ToolsOpReport \
247  -accelerator "Ctrl+Shift+O" -command ::optable::makeReportWin
248 $m add command -label ToolsTracker \
249  -accelerator "Ctrl+Shift+K" -command ::ptrack::make
250 $m add command -label ToolsBookTuning -command ::book::tuning
251 menu $m.hardware
252  $m.hardware add command -label ToolsConnectHardwareConfigure -command ::ExtHardware::config
253  $m.hardware add command -label ToolsConnectHardwareInputEngineConnect -command ::inputengine::connectdisconnect
254  $m.hardware add command -label ToolsConnectHardwareNovagCitrineConnect -command ::novag::connect
255 $m add cascade -label ToolsConnectHardware -menu $m.hardware
256 $m add separator
257 menu $m.pinfo
258  $m.pinfo add command -label GraphOptionsWhite -command { ::pinfo::playerInfo [sc_game info white] }
259  $m.pinfo add command -label GraphOptionsBlack -command { ::pinfo::playerInfo [sc_game info black] }
260 $m add cascade -label ToolsPInfo -menu $m.pinfo
261 $m add command -label ToolsPlayerReport -command ::preport::preportDlg
262 $m add command -label ToolsRating -command {::tools::graphs::rating::Refresh both}
263 $m add command -label ToolsScore -command ::tools::graphs::score::Refresh ;# -accelerator "Ctrl+Shift+Z"
264 
265 
266 ### Options menu:
267 set m .menu.options
268 menu $m
269 .menu add cascade -label Options -menu $m
270 menu $m.language
271  foreach l $::languages {
272  $m.language add radiobutton -label $::langName($l) \
273  -underline $::langUnderline($l) -variable language -value $l \
274  -command setLanguage
275  }
276 $m add cascade -label OptionsLanguage -menu $m.language
277 menu $m.board
278  menu $m.board.bdsize
279  $m.board add cascade -label OptionsBoardSize -menu $m.board.bdsize
280  menu $m.board.pieces -tearoff 1
281  $m.board add cascade -label OptionsBoardPieces -menu $m.board.pieces
282  $m.board add command -label OptionsBoardColors -command chooseBoardColors
283 $m add cascade -label OptionsBoard -menu $m.board
284 menu $m.fonts
285  $m.fonts add command -label OptionsFontsRegular -command {chooseFont Regular}
286  $m.fonts add command -label OptionsFontsMenu -command {chooseFont Menu}
287  $m.fonts add command -label OptionsFontsSmall -command {chooseFont Small}
288  $m.fonts add command -label OptionsFontsTiny -command {chooseFont Tiny}
289  $m.fonts add command -label OptionsFontsFixed -command {chooseFont Fixed}
290 $m add cascade -label OptionsFonts -menu $m.fonts
291 menu $m.numbers
292  foreach numeric {".," ". " "." ",." ", " ","} \
293  underline { 0 1 2 4 5 6} {
294  set decimal [string index $numeric 0]
295  set thousands [string index $numeric 1]
296  $m.numbers add radiobutton -label "12${thousands}345${decimal}67" \
297  -underline $underline \
298  -variable locale(numeric) -value $numeric -command updateLocale
299  }
300 $m add cascade -label OptionsNumbers -menu $m.numbers
301 menu $m.theme
302  foreach i [ttk::style theme names] {
303  $m.theme add radiobutton -label "$i" -value $i -variable ::lookTheme \
304  -command {ttk::style theme use $::lookTheme}
305  }
306 $m add cascade -label OptionsTheme -menu $m.theme
307 menu $m.windows
308  $m.windows add checkbutton -label OptionsWindowsIconify -variable autoIconify
309  $m.windows add checkbutton -label OptionsWindowsRaise -variable autoRaise
310  $m.windows add checkbutton -label OptionsWindowsDock -variable windowsDock
311  if {$::docking::USE_DOCKING} {
312  menu $m.windows.savelayout
313  menu $m.windows.restorelayout
314  foreach i {"1 (default)" "2" "3"} slot {1 2 3} {
315  $m.windows.savelayout add command -label $i -command "::docking::layout_save $slot"
316  $m.windows.restorelayout add command -label $i -command "::docking::layout_restore $slot"
317  }
318  $m.windows add cascade -label OptionsWindowsSaveLayout -menu $m.windows.savelayout
319  $m.windows add cascade -label OptionsWindowsRestoreLayout -menu $m.windows.restorelayout
320  }
321  menu $m.windows.startup
322  $m.windows.startup add checkbutton -label HelpTip -variable startup(tip)
323  $m.windows.startup add checkbutton -label FileFinder -variable startup(finder)
324  $m.windows.startup add checkbutton -label WindowsStats -variable startup(stats)
325  if {! $::docking::USE_DOCKING} {
326  $m.windows.startup add checkbutton -label ToolsCross -variable startup(crosstable)
327  $m.windows.startup add checkbutton -label WindowsSwitcher -variable startup(switcher)
328  $m.windows.startup add checkbutton -label WindowsGList -variable startup(gamelist)
329  $m.windows.startup add checkbutton -label WindowsPGN -variable startup(pgn)
330  $m.windows.startup add checkbutton -label WindowsTree -variable startup(tree)
331  $m.windows.startup add checkbutton -label WindowsBook -variable startup(book)
332  }
333  $m.windows add cascade -label OptionsStartup -menu $m.windows.startup
334 $m add cascade -label OptionsWindows -menu $m.windows
335 $m add command -label OptionsSounds -command ::utils::sound::OptionsDialog
336 $m add command -label OptionsToolbar -command configToolbar
337 $m add separator
338 $m add command -label OptionsRecent -command ::recentFiles::configure
339 $m add command -label GInfoInformant -command configInformant
340 menu $m.export
341  $m.export add command -label "PGN file text" -underline 0 -command "setExportText PGN"
342  $m.export add command -label "HTML file text" -underline 0 -command "setExportText HTML"
343  $m.export add command -label "LaTeX file text" -underline 0 -command "setExportText LaTeX"
344 $m add cascade -label OptionsExport -menu $m.export
345 menu $m.entry
346  $m.entry add checkbutton -label OptionsMovesAsk \
347  -variable askToReplaceMoves -offvalue 0 -onvalue 1
348  menu $m.entry.animate
349  foreach i {0 100 150 200 250 300 400 500 600 800 1000} {
350  $m.entry.animate add radiobutton -label "$i ms" \
351  -variable animateDelay -value $i
352  }
353  $m.entry add cascade -label OptionsMovesAnimate -menu $m.entry.animate
354  $m.entry add command -label OptionsMovesDelay -command setAutoplayDelay
355  $m.entry add checkbutton -label OptionsMovesCoord \
356  -variable moveEntry(Coord) -offvalue 0 -onvalue 1
357  $m.entry add checkbutton -label OptionsMovesKey \
358  -variable moveEntry(AutoExpand) -offvalue 0 -onvalue 1
359  $m.entry add checkbutton -label OptionsMovesSuggest \
360  -variable suggestMoves -offvalue 0 -onvalue 1
361  $m.entry add checkbutton -label OptionsShowVarPopup \
362  -variable showVarPopup -offvalue 0 -onvalue 1
363  $m.entry add checkbutton -label OptionsMovesSpace \
364  -variable ::pgn::moveNumberSpaces -offvalue 0 -onvalue 1
365  $m.entry add checkbutton -label OptionsMovesTranslatePieces \
366  -variable ::translatePieces -offvalue 0 -onvalue 1 -command setLanguage
367  menu $m.entry.highlightlastmove
368  $m.entry.highlightlastmove add checkbutton -label OptionsMovesHighlightLastMoveDisplay \
369  -variable ::highlightLastMove -command updateBoard
370  menu $m.entry.highlightlastmove.width
371  foreach i {1 2 3 4 5} {
372  $m.entry.highlightlastmove.width add radiobutton -label $i -value $i \
373  -variable ::highlightLastMoveWidth -command updateBoard
374  }
375  $m.entry.highlightlastmove add cascade -label OptionsMovesHighlightLastMoveWidth -menu $m.entry.highlightlastmove.width
376  $m.entry.highlightlastmove add command -label OptionsMovesHighlightLastMoveColor -command chooseHighlightColor
377  $m.entry.highlightlastmove add checkbutton -label OptionsMovesHighlightLastMoveArrow \
378  -variable ::arrowLastMove -command updateBoard
379  $m.entry add cascade -label OptionsMovesHighlightLastMove -menu $m.entry.highlightlastmove
380  $m.entry add checkbutton -label OptionsMovesShowVarArrows \
381  -variable showVarArrows -offvalue 0 -onvalue 1
382  $m.entry add checkbutton -label OptionsMovesGlossOfDanger \
383  -variable glossOfDanger -offvalue 0 -onvalue 1 -command updateBoard
384 $m add cascade -label OptionsMoves -menu $m.entry
385 $m add separator
386 $m add command -label OptionsECO -command ::readECOFile
387 $m add command -label OptionsSpell -command readSpellCheckFile
388 $m add command -label OptionsTable -command setTableBaseDir \
389  -state [expr {[sc_info tb] ? "normal" : "disabled"}]
390 $m add command -label OptionsBooksDir -command setBooksDir
391 $m add command -label OptionsTacticsBasesDir -command setTacticsBasesDir
392 #TODO: translate
393 $m add command -label "Photos directory..." -command setPhotoDir
394 $m add separator
395 $m add command -label OptionsSave -command options.write
396 $m add checkbutton -label OptionsAutoSave -variable optionsAutoSave \
397  -command { if {!$::optionsAutoSave} { options.autoSaveHack } }
398 
399 
400 ### Help menu:
401 set m .menu.helpmenu
402 menu $m
403 .menu add cascade -label Help -menu $m
404 set acc [expr {$macOS ? "Command-?" : "F1"}]
405 $m add command -label HelpContents -command {helpWindow Contents} -accelerator "$acc"
406 $m add command -label HelpIndex -command {helpWindow Index}
407 $m add command -label HelpGuide -command {helpWindow Guide}
408 $m add command -label HelpHints -command {helpWindow Hints}
409 $m add command -label HelpContact -command {helpWindow Author}
410 $m add separator
411 $m add command -label HelpTip -command ::tip::show
412 $m add separator
413 $m add command -label HelpAbout -command helpAbout
414 
415 
416 ##################################################
417 # Store menu labels for translations and help messages
418 set ::menuHelpMessage {}
419 proc storeMenuLabels {m} {
420  bind $m <<MenuSelect>> {
421  set ::menuHelpMessage {}
422  set idx [%W index active]
423  if {$idx != "none"} {
424  # Tcl/Tk seems to generate strange window names for menus that
425  # are configured to be a toplevel window main menu, e.g.
426  # .menu.file get reported as ".#menu.#menu#file" and
427  # .menu.file.utils is ".#menu.#menu#file.#menu#file#utils"
428  # I have no idea why it does this, but to avoid it we
429  # convert a window paths with hashes to its true value:
430  regsub -all "\#" [winfo name %W] . win
431  catch {
432  set lbl $::MenuLabels($win,$idx)
433  set ::menuHelpMessage $::helpMessage($::language,$lbl)
434  }
435  }
436  updateStatusBar
437  }
438 
439  set n [$m index end]
440  for {set i 0} {$n != "none" && $i <= $n} {incr i} {
441  set type [$m type $i]
442  if {$type != "separator" && $type != "tearoff"} {
443  set ::MenuLabels($m,$i) [$m entrycget $i -label]
444  }
445  if {$type == "cascade"} {
446  storeMenuLabels [$m entrycget $i -menu]
447  }
448  }
449 }
450 # Issue a command to a menu entry
451 proc menuConfig {{m} {label} {cmd} args} {
452  foreach {key lbl} [array get ::MenuLabels "$m*"] {
453  if {$lbl == $label} {
454  set idx [lindex [split $key ","] 1]
455  $m $cmd $idx {*}$args
456  break
457  }
458  }
459 }
460 storeMenuLabels .menu
461 set fileExitHack [.menu.file index end]
462 set ::MenuLabels(.menu.file,end) $::MenuLabels(.menu.file,$fileExitHack)
463 array unset ::MenuLabels ".menu.file,$fileExitHack"
464 
465 
466 ##################################################
467 # updateMenuStates:
468 # Update all the menus, rechecking which state each item should be in.
469 #
470 proc updateMenuStates {{menuname}} {
471  set m .menu
472  switch -- $menuname {
473  {.menu.file} {
475 
476  # update recent Tree list (open base as Tree)
477  set ntreerecent [::recentFiles::treeshow .menu.file.recenttrees]
478 
479  # Remove and reinsert the Recent files list and Exit command:
480  set idx2 [expr {[$m.file index end] -1}]
481  $m.file delete $::menuFileRecentIdx $idx2
482  set nrecent [::recentFiles::show $m.file $::menuFileRecentIdx]
483  if {$nrecent > 0} {
484  $m.file insert [expr $::menuFileRecentIdx + $nrecent] separator
485  }
486  }
487  {.menu.play} {
488  set n [$m.play index end]
489  set st normal
490  if {[info exists ::playMode]} { set st disabled}
491  for {set i 0} {$i <= $n} {incr i} {
492  catch { $m.play entryconfig $i -state $st}
493  }
494  }
495  {.menu.game} {
496  set isReadOnly [sc_base isReadOnly $::curr_db]
497  # Load first/last/random/game number buttons:
498  set filtercount [sc_filter count]
499  if {$filtercount == 0} {set state disabled} else {set state normal}
500  $m.game entryconfig [tr GameFirst] -state $state
501  $m.game entryconfig [tr GameLast] -state $state
502  $m.game entryconfig [tr GameRandom] -state $state
503 
504  # Load previous button:
505  if {[sc_filter previous]} {set state normal} else {set state disabled}
506  $m.game entryconfig [tr GamePrev] -state $state
507  .main.tb.gprev configure -state $state
508 
509  # Reload button:
510  if {[sc_game number]} {set state normal} else {set state disabled}
511  $m.game entryconfig [tr GameReload] -state $state
512 
513  # Load next button:
514  if {[sc_filter next]} {set state normal} else {set state disabled}
515  $m.game entryconfig [tr GameNext] -state $state
516  .main.tb.gnext configure -state $state
517 
518  # Save add button:
519  set state normal
520  $m.game entryconfig [tr GameAdd] -state $state
521 
522  # Save replace button:
523  set state normal
524  if {[sc_game number] == 0 || $isReadOnly } {
525  set state disabled
526  }
527  $m.game entryconfig [tr GameReplace] -state $state
528  }
529  }
530 }
531 
532 # Update the dynamic menus relative to current/open databases
533 proc menuUpdateBases {} {
534  set ::currentSlot $::curr_db
535  .menu.db delete $::menuDbSwitchIdx end
536  .menu.db.exportfilter delete $::menuDbExportFilterIdx end
537 
538  foreach i [sc_base list] {
539  set fname [file tail [sc_base filename $i]]
540 
541  .menu.db add radiobutton -variable currentSlot -value $i \
542  -label "Base $i: $fname" \
543  -underline 5 -accelerator "Ctrl+$i"\
544  -command [list ::file::SwitchToBase $i]
545 
546  if {$i != $::curr_db && ![sc_base isReadOnly $i]} {
547  .menu.db.exportfilter add command -label "Base $i: $fname" \
548  -command "::windows::gamelist::CopyGames {} $::curr_db $i"
549  }
550  }
551 
552  #Current database
553  set notClipbase [expr {$::curr_db != $::clipbase_db ? "normal" : "disabled"}]
554  set canChange [expr {![sc_base isReadOnly $::curr_db] ? "normal" : "disabled"}]
555  set canCompact [expr {[baseIsCompactable] ? "normal" : "disabled"}]
556  set notEmpty [expr {[sc_base numGames $::curr_db] != 0 ? "normal" : "disabled"}]
557 
558  menuConfig .menu.db FileClose entryconfig -state $notClipbase
559  menuConfig .menu.db ToolsExpFilter entryconfig -state $notEmpty
560  menuConfig .menu.db FileMaintName entryconfig -state $canChange
561  menuConfig .menu.db.utils FileMaintDelete entryconfig -state $canChange
562  menuConfig .menu.db.utils FileMaintClass entryconfig -state $canChange
563  menuConfig .menu.db.utils FileMaintTwin entryconfig -state $canChange
564  menuConfig .menu.db.utils FileMaintCompact entryconfig -state $canCompact
565  menuConfig .menu.db.utils FileMaintNameEditor entryconfig -state $canChange
566 }
567 
568 proc menuUpdateBoardSizes {} {
569  set count 0
570  set m .menu.options.board
571  $m.bdsize delete 0 end
572  set st normal
573  if {$::docking::USE_DOCKING } {
574  $m.bdsize add checkbutton -label "Auto" -variable ::autoResizeBoard \
575  -command "::resizeMainBoard; menuUpdateBoardSizes"
576  if {$::autoResizeBoard} { set st disabled}
577  }
578  foreach i $::boardSizes {
579  incr count
580  if {$count <= 9} {
581  set lbl " $count"
582  } else {
583  set lbl " $count"
584  }
585  $m.bdsize add radio -label "$lbl" -variable boardSize -value $i -state $st\
586  -command "::board::resize .main.board $i "
587  }
588 }
589 
590 proc menuUpdatePieces {} {
591  set m .menu
592  $m.options.board.pieces delete 0 end
593  foreach i $::boardStyles {
594  $m.options.board.pieces add radio -label $i \
595  -variable boardStyle -value $i \
596  -underline 0 -command "setPieceFont \"$i\"; updateBoard"
597  }
598 }
599 
600 
601 ##############################
602 # Multiple-language menu support functions.
603 
604 # configMenuText:
605 # Reconfigures the main window menus. Called when the language is changed.
606 #
607 proc configMenuText {menu entry tag lang} {
608  global menuLabel menuUnder
609  if {[info exists menuLabel($lang,$tag)] && [info exists menuUnder($lang,$tag)]} {
610  $menu entryconfig $entry -label $menuLabel($lang,$tag) -underline $menuUnder($lang,$tag)
611  } else {
612  $menu entryconfig $entry -label $menuLabel(E,$tag) -underline $menuUnder(E,$tag)
613  }
614 }
615 
616 proc setLanguageMenus {} {
617  set lang $::language
618  foreach {key lbl} [array get ::MenuLabels] {
619  foreach {m idx} [split $key ","] {
620  set under 0
621  catch { set under $::menuUnder($lang,$lbl)}
622  $m entryconfig $idx -label [tr $lbl] -underline $under
623  }
624  }
625 
633 
634  # Check for duplicate menu underline characters in this language:
635  # set ::verifyMenus 1
636  if {[info exists ::verifyMenus] && $::verifyMenus} {
637  foreach m {file edit game search windows tools options help} {
638  set list [checkMenuUnderline .menu.$m]
639  if {[llength $list] > 0} {
640  puts stderr "Menu $m has duplicate underline letters: $list"
641  }
642  }
643  }
644 }
645 
646 ################################################################################
647 # checkMenuUnderline:
648 # Given a menu widget, returns a list of all the underline
649 # characters that appear more than once.
650 ################################################################################
651 proc checkMenuUnderline {menu} {
652  array set found {}
653  set duplicates {}
654  set last [$menu index last]
655  for {set i [$menu cget -tearoff]} {$i <= $last} {incr i} {
656  if {[string equal [$menu type $i] "separator"]} {
657  continue
658  }
659  set char [string index [$menu entrycget $i -label] \
660  [$menu entrycget $i -underline]]
661  set char [string tolower $char]
662  if {$char == ""} {
663  continue
664  }
665  if {[info exists found($char)]} {
666  lappend duplicates $char
667  }
668  set found($char) 1
669  }
670  return $duplicates
671 }
672 
673 ################################################################################
674 #
675 ################################################################################
676 proc configInformant {} {
677  global informant
678 
679  set w .configInformant
680  if {[winfo exists $w]} {
681  destroy $w
682  }
683 
684  toplevel $w
685  ::setTitle $w $::tr(ConfigureInformant)
686  setWinLocation $w
687  frame $w.spinF
688  set idx 0
689  set row 0
690 
691  foreach i [lsort [array names informant]] {
692  label $w.spinF.labelExpl$idx -text [ ::tr "Informant[ string trim $i "\""]"]
693  label $w.spinF.label$idx -text $i
694  # Allow the configuration of "won game" up to "Mate found"
695  if {$i == "\"++-\""} {
696  spinbox $w.spinF.sp$idx -textvariable informant($i) -width 5 -from 0.0 -to 328.0 -increment 1.0 -validate all -vcmd { regexp {^[0-9]\.[0-9]$} %P }
697  } else {
698  spinbox $w.spinF.sp$idx -textvariable informant($i) -width 5 -from 0.0 -to 9.9 -increment 0.1 -validate all -vcmd { regexp {^[0-9]\.[0-9]$} %P }
699  }
700  grid $w.spinF.labelExpl$idx -row $row -column 0 -sticky w
701  incr row
702  grid $w.spinF.label$idx -row $row -column 0 -sticky w
703  grid $w.spinF.sp$idx -row $row -column 1 -sticky w
704  incr row
705  incr idx
706  }
707 
708  button $w.close -textvar ::tr(Close) -command "destroy $w"
709  pack $w.spinF $w.close
710  bind $w <Configure> "recordWinSize $w"
711 }
712 
713 # ################################################################################
714 # Set the delay between moves in options menu
715 ################################################################################
716 proc setAutoplayDelay {} {
717  global autoplayDelay tempdelay
718  set tempdelay [expr {int($autoplayDelay / 1000.0)}]
719  set w .apdialog
720  if { [winfo exists $w] } { focus $w ; return}
721  toplevel $w
722  ::setTitle $w "Scid"
723  wm resizable $w 0 0
724  ttk::label $w.label -text $::tr(AnnotateTime:)
725  pack $w.label -side top -pady 5 -padx 5
726  ttk::spinbox $w.spDelay -background white -width 4 -textvariable tempdelay -from 1 -to 999 -increment 1 \
727  -validate key -validatecommand { return [string is digit %S] }
728  pack $w.spDelay -side top -pady 5
729 
730  set b [ttk::frame $w.buttons]
731  pack $b -side top -fill x
732  ttk::button $b.cancel -text $::tr(Cancel) -command {
733  destroy .apdialog
734  focus .
735  }
736  ttk::button $b.ok -text "OK" -command {
737  if {$tempdelay < 0.1} { set tempdelay 0.1 }
738  set autoplayDelay [expr {int($tempdelay * 1000)}]
739  destroy .apdialog
740  focus .
741  }
742  pack $b.cancel $b.ok -side right -padx 5 -pady 5
743  bind $w <Escape> { .apdialog.buttons.cancel invoke }
744  bind $w <Return> { .apdialog.buttons.ok invoke }
745  focus $w.spDelay
746 }
747 
748 # setTableBaseDir:
749 # Prompt user to select a tablebase file; all the files in its
750 # directory will be used.
751 #
752 proc setTableBaseDir {} {
753  global initialDir tempDir
754  set ftype { { "Tablebase files" {".emd" ".nbw" ".nbb"} } }
755 
756  set w .tbDialog
757  toplevel $w
758  ::setTitle $w Scid
759  label $w.title -text "Select up to 4 table base directories:"
760  pack $w.title -side top
761  foreach i {1 2 3 4} {
762  set tempDir(tablebase$i) $initialDir(tablebase$i)
763  pack [frame $w.f$i] -side top -pady 3 -fill x -expand yes
764  entry $w.f$i.e -width 30 -textvariable tempDir(tablebase$i)
765  bindFocusColors $w.f$i.e
766  button $w.f$i.b -text "..." -pady 2 -command [list chooseTableBaseDir $i]
767  pack $w.f$i.b -side right -padx 2
768  pack $w.f$i.e -side left -padx 2 -fill x -expand yes
769  }
771  pack [frame $w.b] -side top -fill x
772  button $w.b.ok -text "OK" \
773  -command "catch {grab release $w; destroy $w}; openTableBaseDirs"
774  button $w.b.cancel -text $::tr(Cancel) \
775  -command "catch {grab release $w; destroy $w}"
776  pack $w.b.cancel $w.b.ok -side right -padx 2
777  bind $w <Escape> "$w.b.cancel invoke"
778  wm resizable $w 1 0
779  grab $w
780 }
781 proc openTableBaseDirs {} {
782  global initialDir tempDir
783  set tableBaseDirs ""
784  foreach i {1 2 3 4} {
785  set tbDir [string trim $tempDir(tablebase$i)]
786  if {$tbDir != ""} {
787  if {$tableBaseDirs != ""} { append tableBaseDirs ";"}
788  append tableBaseDirs [file nativename $tbDir]
789  }
790  }
791 
792  set npieces [sc_info tb $tableBaseDirs]
793  foreach i {1 2 3 4} {
794  set initialDir(tablebase$i) $tempDir(tablebase$i)
795  }
796  if {$npieces == 0} {
797  set msg "No tablebases were found."
798  } else {
799  set msg "Tablebases with up to $npieces pieces were found.\n\n"
800  append msg "If you want these tablebases be used whenever\n"
801  append msg "you start Scid, select \"Save Options\" from the\n"
802  append msg "Options menu before you exit Scid."
803  }
804  tk_messageBox -type ok -icon info -title "Scid: Tablebase results" \
805  -message $msg
806 }
807 proc chooseTableBaseDir {i} {
808  global tempDir
809 
810  set idir $tempDir(tablebase$i)
811  if {$idir == ""} { set idir [pwd]}
812 
813  set fullname [tk_chooseDirectory -initialdir $idir -mustexist 1 \
814  -title "Scid: Select a Tablebase directory"]
815  if {$fullname == ""} { return}
816 
817  set tempDir(tablebase$i) $fullname
818 }
819 ################################################################################
820 
821 proc setBooksDir {} {
822  global scidBooksDir
823  set dir [tk_chooseDirectory -initialdir $scidBooksDir -mustexist 1]
824  if {$dir == ""} {
825  return
826  } else {
827  set scidBooksDir $dir
828  }
829 }
830 
831 proc setTacticsBasesDir {} {
832  global scidBasesDir
833  set dir [tk_chooseDirectory -initialdir $scidBasesDir -mustexist 1]
834  if {$dir == ""} {
835  return
836  } else {
837  set scidBasesDir $dir
838  }
839 }
840 
841 proc setPhotoDir {} {
842  set dir [tk_chooseDirectory -initialdir $::scidExeDir -mustexist 1]
843  if {$dir == ""} {
844  return
845  } else {
846  set ::scidPhotoDir $dir
847  options.save ::scidPhotoDir
848  set n [loadPlayersPhoto]
849  tk_messageBox -message "Found [lindex $n 0] images in [lindex $n 1] file(s)"
851  }
852 }
853 
854 proc readECOFile {} {
855  set ftype { { "Scid ECO files" {".eco"} } }
856  if {[sc_info gzip]} {
857  set ftype { { "Scid ECO files" {".eco" ".eco.gz"} } }
858  }
859  set fullname [tk_getOpenFile -initialdir [pwd] -filetypes $ftype -title "Load ECO file"]
860  if {[string compare $fullname ""]} {
861  if {[catch {sc_eco read $fullname} result]} {
862  tk_messageBox -title "Scid" -type ok \
863  -icon warning -message $result
864  } else {
865  set ecoFile $fullname
866  tk_messageBox -title "Scid: ECO file loaded." -type ok -icon info \
867  -message "ECO file $fullname loaded: $result positions.\n\nTo have this file automatically loaded when you start Scid, select \"Save Options\" from the Options menu before exiting."
868  }
869  }
870 }
871 
872 proc updateLocale {} {
873  global locale
874  sc_info decimal $locale(numeric)
877 }
878 
879 proc chooseFont {fType} {
880  global fontOptions
881  set fontOptions(temp) [FontDialog font_$fType $fontOptions($fType)]
882  if {$fontOptions(temp) != ""} { set fontOptions($fType) $fontOptions(temp)}
883  switch $fType {
884  {Regular} {
885  set font [font configure font_Regular -family]
886  set fontsize [font configure font_Regular -size]
887  font configure font_Bold -family $font -size $fontsize
888  font configure font_Italic -family $font -size $fontsize
889  font configure font_BoldItalic -family $font -size $fontsize
890  font configure font_H1 -family $font -size [expr {$fontsize + 8}]
891  font configure font_H2 -family $font -size [expr {$fontsize + 6}]
892  font configure font_H3 -family $font -size [expr {$fontsize + 4}]
893  font configure font_H4 -family $font -size [expr {$fontsize + 2}]
894  font configure font_H5 -family $font -size [expr {$fontsize + 0}]
895  }
896  {Small} {
897  set font [font configure font_Small -family]
898  set fontsize [font configure font_Small -size]
899  font configure font_SmallBold -family $font -size $fontsize
900  font configure font_SmallItalic -family $font -size $fontsize
901  }
902  }
903 }
904 
905 proc chooseHighlightColor {} {
906  set col [ tk_chooseColor -initialcolor $::highlightLastMoveColor -title "Scid"]
907  if { $col != "" } {
908  set ::highlightLastMoveColor $col
910  }
911 }
912 
913 
914 ### End of file: menus.tcl
915