Scid  4.6.5
bookmark.tcl
Go to the documentation of this file.
1 # bookmark.tcl:
2 # Bookmarks list and Recently-used files list in Scid.
3 
4 set bookmarks(data) {}
5 set bookmarks(subMenus) 0
6 
7 # Read the bookmarks file if it exists:
8 catch {source [scidConfigFile bookmarks]}
9 
10 
11 namespace eval ::bookmarks {}
12 
13 # ::bookmarks::PostMenu:
14 # Posts the bookmarks toolbar menu.
15 #
16 proc ::bookmarks::PostMenu {} {
17  .main.tb.bkm.menu post [winfo pointerx .] [winfo pointery .]
18  if {[::bookmarks::CanAdd]} {
19  .main.tb.bkm.menu activate 0
20  } else {
21  .main.tb.bkm.menu activate 2
22  }
23 }
24 
25 # ::bookmarks::Refresh:
26 # Updates all bookmarks submenus.
27 #
28 proc ::bookmarks::Refresh {} {
29  foreach menu {.menu.file.bookmarks .main.tb.bkm.menu} {
31  }
32 }
33 
34 proc ::bookmarks::RefreshMenu {menu} {
35  global bookmarks helpMessage
36 
38  $menu delete 0 end
39  # $menu configure -disabledforeground [$menu cget -foreground]
40  set numBookmarkEntries [llength $bookmarks(data)]
41  $menu add command -label FileBookmarksAdd -command ::bookmarks::AddCurrent
42  set helpMessage($menu,0) FileBookmarksAdd
43  $menu add cascade -label FileBookmarksFile -menu $menu.file
44  menu $menu.file
45  set helpMessage($menu,1) FileBookmarksFile
46  if {! [::bookmarks::CanAdd]} {
47  $menu entryconfigure 0 -state disabled
48  $menu entryconfigure 1 -state disabled
49  }
50  $menu add command -label FileBookmarksEdit -command ::bookmarks::Edit
51  set helpMessage($menu,2) FileBookmarksEdit
52  if {$bookmarks(subMenus)} {
53  set display List
54  set newval 0
55  } else {
56  set display Sub
57  set newval 1
58  }
59  $menu add command -label FileBookmarks$display \
60  -command "set bookmarks(subMenus) $newval; ::bookmarks::Refresh"
61  set helpMessage($menu,3) FileBookmarks$display
62  foreach tag [list Add File Edit $display] {
63  configMenuText $menu FileBookmarks$tag FileBookmarks$tag $::language
64  }
65  if {$numBookmarkEntries == 0} { return}
66  $menu add separator
67 
68  # Add each bookmark entry:
69  set current $menu
70  set inSubMenu 0
71  set nfolders 0
72  foreach entry $bookmarks(data) {
73  if {$entry == ""} { continue}
74  set isfolder [::bookmarks::isfolder $entry]
75 
76  if {$isfolder} {
77  incr nfolders
78  $menu.file add command -label [::bookmarks::Text $entry] \
79  -command "::bookmarks::AddCurrent $nfolders"
80  }
81 
82  if {! $bookmarks(subMenus)} {
83  if {$isfolder} {
84  $current add command -label [::bookmarks::IndexText $entry]
85  } elseif {!$isfolder} {
86  $current add command -label [::bookmarks::IndexText $entry] \
87  -command [list ::bookmarks::Go $entry]
88  }
89  continue
90  }
91 
92  # Move out of submenu where necessary:
93  if {$isfolder && $inSubMenu} {
94  set current [winfo parent $current]
95  }
96 
97  if {$isfolder} {
98  # Menu (folder) entry:
99  set current [::bookmarks::NewSubMenu $current $entry]
100  set inSubMenu 1
101  } else {
102  # Bookmark entry:
103  $current add command -label [::bookmarks::Text $entry] \
104  -command [list ::bookmarks::Go $entry]
105  }
106  }
107 }
108 
109 # ::bookmarks::CanAdd:
110 # Returns 1 if the current game can be added as a bookmark.
111 # It must be in an open database, not a PGN file, and not game number 0.
112 #
113 proc ::bookmarks::CanAdd {} {
114  if {[sc_game number] == 0} { return 0}
115  if {$::curr_db == $::clipbase_db} { return 0}
116  set fname [sc_base filename $::curr_db]
117  foreach suffix {.pgn .PGN .pgn.gz} {
118  if {[string match "*$suffix" "$fname"]} { return 0}
119  }
120  return 1
121 }
122 
123 # ::bookmarks::AddCurrent:
124 # Adds the current game to the bookmarks list.
125 #
126 proc ::bookmarks::AddCurrent {{folder 0}} {
127  global bookmarks
128  if {! [sc_base inUse]} {
129  return
130  }
131  set text [::bookmarks::New game]
132  set len [llength $bookmarks(data)]
133  set fcount 0
134  for {set i 0} {$i < $len} {incr i} {
135  if {[::bookmarks::isfolder [lindex $bookmarks(data) $i]]} {
136  if {$fcount == $folder} { break}
137  incr fcount
138  }
139  }
140  set bookmarks(data) [linsert $bookmarks(data) $i $text]
143 }
144 
145 # ::bookmarks::New:
146 # Returns a bookmarks list entry for the current game or a new folder.
147 #
148 proc ::bookmarks::New {type} {
149  if {$type == "folder"} { return [list "f" ""]}
150  set text "[file tail [sc_base filename $::curr_db]]: [sc_game info result], "
151  append text "[::utils::string::Surname [sc_game info white]] - "
152  append text "[::utils::string::Surname [sc_game info black]], "
153  append text "[::utils::string::CityName [sc_game info site]] "
154  set round [sc_game info round]
155  if {$round != "" && $round != "?"} { append text "($round) "}
156  append text "[sc_game info year]"
157  set list [list "g" $text]
158  sc_game pgn
159  lappend list [sc_base filename ::curr_db] [sc_game number] [sc_pos pgnOffset]
160  lappend list [sc_game info white] [sc_game info black]
161  lappend list [sc_game info year] [sc_game info site]
162  lappend list [sc_game info round] [sc_game info result]
163  return $list
164 }
165 
166 # ::bookmarks::Go
167 #
168 # Jumps to a selected bookmark.
169 #
170 proc ::bookmarks::Go {entry} {
171  if {[::bookmarks::isfolder $entry]} { return}
172  set fname [lindex $entry 2]
173  set gnum [lindex $entry 3]
174  set ply [lindex $entry 4]
175  set slot [sc_base slot $fname]
176  if {$slot != 0} {
177  sc_base switch $slot
178  } else {
179  busyCursor .
180  if {[catch { ::file::Open $fname} result]} {
181  unbusyCursor .
182  tk_messageBox -icon warning -type ok -parent . \
183  -title "Scid" -message "Unable to load the database:\n$fname\n\n$result"
184  return
185  }
186  unbusyCursor .
187  set ::glist 1
188  ::recentFiles::add "[file rootname $fname].si4"
189  }
190  # Find and load the best database game matching the bookmark:
191  set white [lindex $entry 5]
192  set black [lindex $entry 6]
193  set year [lindex $entry 7]
194  set site [lindex $entry 8]
195  set round [lindex $entry 9]
196  set result [lindex $entry 10]
197 
198  set best [sc_game find $gnum $white $black $site $round $year $result]
199  if {[catch {::game::Load $best}]} {
200  tk_messageBox -icon warning -type ok -parent . \
201  -title "Scid" -message "Unable to load game number: $best"
202  } else {
203  sc_move pgn $ply
204  }
207 }
208 
209 # ::bookmarks::DeleteChildren
210 #
211 # Deletes all submenus of a bookmark menu.
212 #
213 proc ::bookmarks::DeleteChildren {w} {
214  foreach child [winfo children $w] {
216  destroy $child
217  }
218 }
219 
220 # ::bookmarks::NewSubMenu
221 #
222 # Creates a new bookmark submenu.
223 #
224 proc ::bookmarks::NewSubMenu {w entry} {
225  set i 1
226  while {[winfo exists $w.m$i]} { incr i}
227  $w add cascade -label [::bookmarks::Text $entry] -menu $w.m$i
228  menu $w.m$i -tearoff 0
229  return $w.m$i
230 }
231 
232 # Globals used for bookmark editing:
233 #
234 set bookmarks(edit) ""
235 set bookmarks(ismenu) 0
236 
237 
238 # ::bookmarks::Edit
239 #
240 # Creates the bookmark editing window.
241 #
242 proc ::bookmarks::Edit {} {
243  global bookmarks
244  set w .bmedit
245  if {[winfo exists $w]} { return}
246  set bookmarks(old) $bookmarks(data)
247  toplevel $w
248  wm title $w "Scid: [tr FileBookmarksEdit]"
249  # wm transient $w .
250  bind $w <F1> {helpWindow Bookmarks}
251  entry $w.e -width 40 -foreground black -background white \
252  -textvariable bookmarks(edit) -font font_Small -exportselection 0
253  bind $w.e <FocusIn> {.bmedit.e configure -background lightYellow}
254  bind $w.e <FocusOut> {.bmedit.e configure -background white}
255 
256  trace variable bookmarks(edit) w ::bookmarks::EditRefresh
257  pack $w.e -side top -fill x
258  pack [frame $w.b2] -side bottom -fill x
259  pack [frame $w.b1] -side bottom -fill x
260  pack [frame $w.f] -side top -fill both -expand 1
261  listbox $w.f.list -width 50 -height 10 -yscrollcommand "$w.f.ybar set" \
262  -fg black -bg white -exportselection 0 -font font_Small -setgrid 1
263  scrollbar $w.f.ybar -takefocus 0 -command "$w.f.list yview"
264  bind $w.f.list <<ListboxSelect>> ::bookmarks::EditSelect
265  pack $w.f.ybar -side right -fill y
266  pack $w.f.list -side left -fill x -expand 1
267  foreach entry $bookmarks(data) {
268  $w.f.list insert end [::bookmarks::IndexText $entry]
269  }
270  dialogbutton $w.b1.newFolder -text $::tr(NewSubmenu) \
271  -command {::bookmarks::EditNew folder}
272  dialogbutton $w.b1.newGame -text [tr FileBookmarksAdd] \
273  -command {::bookmarks::EditNew game}
274  if {! [::bookmarks::CanAdd]} { $w.b1.newGame configure -state disabled}
275  dialogbutton $w.b1.delete -text $::tr(Delete) -command ::bookmarks::EditDelete
276  button $w.b2.up -image tb_up -command {::bookmarks::EditMove up}
277  button $w.b2.down -image tb_down -command {::bookmarks::EditMove down}
278  foreach i [list $w.b2.up $w.b2.down] {
279  $i configure -padx 0 -pady 0 -borderwidth 1
280  }
281  dialogbutton $w.b2.ok -text "OK" -command ::bookmarks::EditDone
282  dialogbutton $w.b2.cancel -text $::tr(Cancel) -command {
283  set bookmarks(data) $bookmarks(old)
284  catch {grab release .bmedit}
285  destroy .bmedit
286  }
287  pack $w.b1.newFolder $w.b1.newGame $w.b1.delete -side left -padx 2 -pady 2
288  pack $w.b2.up $w.b2.down -side left -padx 2 -pady 2
289  pack $w.b2.cancel $w.b2.ok -side right -padx 2 -pady 2
290  set bookmarks(edit) ""
291 
292  wm withdraw $w
293  update idletasks
294  set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
295  - [winfo vrootx .]}]
296  set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
297  - [winfo vrooty .]}]
298  wm geom $w +$x+$y
299  wm deiconify $w
300  update
301  catch {grab .bmedit}
302 }
303 
304 # ::bookmarks::EditDone
305 #
306 # Updates the bookmarks and closes the bookmark editing window.
307 #
308 proc ::bookmarks::EditDone {} {
309  catch {grab release .bmedit}
310  destroy .bmedit
313 }
314 
315 # ::bookmarks::EditRefresh
316 #
317 # Updates the bookmarks whenever the contents of the bookmark
318 # editing entry box are changed.
319 #
320 proc ::bookmarks::EditRefresh {args} {
321  global bookmarks
322  set list .bmedit.f.list
323  set sel [lindex [$list curselection] 0]
324  if {$sel == ""} { return}
325  set text $bookmarks(edit)
326  set e [lindex $bookmarks(data) $sel]
327  set e [::bookmarks::SetText $e $text]
328  set text [::bookmarks::IndexText $e]
329  set bookmarks(data) [lreplace $bookmarks(data) $sel $sel $e]
330  $list insert $sel $text
331  $list delete [expr {$sel + 1}]
332  $list selection clear 0 end
333  $list selection set $sel
334 }
335 
336 # ::bookmarks::EditSelect
337 #
338 # Sets the bookmark editing entry box when a bookmark is selected.
339 #
340 proc ::bookmarks::EditSelect {{sel ""}} {
341  global bookmarks
342  set list .bmedit.f.list
343  set sel [lindex [$list curselection] 0]
344  if {$sel == ""} {
345  .bmedit.e delete 0 end
346  return
347  }
348  if {$sel >= [llength $bookmarks(data)]} {
349  $list selection clear 0 end
350  set bookmarks(edit) ""
351  return
352  }
353  set e [lindex $bookmarks(data) $sel]
354  set bookmarks(ismenu) [::bookmarks::isfolder $e]
355  set bookmarks(edit) [::bookmarks::Text $e]
356 }
357 
358 # ::bookmarks::isfolder:
359 # Returns 1 if this bookmark entry is a folder (submenu).
360 #
361 proc ::bookmarks::isfolder {entry} {
362  if {[lindex $entry 0] == "f"} { return 1}
363  return 0
364 }
365 
366 # ::bookmarks::Text:
367 # Returns the entry text of a bookmark.
368 #
369 proc ::bookmarks::Text {entry} {
370  return [lindex $entry 1]
371 }
372 
373 proc ::bookmarks::IndexText {entry} {
374  set text ""
375  if {[lindex $entry 0] == "f"} {
376  append text "\[[lindex $entry 1]\]"
377  } else {
378  append text " [lindex $entry 1]"
379  }
380  return $text
381 }
382 
383 proc ::bookmarks::SetText {entry text} {
384  return [lreplace $entry 1 1 $text]
385 }
386 
387 # ::bookmarks::EditMove
388 #
389 # Moves the selected bookmark "up" or "down" one place.
390 #
391 proc ::bookmarks::EditMove {{dir "up"}} {
392  global bookmarks
393  set w .bmedit
394  set list $w.f.list
395  set sel [lindex [$list curselection] 0]
396  if {$sel == ""} { return}
397  set e [lindex $bookmarks(data) $sel]
398  set text [::bookmarks::IndexText $e]
399  set newsel $sel
400  if {$dir == "up"} {
401  incr newsel -1
402  if {$newsel < 0} { return}
403  } else {
404  incr newsel
405  if {$newsel >= [$list index end]} { return}
406  }
407  set bookmarks(data) [lreplace $bookmarks(data) $sel $sel]
408  set bookmarks(data) [linsert $bookmarks(data) $newsel $e]
409  $list selection clear 0 end
410  $list delete $sel
411  $list insert $newsel $text
412  $list selection set $newsel
413 }
414 
415 # ::bookmarks::EditDelete
416 #
417 # Deletes the selected bookmark.
418 #
419 proc ::bookmarks::EditDelete {} {
420  global bookmarks
421  set w .bmedit
422  set list $w.f.list
423  set sel [lindex [$list curselection] 0]
424  if {$sel == ""} { return}
425  set bookmarks(data) [lreplace $bookmarks(data) $sel $sel]
426  $list selection clear 0 end
427  $list delete $sel
428  set bookmarks(edit) ""
429 }
430 
431 # ::bookmarks::EditNew
432 #
433 # Inserts a new entry ("folder" for a submenu or "game" for the
434 # current game) after the selected bookmark.
435 #
436 proc ::bookmarks::EditNew {{type "folder"}} {
437  global bookmarks
438  set w .bmedit
439  set list $w.f.list
440  set folder 0
441  if {[string index $type 0] == "f"} {
442  set folder 1
443  set entry [::bookmarks::New folder]
444  } else {
445  set entry [::bookmarks::New game]
446  }
447  set sel [lindex [$list curselection] 0]
448  if {$sel == ""} {
449  lappend bookmarks(data) $entry
450  set sel [$list index end]
451  $list insert end [::bookmarks::IndexText $entry]
452  $list selection clear 0 end
453  $list selection set $sel
454  $list see $sel
456  return
457  }
458  incr sel
459  set bookmarks(data) [linsert $bookmarks(data) $sel $entry]
460  $list insert $sel [::bookmarks::IndexText $entry]
461  $list selection clear 0 end
462  $list selection set $sel
463  $list see $sel
465 }
466 
467 # ::bookmarks::Save
468 #
469 # Saves the bookmarks file, reporting any error in a message box if
470 # reportError is true.
471 #
472 proc ::bookmarks::Save {{reportError 0}} {
473  global bookmarks
474  set f {}
475  set filename [scidConfigFile bookmarks]
476  if {[catch {open $filename w} f]} {
477  if {$reportError} {
478  tk_messageBox -title "Scid" -type ok -icon warning \
479  -message "Unable to write bookmarks file: $filename\n$f"
480  }
481  return
482  }
483  puts $f "# Scid $::scidVersion bookmarks file\n"
484  foreach i {subMenus data} {
485  puts $f "set bookmarks($i) [list [set bookmarks($i)]]"
486  puts $f ""
487  }
488  close $f
489 }
490 
491 
492 # End of file: bookmark.tcl