Scid  4.7.0
•All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros
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 ::crosstab::Open
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 $m add command -label OptionsMenuColor -command { ::appearance::menuConfigDialog }
292 if { $::macOS } { $m entryconfigure end -state disabled}
293 menu $m.numbers
294  foreach numeric {".," ". " "." ",." ", " ","} \
295  underline { 0 1 2 4 5 6} {
296  set decimal [string index $numeric 0]
297  set thousands [string index $numeric 1]
298  $m.numbers add radiobutton -label "12${thousands}345${decimal}67" \
299  -underline $underline \
300  -variable locale(numeric) -value $numeric -command updateLocale
301  }
302 $m add cascade -label OptionsNumbers -menu $m.numbers
303 menu $m.theme -tearoff 1
304 $m.theme add command -label OptionsThemeDir -command setThemePkgFile
305 $m.theme add separator
306 set ::menuThemeListIdx [expr [$m.theme index end] +1]
307 $m add cascade -label OptionsTheme -menu $m.theme
308 menu $m.windows
309  $m.windows add checkbutton -label OptionsWindowsIconify -variable autoIconify
310  $m.windows add checkbutton -label OptionsWindowsRaise -variable autoRaise
311  $m.windows add checkbutton -label OptionsWindowsDock -variable windowsDock
312 
313  menu $m.windows.savelayout
314  menu $m.windows.restorelayout
315  foreach i {"1 (default)" "2" "3"} slot {1 2 3} {
316  $m.windows.savelayout add command -label $i -command "::docking::layout_save $slot"
317  $m.windows.restorelayout add command -label $i -command "::docking::layout_restore $slot"
318  }
319  $m.windows add cascade -label OptionsWindowsSaveLayout -menu $m.windows.savelayout
320  $m.windows add cascade -label OptionsWindowsRestoreLayout -menu $m.windows.restorelayout
321 
322  menu $m.windows.startup
323  $m.windows.startup add checkbutton -label HelpTip -variable startup(tip)
324  $m.windows.startup add checkbutton -label FileFinder -variable startup(finder)
325  $m.windows.startup add checkbutton -label WindowsStats -variable startup(stats)
326  $m.windows add cascade -label OptionsStartup -menu $m.windows.startup
327 $m add cascade -label OptionsWindows -menu $m.windows
328 $m add command -label OptionsSounds -command ::utils::sound::OptionsDialog
329 $m add command -label OptionsToolbar -command configToolbar
330 $m add separator
331 $m add command -label OptionsRecent -command ::recentFiles::configure
332 $m add command -label GInfoInformant -command configInformant
333 menu $m.export
334  $m.export add command -label "PGN file text" -underline 0 -command "setExportText PGN"
335  $m.export add command -label "HTML file text" -underline 0 -command "setExportText HTML"
336  $m.export add command -label "LaTeX file text" -underline 0 -command "setExportText LaTeX"
337 $m add cascade -label OptionsExport -menu $m.export
338 menu $m.entry
339  $m.entry add checkbutton -label OptionsMovesAsk \
340  -variable askToReplaceMoves -offvalue 0 -onvalue 1
341  menu $m.entry.animate
342  foreach i {0 100 150 200 250 300 400 500 600 800 1000} {
343  $m.entry.animate add radiobutton -label "$i ms" \
344  -variable animateDelay -value $i
345  }
346  $m.entry add cascade -label OptionsMovesAnimate -menu $m.entry.animate
347  $m.entry add command -label OptionsMovesDelay -command setAutoplayDelay
348  $m.entry add checkbutton -label OptionsMovesCoord \
349  -variable moveEntry(Coord) -offvalue 0 -onvalue 1
350  $m.entry add checkbutton -label OptionsMovesKey \
351  -variable moveEntry(AutoExpand) -offvalue 0 -onvalue 1
352  $m.entry add checkbutton -label OptionsMovesSuggest \
353  -variable suggestMoves -offvalue 0 -onvalue 1
354  $m.entry add checkbutton -label OptionsShowVarPopup \
355  -variable showVarPopup -offvalue 0 -onvalue 1
356  $m.entry add checkbutton -label OptionsMovesSpace \
357  -variable ::pgn::moveNumberSpaces -offvalue 0 -onvalue 1
358  $m.entry add checkbutton -label OptionsMovesTranslatePieces \
359  -variable ::translatePieces -offvalue 0 -onvalue 1 -command setLanguage
360  menu $m.entry.highlightlastmove
361  $m.entry.highlightlastmove add checkbutton -label OptionsMovesHighlightLastMoveDisplay \
362  -variable ::highlightLastMove -command updateBoard
363  menu $m.entry.highlightlastmove.width
364  foreach i {1 2 3 4 5} {
365  $m.entry.highlightlastmove.width add radiobutton -label $i -value $i \
366  -variable ::highlightLastMoveWidth -command updateBoard
367  }
368  $m.entry.highlightlastmove add cascade -label OptionsMovesHighlightLastMoveWidth -menu $m.entry.highlightlastmove.width
369  $m.entry.highlightlastmove add command -label OptionsMovesHighlightLastMoveColor -command chooseHighlightColor
370  $m.entry.highlightlastmove add checkbutton -label OptionsMovesHighlightLastMoveArrow \
371  -variable ::arrowLastMove -command updateBoard
372  $m.entry add cascade -label OptionsMovesHighlightLastMove -menu $m.entry.highlightlastmove
373  $m.entry add checkbutton -label OptionsMovesShowVarArrows \
374  -variable showVarArrows -offvalue 0 -onvalue 1
375  $m.entry add checkbutton -label OptionsMovesGlossOfDanger \
376  -variable glossOfDanger -offvalue 0 -onvalue 1 -command updateBoard
377 $m add cascade -label OptionsMoves -menu $m.entry
378 $m add separator
379 $m add command -label OptionsECO -command ::readECOFile
380 $m add command -label OptionsSpell -command readSpellCheckFile
381 $m add command -label OptionsTable -command setTableBaseDir \
382  -state [expr {[sc_info tb] ? "normal" : "disabled"}]
383 $m add command -label OptionsBooksDir -command setBooksDir
384 $m add command -label OptionsTacticsBasesDir -command setTacticsBasesDir
385 $m add command -label OptionsPhotosDir -command setPhotoDir
386 $m add separator
387 $m add command -label OptionsSave -command options.write
388 $m add checkbutton -label OptionsAutoSave -variable optionsAutoSave \
389  -command { if {!$::optionsAutoSave} { options.autoSaveHack } }
390 
391 
392 ### Help menu:
393 set m .menu.helpmenu
394 menu $m
395 .menu add cascade -label Help -menu $m
396 set acc [expr {$macOS ? "Command-?" : "F1"}]
397 $m add command -label HelpContents -command {helpWindow Contents} -accelerator "$acc"
398 $m add command -label HelpIndex -command {helpWindow Index}
399 $m add command -label HelpGuide -command {helpWindow Guide}
400 $m add command -label HelpHints -command {helpWindow Hints}
401 $m add command -label HelpContact -command {helpWindow Author}
402 $m add separator
403 $m add command -label HelpTip -command ::tip::show
404 $m add separator
405 $m add command -label HelpAbout -command helpAbout
406 
407 
408 ##################################################
409 # Store menu labels for translations and help messages
410 set ::menuHelpMessage {}
411 proc storeMenuLabels {m} {
412  bind $m <<MenuSelect>> {
413  set ::menuHelpMessage {}
414  set idx [%W index active]
415  if {$idx != "none"} {
416  # Tcl/Tk seems to generate strange window names for menus that
417  # are configured to be a toplevel window main menu, e.g.
418  # .menu.file get reported as ".#menu.#menu#file" and
419  # .menu.file.utils is ".#menu.#menu#file.#menu#file#utils"
420  # I have no idea why it does this, but to avoid it we
421  # convert a window paths with hashes to its true value:
422  regsub -all "\#" [winfo name %W] . win
423  catch {
424  set lbl $::MenuLabels($win,$idx)
425  set ::menuHelpMessage $::helpMessage($::language,$lbl)
426  }
427  }
428  updateStatusBar
429  }
430 
431  set n [$m index end]
432  for {set i 0} {$n != "none" && $i <= $n} {incr i} {
433  set type [$m type $i]
434  if {$type != "separator" && $type != "tearoff"} {
435  set ::MenuLabels($m,$i) [$m entrycget $i -label]
436  }
437  if {$type == "cascade"} {
438  storeMenuLabels [$m entrycget $i -menu]
439  }
440  }
441 }
442 # Issue a command to a menu entry
443 proc menuConfig {{m} {label} {cmd} args} {
444  foreach {key lbl} [array get ::MenuLabels "$m*"] {
445  if {$lbl == $label} {
446  set idx [lindex [split $key ","] 1]
447  $m $cmd $idx {*}$args
448  break
449  }
450  }
451 }
452 storeMenuLabels .menu
453 set fileExitHack [.menu.file index end]
454 set ::MenuLabels(.menu.file,end) $::MenuLabels(.menu.file,$fileExitHack)
455 array unset ::MenuLabels ".menu.file,$fileExitHack"
456 
457 
458 ##################################################
459 # updateMenuStates:
460 # Update all the menus, rechecking which state each item should be in.
461 #
462 proc updateMenuStates {{menuname}} {
463  set m .menu
464  switch -- $menuname {
465  {.menu.file} {
466  ::bookmarks::Refresh
467 
468  # update recent Tree list (open base as Tree)
469  set ntreerecent [::recentFiles::treeshow .menu.file.recenttrees]
470 
471  # Remove and reinsert the Recent files list and Exit command:
472  set idx2 [expr {[$m.file index end] -1}]
473  $m.file delete $::menuFileRecentIdx $idx2
474  set nrecent [::recentFiles::show $m.file $::menuFileRecentIdx]
475  if {$nrecent > 0} {
476  $m.file insert [expr $::menuFileRecentIdx + $nrecent] separator
477  }
478  }
479  {.menu.play} {
480  set n [$m.play index end]
481  set st normal
482  if {[info exists ::playMode]} { set st disabled}
483  for {set i 0} {$i <= $n} {incr i} {
484  catch { $m.play entryconfig $i -state $st}
485  }
486  }
487  {.menu.game} {
488  set isReadOnly [sc_base isReadOnly $::curr_db]
489  # Load first/last/random/game number buttons:
490  set filtercount [sc_filter count]
491  if {$filtercount == 0} {set state disabled} else {set state normal}
492  $m.game entryconfig [tr GameFirst] -state $state
493  $m.game entryconfig [tr GameLast] -state $state
494  $m.game entryconfig [tr GameRandom] -state $state
495 
496  # Load previous button:
497  if {[sc_filter previous]} {set state normal} else {set state disabled}
498  $m.game entryconfig [tr GamePrev] -state $state
499  .main.tb.gprev configure -state $state
500 
501  # Reload button:
502  if {[sc_game number]} {set state normal} else {set state disabled}
503  $m.game entryconfig [tr GameReload] -state $state
504 
505  # Load next button:
506  if {[sc_filter next]} {set state normal} else {set state disabled}
507  $m.game entryconfig [tr GameNext] -state $state
508  .main.tb.gnext configure -state $state
509 
510  # Save add button:
511  set state normal
512  $m.game entryconfig [tr GameAdd] -state $state
513 
514  # Save replace button:
515  set state normal
516  if {[sc_game number] == 0 || $isReadOnly } {
517  set state disabled
518  }
519  $m.game entryconfig [tr GameReplace] -state $state
520  }
521  }
522 }
523 
524 # Update the dynamic menus relative to current/open databases
525 proc menuUpdateBases {} {
526  set ::currentSlot $::curr_db
527  .menu.db delete $::menuDbSwitchIdx end
528  .menu.db.exportfilter delete $::menuDbExportFilterIdx end
529 
530  foreach i [sc_base list] {
531  set fname [file tail [sc_base filename $i]]
532 
533  .menu.db add radiobutton -variable currentSlot -value $i \
534  -label "Base $i: $fname" \
535  -underline 5 -accelerator "Ctrl+$i"\
536  -command [list ::file::SwitchToBase $i]
537 
538  if {$i != $::curr_db && ![sc_base isReadOnly $i]} {
539  .menu.db.exportfilter add command -label "Base $i: $fname" \
540  -command "::windows::gamelist::CopyGames {} $::curr_db $i"
541  }
542  }
543 
544  #Current database
545  set notClipbase [expr {$::curr_db != $::clipbase_db ? "normal" : "disabled"}]
546  set canChange [expr {![sc_base isReadOnly $::curr_db] ? "normal" : "disabled"}]
547  set canCompact [expr {[baseIsCompactable] ? "normal" : "disabled"}]
548  set notEmpty [expr {[sc_base numGames $::curr_db] != 0 ? "normal" : "disabled"}]
549 
550  menuConfig .menu.db FileClose entryconfig -state $notClipbase
551  menuConfig .menu.db ToolsExpFilter entryconfig -state $notEmpty
552  menuConfig .menu.db FileMaintName entryconfig -state $canChange
553  menuConfig .menu.db.utils FileMaintDelete entryconfig -state $canChange
554  menuConfig .menu.db.utils FileMaintClass entryconfig -state $canChange
555  menuConfig .menu.db.utils FileMaintTwin entryconfig -state $canChange
556  menuConfig .menu.db.utils FileMaintCompact entryconfig -state $canCompact
557  menuConfig .menu.db.utils FileMaintNameEditor entryconfig -state $canChange
558 }
559 
560 proc menuUpdateBoardSizes {} {
561  set count 0
562  set m .menu.options.board
563  $m.bdsize delete 0 end
564  set st normal
565  $m.bdsize add checkbutton -label "Auto" -variable ::autoResizeBoard \
566  -command "::resizeMainBoard; menuUpdateBoardSizes"
567  if {$::autoResizeBoard} { set st disabled}
568  foreach i $::boardSizes {
569  incr count
570  if {$count <= 9} {
571  set lbl " $count"
572  } else {
573  set lbl " $count"
574  }
575  $m.bdsize add radio -label "$lbl" -variable boardSize -value $i -state $st\
576  -command "::board::resize .main.board $i "
577  }
578 }
579 
580 proc menuUpdatePieces {} {
581  set m .menu
582  $m.options.board.pieces delete 0 end
583  foreach i $::boardStyles {
584  $m.options.board.pieces add radio -label $i \
585  -variable boardStyle -value $i \
586  -underline 0 -command "setPieceFont \"$i\"; updateBoard"
587  }
588 }
589 
590 proc menuUpdateThemes {} {
591  set m .menu.options.theme
592  $m delete $::menuThemeListIdx end
593  foreach i [lsort [ttk::style theme names]] {
594  $m add radiobutton -label "$i" -value $i -variable ::lookTheme \
595  -command {ttk::style theme use $::lookTheme}
596  }
597 }
598 
599 ##############################
600 # Multiple-language menu support functions.
601 
602 # configMenuText:
603 # Reconfigures the main window menus. Called when the language is changed.
604 #
605 proc configMenuText {menu entry tag lang} {
606  global menuLabel menuUnder
607  if {[info exists menuLabel($lang,$tag)] && [info exists menuUnder($lang,$tag)]} {
608  $menu entryconfig $entry -label $menuLabel($lang,$tag) -underline $menuUnder($lang,$tag)
609  } else {
610  $menu entryconfig $entry -label $menuLabel(E,$tag) -underline $menuUnder(E,$tag)
611  }
612 }
613 
614 proc setLanguageMenus {} {
615  set lang $::language
616  foreach {key lbl} [array get ::MenuLabels] {
617  foreach {m idx} [split $key ","] {
618  set under 0
619  catch { set under $::menuUnder($lang,$lbl)}
620  $m entryconfig $idx -label [tr $lbl] -underline $under
621  }
622  }
623 
624  ::pgn::ConfigMenus
625  ::tree::ConfigMenus
626  ::crosstab::ConfigMenus
627  ::optable::ConfigMenus
628  ::preport::ConfigMenus
629 
630  # Check for duplicate menu underline characters in this language:
631  # set ::verifyMenus 1
632  if {[info exists ::verifyMenus] && $::verifyMenus} {
633  foreach m {file edit game search windows tools options help} {
634  set list [checkMenuUnderline .menu.$m]
635  if {[llength $list] > 0} {
636  puts stderr "Menu $m has duplicate underline letters: $list"
637  }
638  }
639  }
640 }
641 
642 ################################################################################
643 # checkMenuUnderline:
644 # Given a menu widget, returns a list of all the underline
645 # characters that appear more than once.
646 ################################################################################
647 proc checkMenuUnderline {menu} {
648  array set found {}
649  set duplicates {}
650  set last [$menu index last]
651  for {set i [$menu cget -tearoff]} {$i <= $last} {incr i} {
652  if {[string equal [$menu type $i] "separator"]} {
653  continue
654  }
655  set char [string index [$menu entrycget $i -label] \
656  [$menu entrycget $i -underline]]
657  set char [string tolower $char]
658  if {$char == ""} {
659  continue
660  }
661  if {[info exists found($char)]} {
662  lappend duplicates $char
663  }
664  set found($char) 1
665  }
666  return $duplicates
667 }
668 
669 ################################################################################
670 #
671 ################################################################################
672 proc configInformant {} {
673  global informant
674 
675  set w .configInformant
676  if {[winfo exists $w]} {
677  destroy $w
678  }
679 
680  win::createDialog $w
681  ::setTitle $w $::tr(ConfigureInformant)
682  setWinLocation $w
683  ttk::frame $w.spinF
684  set idx 0
685  set row 0
686 
687  foreach i [lsort [array names informant]] {
688  ttk::label $w.spinF.labelExpl$idx -text [ ::tr "Informant[ string trim $i "\""]"]
689  ttk::label $w.spinF.label$idx -text $i
690  # Allow the configuration of "won game" up to "Mate found"
691  if {$i == "\"++-\""} {
692  ttk::spinbox $w.spinF.sp$idx -textvariable informant($i) -width 5 -from 0.0 -to 328.0 -increment 1.0 -validate all -validatecommand { regexp {^[0-9]\.[0-9]$} %P }
693  } else {
694  ttk::spinbox $w.spinF.sp$idx -textvariable informant($i) -width 5 -from 0.0 -to 9.9 -increment 0.1 -validate all -validatecommand { regexp {^[0-9]\.[0-9]$} %P }
695  }
696  grid $w.spinF.labelExpl$idx -row $row -column 0 -sticky w
697  incr row
698  grid $w.spinF.label$idx -row $row -column 0 -sticky w
699  grid $w.spinF.sp$idx -row $row -column 1 -sticky w
700  incr row
701  incr idx
702  }
703  pack $w.spinF
704 # addHorizontalRule $w
705  ttk::button $w.close -textvar ::tr(Close) -command "destroy $w"
706  packdlgbuttons $w.close
707  bind $w <Configure> "recordWinSize $w"
708 }
709 
710 # ################################################################################
711 # Set the delay between moves in options menu
712 ################################################################################
713 proc setAutoplayDelay {} {
714  global autoplayDelay tempdelay
715  set tempdelay [expr {int($autoplayDelay / 1000.0)}]
716  set w .apdialog
717  if { [winfo exists $w] } { focus $w ; return}
718  win::createDialog $w
719  ::setTitle $w "Scid"
720  wm resizable $w 0 0
721  ttk::label $w.label -text $::tr(AnnotateTime:)
722  pack $w.label -side top -pady 5 -padx 5
723  ttk::spinbox $w.spDelay -background white -width 4 -textvariable tempdelay -from 1 -to 999 -increment 1 \
724  -validate key -validatecommand { return [string is digit %S] }
725  pack $w.spDelay -side top -pady 5
726 
727  set b [ttk::frame $w.buttons]
728  pack $b -side top -fill x
729  ttk::button $b.cancel -text $::tr(Cancel) -command {
730  destroy .apdialog
731  focus .
732  }
733  ttk::button $b.ok -text "OK" -command {
734  if {$tempdelay < 0.1} { set tempdelay 0.1 }
735  set autoplayDelay [expr {int($tempdelay * 1000)}]
736  destroy .apdialog
737  focus .
738  }
739  packdlgbuttons $b.cancel $b.ok
740  bind $w <Escape> { .apdialog.buttons.cancel invoke }
741  bind $w <Return> { .apdialog.buttons.ok invoke }
742  focus $w.spDelay
743 }
744 
745 # setTableBaseDir:
746 # Prompt user to select a tablebase file; all the files in its
747 # directory will be used.
748 #
749 proc setTableBaseDir {} {
750  global initialDir tempDir
751  set ftype { { "Tablebase files" {".emd" ".nbw" ".nbb"} } }
752 
753  set w .tbDialog
754  win::createDialog $w
755  ::setTitle $w Scid
756  ttk::label $w.title -text "Select up to 4 table base directories:"
757  pack $w.title -side top -fill x
758  foreach i {1 2 3 4} {
759  set tempDir(tablebase$i) $initialDir(tablebase$i)
760  pack [ttk::frame $w.f$i] -side top -fill x -expand yes
761  ttk::entry $w.f$i.e -width 30 -textvariable tempDir(tablebase$i)
762  bindFocusColors $w.f$i.e
763  ttk::button $w.f$i.b -text "..." -command [list chooseTableBaseDir $i]
764  pack $w.f$i.b -side right -padx 2
765  pack $w.f$i.e -side left -padx 2 -fill x -expand yes
766  }
767 # addHorizontalRule $w
768  pack [ttk::frame $w.b] -side top -fill x
769  ttk::button $w.b.ok -text "OK" \
770  -command "catch {grab release $w; destroy $w}; openTableBaseDirs"
771  ttk::button $w.b.cancel -text $::tr(Cancel) \
772  -command "catch {grab release $w; destroy $w}"
773  packdlgbuttons $w.b.cancel $w.b.ok
774  bind $w <Escape> "$w.b.cancel invoke"
775  wm resizable $w 1 0
776  grab $w
777 }
778 proc openTableBaseDirs {} {
779  global initialDir tempDir
780  set tableBaseDirs ""
781  foreach i {1 2 3 4} {
782  set tbDir [string trim $tempDir(tablebase$i)]
783  if {$tbDir != ""} {
784  if {$tableBaseDirs != ""} { append tableBaseDirs ";"}
785  append tableBaseDirs [file nativename $tbDir]
786  }
787  }
788 
789  set npieces [sc_info tb $tableBaseDirs]
790  foreach i {1 2 3 4} {
791  set initialDir(tablebase$i) $tempDir(tablebase$i)
792  }
793  if {$npieces == 0} {
794  set msg "No tablebases were found."
795  } else {
796  set msg "Tablebases with up to $npieces pieces were found.\n\n"
797  append msg "If you want these tablebases be used whenever\n"
798  append msg "you start Scid, select \"Save Options\" from the\n"
799  append msg "Options menu before you exit Scid."
800  }
801  tk_messageBox -type ok -icon info -title "Scid: Tablebase results" \
802  -message $msg
803 }
804 proc chooseTableBaseDir {i} {
805  global tempDir
806 
807  set idir $tempDir(tablebase$i)
808  if {$idir == ""} { set idir [pwd]}
809 
810  set fullname [tk_chooseDirectory -initialdir $idir -mustexist 1 \
811  -title "Scid: Select a Tablebase directory"]
812  if {$fullname == ""} { return}
813 
814  set tempDir(tablebase$i) $fullname
815 }
816 ################################################################################
817 
818 proc setBooksDir {} {
819  global scidBooksDir
820  set dir [tk_chooseDirectory -initialdir $scidBooksDir -mustexist 1]
821  if {$dir == ""} {
822  return
823  } else {
824  set scidBooksDir $dir
825  }
826 }
827 
828 proc setTacticsBasesDir {} {
829  global scidBasesDir
830  set dir [tk_chooseDirectory -initialdir $scidBasesDir -mustexist 1]
831  if {$dir == ""} {
832  return
833  } else {
834  set scidBasesDir $dir
835  }
836 }
837 
838 proc setPhotoDir {} {
839  set dir [tk_chooseDirectory -initialdir $::scidExeDir -mustexist 1]
840  if {$dir == ""} {
841  return
842  } else {
843  set ::scidPhotoDir $dir
844  options.save ::scidPhotoDir
845  set n [loadPlayersPhoto]
846  tk_messageBox -message "Found [lindex $n 0] images in [lindex $n 1] file(s)"
847  ::notify::GameChanged
848  }
849 }
850 
851 proc setThemePkgFile {} {
852  global initialDir
853  set f [tk_getOpenFile -title "Select a pkgIndex.tcl file for themes" -initialfile $::ThemePackageFile \
854  -filetypes { {Theme "pkgIndex.tcl"} }]
855  if {$f ne ""} {
856  ::safeSourceStyle $f
857  menuUpdateThemes
858  set ::ThemePackageFile $f
859  }
860 }
861 
862 proc readECOFile {} {
863  set ftype { { "Scid ECO files" {".eco"} } }
864  set fullname [tk_getOpenFile -initialdir [pwd] -filetypes $ftype -title "Load ECO file"]
865  if {[string compare $fullname ""]} {
866  if {[catch {sc_eco read $fullname} result]} {
867  tk_messageBox -title "Scid" -type ok \
868  -icon warning -message $result
869  } else {
870  set ecoFile $fullname
871  tk_messageBox -title "Scid: ECO file loaded." -type ok -icon info \
872  -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."
873  }
874  }
875 }
876 
877 proc updateLocale {} {
878  global locale
879  sc_info decimal $locale(numeric)
880  ::windows::gamelist::Refresh
881  updateTitle
882 }
883 
884 proc chooseFont {fType} {
885  global fontOptions
886  set fontOptions(temp) [FontDialog font_$fType $fontOptions($fType)]
887  if {$fontOptions(temp) != ""} { set fontOptions($fType) $fontOptions(temp)}
888  switch $fType {
889  {Regular} {
890  set font [font configure font_Regular -family]
891  set fontsize [font configure font_Regular -size]
892  font configure font_Bold -family $font -size $fontsize
893  font configure font_Italic -family $font -size $fontsize
894  font configure font_BoldItalic -family $font -size $fontsize
895  font configure font_H1 -family $font -size [expr {$fontsize + 8}]
896  font configure font_H2 -family $font -size [expr {$fontsize + 6}]
897  font configure font_H3 -family $font -size [expr {$fontsize + 4}]
898  font configure font_H4 -family $font -size [expr {$fontsize + 2}]
899  font configure font_H5 -family $font -size [expr {$fontsize + 0}]
900  }
901  {Small} {
902  set font [font configure font_Small -family]
903  set fontsize [font configure font_Small -size]
904  font configure font_SmallBold -family $font -size $fontsize
905  font configure font_SmallItalic -family $font -size $fontsize
906  }
907  }
908 }
909 
910 proc chooseHighlightColor {} {
911  set col [ tk_chooseColor -initialcolor $::highlightLastMoveColor -title "Scid"]
912  if { $col != "" } {
913  set ::highlightLastMoveColor $col
914  updateBoard
915  }
916 }
917 
918 
919 ### End of file: menus.tcl
920 
Generated by   doxygen 1.8.13