Scid  4.6.5
maint.tcl
Go to the documentation of this file.
1 # maint.tcl: Maintenance-related functions
2 # Part of Scid.
3 # Copyright (C) 2000-2004 Shane Hudson.
4 
5 namespace eval ::maint {}
6 
7 ### TODO: Move procedures and variables into the maint namespace.
8 ### TODO: Make sub-namespaces (sort, compact, cleaner, etc)
9 
10 ################################################################################
11 # ::maint::SetGameFlags
12 #
13 # Updates a flag for the current game, all filtered games, or all games.
14 # <type> should be "current", "filter" or "all".
15 # <flag> should be "delete", "user", "endgame", etc.
16 # <value> should be 0 or 1
17 #
18 proc ::maint::SetGameFlags {flag type value} {
19  if {$flag == "mark"} { set flag $::maintFlag}
20  if {$value} {
21  set op "set"
22  } else {
23  set op "unset"
24  }
25  set base [sc_base current]
26  switch -- $type {
27  "current" {
28  sc_base gameflag $base [sc_game number] $op $flag
29  }
30  "filter" {
31  busyCursor .
32  update idletasks
33  sc_base gameflag $base "dbfilter" $op $flag
34  unbusyCursor .
35  }
36  "all" {
37  busyCursor .
38  update idletasks
39  sc_base gameflag $base "all" $op $flag
40  unbusyCursor .
41  }
42  default { return}
43  }
46 }
47 
48 set maintFlag W
49 set maintFlaglist {W B M E N P T Q K ! ? U 1 2 3 4 5 6}
50 array set maintFlags {
51  W WhiteOpFlag
52  B BlackOpFlag
53  M MiddlegameFlag
54  E EndgameFlag
55  N NoveltyFlag
56  P PawnFlag
57  T TacticsFlag
58  Q QsideFlag
59  K KsideFlag
60  ! BrilliancyFlag
61  ? BlunderFlag
62  U UserFlag
63  1 CustomFlag1
64  2 CustomFlag2
65  3 CustomFlag3
66  4 CustomFlag4
67  5 CustomFlag5
68  6 CustomFlag6
69 }
70 
71 
72 set maintWin 0
73 
74 # ::maint::OpenClose
75 #
76 # Creates the database maintenance window.
77 #
78 proc ::maint::OpenClose {} {
79  global maintWin maintFlag maintFlags maintFlaglist
80  set w .maintWin
81  if {[winfo exists $w]} {
82  destroy $w
83  set maintWin 0
84  return
85  }
86  set maintWin 1
87  set font font_Small
88  set bold font_SmallBold
89  toplevel $w
90  wm title $w "Scid: [tr FileMaint]"
91  wm resizable $w 0 0
92  bind $w <F1> {helpWindow Maintenance}
93  bind $w <Escape> "destroy $w; break"
94  bind $w <Destroy> {set maintWin 0}
95  foreach f {title delete mark spell db buttons} {
96  ttk::frame $w.$f
97  }
98  foreach f {title delete mark spell db} {
99  pack $w.$f -side top -fill x
101  }
102  pack $w.buttons -side top -fill x
103 
104  ttk::label $w.title.name -textvar ::tr(DatabaseName) -font font_Bold
105  ttk::label $w.title.games -textvar ::tr(NumOfGames) -font font_SmallBold
106  ttk::label $w.title.icon -textvar ::tr(TypeIcon)
107  ttk::label $w.title.delete -textvar ::tr(NumDeletedGames) -font $font
108  ttk::label $w.title.mark -font $font
109  ttk::label $w.title.filter -textvar ::tr(NumFilterGames) -font $font
110  ttk::label $w.title.dates -textvar ::tr(YearRange) -font $font
111  ttk::label $w.title.ratings -textvar ::tr(RatingRange) -font $font
112  ttk::button $w.title.vicon -command {changeBaseType [sc_base current]}
113 
114  ttk::frame $w.title.desc
115  ttk::label $w.title.desc.lab -text $::tr(Description:) -font font_SmallBold
116  ttk::label $w.title.desc.text -width 1 -font $font -relief sunken -anchor w
117  ttk::button $w.title.desc.edit -text "[tr Edit]..." -style Small.TButton -command ::maint::ChangeBaseDescription
118  pack $w.title.desc.lab -side left
119  pack $w.title.desc.edit -side right -padx 2
120  pack $w.title.desc.text -side left -fill x -expand yes
121 
122  # Custom flags
123  ttk::frame $w.title.cust
124  ttk::label $w.title.cust.lab -text "[::tr CustomFlags]:" -font font_SmallBold
125  set ::curr_db [sc_base current]
126  for {set i 1} { $i < 7} { incr i} {
127  set desc [sc_base extra $::curr_db flag$i]
128  ttk::label $w.title.cust.text$i -width 8 -font $font -relief sunken -anchor w -text $desc
129  }
130 
131  ttk::button $w.title.cust.edit -text "[tr Edit]..." -style Small.TButton -command ::maint::ChangeCustomDescription
132  pack $w.title.cust.lab -side left
133  pack $w.title.cust.edit -side right -padx 2
134  for {set i 1} { $i < 7} { incr i} {
135  pack $w.title.cust.text$i -side left -fill x -expand yes
136  }
137  foreach name {name games delete mark filter dates ratings} {
138  ttk::label $w.title.v$name -text "0" -font $font
139  }
140 
141  set row 0
142  set col 0
143  foreach name {name icon games filter delete mark dates ratings} {
144  grid $w.title.$name -row $row -column $col -sticky w
145  incr col
146  grid $w.title.v$name -row $row -column $col -sticky e
147  incr col
148  if {$col == 2} { incr col}
149  if {$col >= 5} { set col 0; incr row}
150  }
151  grid [ttk::label $w.title.space -text " "] -row 0 -column 2
152  $w.title.vname configure -font font_Bold
153  $w.title.vgames configure -font font_SmallBold
154  grid $w.title.desc -row $row -column 0 -columnspan 5 -sticky we
155  incr row
156  grid $w.title.cust -row $row -column 0 -columnspan 5 -sticky we
157 
158  foreach grid {title delete mark spell db} cols {5 3 3 4 3} {
159  for {set i 0} {$i < $cols} {incr i} {
160  grid columnconfigure $w.$grid $i -weight 1
161  }
162  }
163 
164  ttk::label $w.delete.title -textvar ::tr(DeleteFlag) -font $bold
165  ttk::menubutton $w.mark.title -menu $w.mark.title.m ;# -indicatoron 1 -relief raised -font $bold
166  menu $w.mark.title.m -font $font
167 
168  set i 0
169  foreach flag $maintFlaglist {
170  if {$i < 12} {
171  $w.mark.title.m add command -label "$::tr($maintFlags($flag)) ($flag)" -command "set maintFlag $flag; ::maint::Refresh"
172  } else {
173  set tmp [sc_base extra $::curr_db flag$flag]
174  if {$tmp == "" } { set tmp $maintFlags($flag)}
175  $w.mark.title.m add command -label "$tmp ($flag)" -command "set maintFlag $flag; ::maint::Refresh"
176  }
177  incr i
178  }
179 
180  foreach flag {delete mark} on {Delete Mark} off {Undelete Unmark} {
181  foreach b {Current Filter All} {
182  ttk::button $w.$flag.on$b -textvar "::tr($on$b)" -style Small.TButton -command "::maint::SetGameFlags $flag [string tolower $b] 1"
183  ttk::button $w.$flag.off$b -textvar "::tr($off$b)" -style Small.TButton -command "::maint::SetGameFlags $flag [string tolower $b] 0"
184  }
185 
186  grid $w.$flag.title -columnspan 3 -row 0 -column 0 -sticky n
187  grid $w.$flag.onCurrent -row 1 -column 0 -sticky we
188  grid $w.$flag.offCurrent -row 2 -column 0 -sticky we
189  grid $w.$flag.onFilter -row 1 -column 1 -sticky we
190  grid $w.$flag.offFilter -row 2 -column 1 -sticky we
191  grid $w.$flag.onAll -row 1 -column 2 -sticky we
192  grid $w.$flag.offAll -row 2 -column 2 -sticky we
193  }
194 
195  ttk::label $w.spell.title -textvar ::tr(Spellchecking) -font $bold
196  grid $w.spell.title -columnspan 4 -row 0 -column 0 -sticky n
197  ttk::button $w.spell.player -textvar ::tr(Players...) -style Small.TButton \
198  -command "openSpellCheckWin Player $w"
199  ttk::button $w.spell.event -textvar ::tr(Events...) -style Small.TButton \
200  -command "openSpellCheckWin Event $w"
201  ttk::button $w.spell.site -textvar ::tr(Sites...) -style Small.TButton \
202  -command "openSpellCheckWin Site $w"
203  ttk::button $w.spell.round -textvar ::tr(Rounds...) -style Small.TButton \
204  -command "openSpellCheckWin Round $w"
205  grid $w.spell.player -row 1 -column 0 -sticky we
206  grid $w.spell.event -row 1 -column 1 -sticky we
207  grid $w.spell.site -row 1 -column 2 -sticky we
208  grid $w.spell.round -row 1 -column 3 -sticky we
209 
210  bind $w <Alt-p> "$w.spell.player invoke"
211  bind $w <Alt-e> "$w.spell.event invoke"
212  bind $w <Alt-s> "$w.spell.site invoke"
213  bind $w <Alt-r> "$w.spell.round invoke"
214 
215  ttk::label $w.db.title -textvar ::tr(DatabaseOps) -font $bold
216  grid $w.db.title -columnspan 3 -row 0 -column 0 -sticky n
217 
218  ttk::button $w.db.eco -style Small.TButton -textvar ::tr(ReclassifyGames...) -command classifyAllGames
219  ttk::button $w.db.compact -style Small.TButton -textvar ::tr(CompactDatabase...) -command compactDB
220  ttk::button $w.db.elo -style Small.TButton -textvar ::tr(AddEloRatings...) -command allocateRatings
221  ttk::button $w.db.dups -style Small.TButton -textvar ::tr(DeleteTwins...) -command "markTwins $w"
222  ttk::button $w.db.cleaner -style Small.TButton -textvar ::tr(Cleaner...) -command cleanerWin
223  ttk::button $w.db.autoload -style Small.TButton -textvar ::tr(AutoloadGame...) -command ::maint::SetAutoloadGame
224  ttk::button $w.db.strip -style Small.TButton -textvar ::tr(StripTags...) -command stripTags
225 
226  foreach i {eco compact elo dups cleaner autoload strip} {
227  $w.db.$i configure -style Small.TButton
228  }
229  bind $w <Alt-d> "$w.db.dups invoke"
230 
231  grid $w.db.eco -row 1 -column 0 -sticky we
232  grid $w.db.compact -row 1 -column 1 -sticky we
233  grid $w.db.elo -row 2 -column 0 -sticky we
234  grid $w.db.dups -row 2 -column 1 -sticky we
235  grid $w.db.cleaner -row 2 -column 2 -sticky we
236  grid $w.db.autoload -row 3 -column 0 -sticky we
237  grid $w.db.strip -row 3 -column 1 -sticky we
238 
239  dialogbutton $w.buttons.help -textvar ::tr(Help) -command {helpWindow Maintenance}
240  dialogbutton $w.buttons.close -textvar ::tr(Close) -command "destroy $w"
241  packbuttons right $w.buttons.close $w.buttons.help
242 
243  bind $w <Alt-h> "$w.buttons.help invoke"
246 }
247 
248 proc ::maint::ChangeBaseDescription {} {
249  set w .bdesc
250  if {[winfo exists $w]} { return}
251  toplevel $w
252  wm title $w "Scid: $::tr(Description): [file tail [sc_base filename $::curr_db]]"
253  set font font_Small
254  ttk::entry $w.entry -width 50 ;# -relief sunken -background white
255  set ::curr_db [sc_base current]
256  $w.entry insert end [sc_base extra $::curr_db description]
257  pack $w.entry -side top -pady 4
258  ttk::frame $w.b
259  ttk::button $w.b.ok -text OK -command {
260  if { [catch {sc_base extra $::curr_db description [.bdesc.entry get]}] } {
261  ERROR::MessageBox
262  }
263  grab release .bdesc
264  destroy .bdesc
265  ::maint::Refresh
266  }
267  ttk::button $w.b.cancel -text $::tr(Cancel) -command "grab release $w; destroy $w"
268  pack $w.b -side bottom -fill x
269  pack $w.b.cancel $w.b.ok -side right -padx 2 -pady 2
270  wm resizable $w 0 0
271  catch {grab $w}
272 }
273 ################################################################################
274 # Change custom flags description
275 ################################################################################
276 proc ::maint::ChangeCustomDescription {} {
277  set w .bcustom
278  if {[winfo exists $w]} { return}
279  toplevel $w
280  wm title $w "Scid: $::tr(CustomFlags): [file tail [sc_base filename $::curr_db]]"
281  ttk::frame $w.a
282  ttk::label $w.a.lb -text [::tr CustomFlags]
283  grid $w.a.lb -column 0 -row 0 -columnspan 12
284  set col 0
285  set ::curr_db [sc_base current]
286  for {set i 1} {$i <7} {incr i} {
287  ttk::label $w.a.lab$i -text "$i:"
288  ttk::entry $w.a.e$i -width 8
289  set desc [sc_base extra $::curr_db flag$i]
290  $w.a.e$i insert end $desc
291  grid $w.a.lab$i -column $col -row 1
292  incr col
293  grid $w.a.e$i -column $col -row 1
294  incr col
295  }
296  ttk::frame $w.b
297  ttk::button $w.b.ok -text OK -command {
298  for {set i 1} {$i <7} {incr i} {
299  set desc [.bcustom.a.e$i get]
300  sc_base extra $::curr_db flag$i $desc
301  }
302  grab release .bcustom
303  destroy .bcustom
304 
305  # update the drop down menu of maint window and the menu of GameInfo window
306  for {set idx 12} {$idx < 18} {incr idx} {
307  set flag [ lindex $::maintFlaglist $idx]
308  set tmp [sc_base extra $::curr_db flag$flag]
309  if {$tmp == "" } { set tmp $::maintFlags($flag) }
310  .maintWin.mark.title.m entryconfigure $idx -label "$tmp ($flag)"
311  }
312 
313  # update the custom flags labels
314  for {set i 1} { $i < 7} { incr i} {
315  set desc [sc_base extra $::curr_db flag$i]
316  .maintWin.title.cust.text$i configure -text $desc
317  }
318  # ::maint::Refresh
319  }
320  ttk::button $w.b.cancel -text $::tr(Cancel) -command "grab release $w; destroy $w"
321  pack $w.a -side top -fill x
322  pack $w.b -side bottom -fill x
323  pack $w.b.cancel $w.b.ok -side right -padx 2 -pady 2
324  wm resizable $w 0 0
325  catch {grab $w}
326 }
327 
328 proc ::maint::Refresh {} {
329  global maintFlag maintFlags
331 
332  set w .maintWin
333  if {![winfo exists $w]} { return}
334  set ::curr_db [sc_base current]
335  set ng [sc_base numGames $::curr_db]
336  set dates [sc_base stats $::curr_db dates]
337  set deleted [sc_base stats $::curr_db flag D]
338  set marked [sc_base stats $::curr_db flag $maintFlag]
339  set flags [sc_base stats $::curr_db flags]
340  set ratings [sc_base stats $::curr_db ratings]
341  $w.title.vgames configure -text [::utils::thousands $ng]
342  $w.title.vicon configure -image dbt[sc_base extra $::curr_db type]
343  $w.title.vname configure -text [file tail [sc_base filename $::curr_db]]
344  $w.title.vdelete configure -text [::utils::percentFormat $deleted $ng]
345  $w.title.vmark configure -text [::utils::percentFormat $marked $ng]
346  $w.title.vfilter configure -text [::utils::percentFormat [sc_filter count] $ng]
347  $w.title.vdates configure \
348  -text "[lindex $dates 0]-[lindex $dates 1] ([lindex $dates 2])"
349  $w.title.vratings configure \
350  -text "[lindex $ratings 0]-[lindex $ratings 1] ([lindex $ratings 2])"
351 
352  if { [lsearch -exact { 1 2 3 4 5 6 } $maintFlag] != -1 } {
353  set tmp [sc_base extra $::curr_db flag$maintFlag]
354  if {$tmp == "" } { set tmp $maintFlags($maintFlag)}
355  } else {
356  set tmp $::tr($maintFlags($maintFlag))
357  }
358 
359  set flagname "$::tr(Flag): $tmp ($maintFlag)"
360 
361  $w.mark.title configure -text $flagname
362  $w.title.mark configure -text $flagname
363  $w.title.desc.text configure -text [sc_base extra $::curr_db description]
364 
365  # Disable buttons if current base is closed or read-only:
366  set state disabled
367  set curr_base [sc_base current]
368  if {![sc_base isReadOnly $curr_base]} {
369  set state normal
370  }
371  foreach spell {player event site round} {
372  $w.spell.$spell configure -state $state
373  }
374  foreach button {onCurrent offCurrent onAll offAll onFilter offFilter} {
375  $w.delete.$button configure -state $state
376  $w.mark.$button configure -state $state
377  }
378  $w.db.dups configure -state $state
379  $w.title.vicon configure -state $state
380  $w.title.desc.edit configure -state $state
381  $w.title.cust.edit configure -state $state
382  $w.db.elo configure -state $state
383  $w.db.autoload configure -state $state
384  $w.db.eco configure -state $state
385  $w.db.strip configure -state $state
386 
387  set state disabled
388  if {[baseIsCompactable]} {
389  set state normal
390  }
391  $w.db.compact configure -state $state
392  $w.db.cleaner configure -state $state
393 }
394 
395 
396 set autoloadGame 0
397 trace variable autoloadGame w {::utils::validate::Integer 9999999 0}
398 
399 # ::maint::SetAutoloadGame
400 #
401 # Creates a dialog for setting the autoload game number of the
402 # current database.
403 #
404 proc ::maint::SetAutoloadGame {} {
405  global autoloadGame
406  set w .autoload
407  if {[winfo exists $w]} { return}
408  toplevel $w
409  wm title $w "Scid"
410  set ::curr_db [sc_base current]
411  set autoloadGame [sc_base extra $::curr_db autoload]
412 
413  pack [ttk::frame $w.f] -side top -fill x -expand 1
414  ttk::label $w.f.label -text $::tr(AutoloadGame:)
415  ttk::entry $w.f.entry -textvar autoloadGame -justify right -width 10 ;# -foreground black -background white
416  pack $w.f.label $w.f.entry -side left
417 
418  pack [ttk::frame $w.set] -side top -fill x
419  ttk::button $w.set.none -text $::tr(None) -command {set autoloadGame 0}
420  ttk::button $w.set.first -text $::tr(First) -command {set autoloadGame 1}
421  ttk::button $w.set.current -text $::tr(Current) \
422  -command {set autoloadGame [sc_game number]}
423  ttk::button $w.set.last -text $::tr(Last) -command {set autoloadGame 9999999}
424  foreach i {none first current last} {$w.set.$i configure -style Small.TButton}
425  pack $w.set.none $w.set.first $w.set.current $w.set.last \
426  -side left -padx 1 -pady 2
427 
429 
430  pack [ttk::frame $w.b] -side top -fill x
431  ttk::button $w.b.ok -text OK -command \
432  "sc_base extra $::curr_db autoload \$autoloadGame; catch {grab release $w}; destroy $w"
433  ttk::button $w.b.cancel -text $::tr(Cancel) -command \
434  "catch {grab release $w}; destroy $w"
435  pack $w.b.cancel $w.b.ok -side right -padx 2
436 
437  bind $w.f.entry <Return> "$w.b.ok invoke"
438  bind $w.f.entry <Escape> "$w.b.cancel invoke"
439  wm resizable $w 0 0
441  focus $w.f.entry
442  grab $w
443 }
444 
445 # markTwins:
446 # Finds twin games and marks them for deletion.
447 # Takes parent window as parameter since it can be the main window,
448 # or the maintenance window.
449 #
450 proc markTwins {{parent .}} {
451  global twinSettings
452  if {[sc_base numGames $::curr_db] == 0} {
453  tk_messageBox -type ok -icon info -title [concat "Scid: " $::tr(noGames)] \
454  -message $::tr(TwinCheckNoDelete)
455  return
456  }
457 
458  set w .twinSettings
459  if {! [winfo exists $w]} {
460  toplevel $w
461  wm resizable $w 0 0
462  wm title $w "Scid: $::tr(DeleteTwins)"
463  pack [ttk::frame $w.f]
464  set small font_Small
465 
466  ttk::label $w.f.note -text $::tr(TwinsNote) -justify left -wraplength 500 -font $small
467  pack $w.f.note -side top -anchor w -ipady 0 -pady 0
468  addHorizontalRule $w.f
469  ttk::label $w.f.tc -text $::tr(TwinsCriteria) -font font_Bold
470  pack $w.f.tc -side top
471 
472  ttk::frame $w.f.g
473  pack $w.f.g -side top
474  set row 0
475  set col 0
476  foreach name {Colors Event Site Round Year Month Day Result ECO Moves} {
477  set n [string tolower $name]
478  ttk::checkbutton $w.f.g.b$n -text $::tr(Twins$name) \
479  -variable twinSettings($n) -onvalue Yes -offvalue No
480  grid $w.f.g.b$n -row $row -column $col -sticky w
481  incr col
482  if {$col >= 4} {
483  incr row; set col 0
484  } else {
485  grid [ttk::label $w.f.g.space$n -text " "] -row $row -column $col
486  incr col
487  }
488  }
489  ttk::frame $w.f.players
490  ttk::label $w.f.players.label -text $::tr(TwinsPlayers) -font $small
491  ttk::radiobutton $w.f.players.yes -variable twinSettings(players) -value Yes \
492  -text $::tr(TwinsPlayersExact) -style Small.TRadiobutton
493  ttk::radiobutton $w.f.players.no -variable twinSettings(players) -value No \
494  -text $::tr(TwinsPlayersPrefix) -style Small.TRadiobutton
495 
496  pack $w.f.players -side top
497  pack $w.f.players.label $w.f.players.yes $w.f.players.no -side left
498  }
499 
500 
501  addHorizontalRule $w.f
502  ttk::label $w.f.twhich -text $::tr(TwinsWhich:) -font font_Bold
503  pack $w.f.twhich -side top
504  pack [ttk::frame $w.f.g2] -side top -fill x
505  ttk::radiobutton $w.f.g2.exall -text $::tr(SelectAllGames) -style Small.TRadiobutton \
506  -variable twinSettings(usefilter) -value No
507  ttk::label $w.f.g2.space -text " " -font $small
508  ttk::radiobutton $w.f.g2.exfil -text $::tr(SelectFilterGames) -style Small.TRadiobutton \
509  -variable twinSettings(usefilter) -value Yes
510  grid $w.f.g2.exall -row 0 -column 0 -sticky e
511  grid $w.f.g2.space -row 0 -column 1
512  grid $w.f.g2.exfil -row 0 -column 2 -sticky w
513  grid columnconfigure $w.f.g2 0 -weight 1
514  grid columnconfigure $w.f.g2 2 -weight 1
515 
516  addHorizontalRule $w.f
517  ttk::label $w.f.twhen -text $::tr(TwinsWhen:) -font font_Bold
518  pack $w.f.twhen -side top
519  pack [ttk::frame $w.f.g3] -side top
520  set row 0
521  set col 0
522  foreach n {skipshort undelete setfilter comments variations} \
523  name {SkipShort Undelete SetFilter Comments Vars} {
524  ttk::checkbutton $w.f.g3.b$n -text $::tr(Twins$name) -variable twinSettings($n) -onvalue Yes -offvalue No
525  grid $w.f.g3.b$n -row $row -column $col -sticky w
526  incr col
527  if {$col >= 2} {
528  incr row; set col 0
529  } else {
530  grid [ttk::label $w.f.g3.space$n -text " "] -row $row -column $col
531  incr col
532  }
533  }
534  incr row
535  #$w.f.g3.lskipshort configure -text $::tr(TwinsSkipShort)
536  #$w.f.g3.lundelete configure -text $::tr(TwinsUndelete)
537  #$w.f.g3.lsetfilter configure -text $::tr(TwinsSetFilter)
538  #$w.f.g3.lcomments configure -text $::tr(TwinsComments)
539  #$w.f.g3.lvariations configure -text $::tr(TwinsVars)
540  ttk::label $w.f.g3.ldelete -text $::tr(TwinsDeleteWhich) -font font_Bold
541  grid $w.f.g3.ldelete -row $row -column 0 -sticky we -columnspan 3
542  incr row
543  ttk::frame $w.f.g3.vdelete
544  foreach v {Shorter Older Newer} {
545  ttk::radiobutton $w.f.g3.vdelete.v$v -text $::tr(TwinsDelete$v) \
546  -variable twinSettings(delete) -value $v -style Small.TRadiobutton
547  pack $w.f.g3.vdelete.v$v -side left -padx 5
548  }
549  grid $w.f.g3.vdelete -row $row -column 0 -columnspan 3
550 
551  #foreach g {g2 g3} {
552  # grid columnconfigure $w.f.$g 0 -weight 1
553  #}
554 
555  addHorizontalRule $w.f
556  ttk::frame $w.f.b
557  dialogbutton $w.f.b.defaults -textvar ::tr(Defaults) -command {
558  array set twinSettings [array get twinSettingsDefaults]
559  }
560  dialogbuttonsmall $w.f.b.help [ list -text $::tr(Help) -command "helpWindow Maintenance Twins; focus $w"]
561  dialogbuttonsmall $w.f.b.go [ list -text $::tr(TwinsDelete) -command {
562  if {[twinCriteriaOK .twinSettings]} {
563  grab release .twinSettings
564  .twinSettings.f.b.cancel configure -command "progressBarCancel"
565  set result [doMarkDups .twinSettings]
566  focus .
567  destroy .twinSettings
568  if {$result > 0} {
569  ::notify::DatabaseChanged
570  set gn [sc_filter first]
571  ::game::Load $gn
572  updateTwinChecker
573  }
574  }
575  }]
576 
577  dialogbuttonsmall $w.f.b.cancel [ list -text $::tr(Cancel) -command "grab release $w; focus .; destroy $w"]
578 
579  canvas $w.f.progress -width 300 -height 20 -bg white -relief solid -border 1
580  $w.f.progress create rectangle 0 0 0 0 -fill blue -outline blue -tags bar
581  $w.f.progress create text 295 10 -anchor e -font font_Regular -tags time \
582  -fill black -text "0:00 / 0:00"
583 
584  pack $w.f.progress -side bottom -padx 2 -pady 2
585  pack $w.f.b -side bottom -fill x
586  packbuttons right $w.f.b.cancel $w.f.b.go
587  packbuttons left $w.f.b.defaults $w.f.b.help
588  bind $w <F1> "$w.f.b.help invoke"
589  bind $w <Escape> "$w.f.b.cancel invoke"
590  bind $w <Return> "$w.f.b.go invoke"
591  grab $w
592  update idletasks
593  $w.f.note configure -wraplength [winfo width $w]
594  return
595 }
596 
597 # twinCriteriaOK:
598 # Check that the user specified at least three of the the same site,
599 # same round, and same year settings, since otherwise it is quite
600 # likely that actual games with similar moves will be marked as twins:
601 #
602 proc twinCriteriaOK {{parent .}} {
603  global twinSettings
604 
605  set msg $::tr(TwinCriteria1)
606 
607  # First, check that if same moves is off, then the same colors, event,
608  # site, round, year and month flags should all be set:
609  if {$twinSettings(moves) == "No"} {
610  if {$twinSettings(colors) == "No" || $twinSettings(event) == "No" || \
611  $twinSettings(site) == "No" || $twinSettings(year) == "No" || \
612  $twinSettings(month) == "No"} {
613  append msg $::tr(TwinCriteria2)
614  set result [tk_messageBox -type yesno -parent $parent -icon warning \
615  -title $::tr(TwinCriteriaConfirm) \
616  -message $msg]
617  if {$result == "no"} { return 0} else { return 1}
618  }
619  }
620 
621  # Now check that at least two of site, round, and year are set:
622  set count 0
623  if {$twinSettings(site) == "Yes"} { incr count}
624  if {$twinSettings(round) == "Yes"} { incr count}
625  if {$twinSettings(year) == "Yes"} { incr count}
626  if {$count < 2} {
627  append msg $::tr(TwinCriteria3)
628  set result [tk_messageBox -type yesno -parent $parent -icon warning \
629  -title $::tr(TwinCriteriaConfirm) \
630  -message $msg]
631  if {$result == "no"} { return 0} else { return 1}
632  }
633  return 1
634 }
635 
636 
637 proc doMarkDups {{parent .}} {
638  global twinSettings
639 
640  if {$twinSettings(undelete) == "Yes"} {
641  if {[catch {sc_base gameflag [sc_base current] all unset del}]} {
642  unbusyCursor .
644  return 0
645  }
646  }
647 
648  progressBarSet $parent.f.progress 301 21
649  if {[catch {sc_base duplicates [sc_base current] \
650  -colors $twinSettings(colors) \
651  -event $twinSettings(event) -site $twinSettings(site) \
652  -round $twinSettings(round) -year $twinSettings(year) \
653  -month $twinSettings(month) -day $twinSettings(day) \
654  -result $twinSettings(result) -eco $twinSettings(eco) \
655  -moves $twinSettings(moves) -players $twinSettings(players) \
656  -skipshort $twinSettings(skipshort) \
657  -setfilter $twinSettings(setfilter) \
658  -usefilter $twinSettings(usefilter) \
659  -comments $twinSettings(comments) \
660  -variations $twinSettings(variations) \
661  -delete $twinSettings(delete)} result]} {
663  set result 0
664  } else {
665  set message [subst $::tr(TwinCheckFound1)]
666  if {$result > 0} {append message $::tr(TwinCheckFound2)}
667  append message "."
668  tk_messageBox -type ok -parent $parent -icon info -title [concat "Scid: " $::tr(Result)] \
669  -message $message
670  }
672  return $result
673 }
674 
675 
676 set classifyOption(AllGames) all
677 set classifyOption(ExtendedCodes) 1
678 
679 # ClassifyAllGames:
680 # Reclassifies all games (recomputes the ECO code of each game).
681 # User can choose to reclassify all games, or only those games that
682 # currently have no ECO code assigned.
683 #
684 proc classifyAllGames {} {
686 }
687 
688 proc makeClassifyWin {} {
689  global classifyOption
690  set w .classify
691  if {[winfo exists $w]} {
692  raiseWin $w
693  return
694  }
695  toplevel $w
696  wm title $w "Scid: [tr FileMaintClass]"
697 
698  pack [ttk::frame $w.f] -expand 1
699 
700  ttk::label $w.f.label -font font_Bold -textvar ::tr(ClassifyWhich)
701  ttk::frame $w.f.g
702  ttk::radiobutton $w.f.g.all -textvar ::tr(ClassifyAll) -variable classifyOption(AllGames) -value all
703  ttk::radiobutton $w.f.g.filter -textvar ::tr(SelectFilterGames) -variable classifyOption(AllGames) -value filter
704  set year [::utils::date::today year]
705  set month [::utils::date::today month]
706  set day [::utils::date::today day]
707  ttk::radiobutton $w.f.g.year -textvar ::tr(ClassifyYear) -variable classifyOption(AllGames) \
708  -value "date:[expr $year - 1].$month.$day"
709  if {$month == "01"} {
710  incr year -1
711  set month 12
712  } else {
713  scan $month "%02u" month
714  incr month -1
715  set month [format "%02u" $month]
716  }
717  ttk::radiobutton $w.f.g.month -textvar ::tr(ClassifyMonth) -variable classifyOption(AllGames) \
718  -value "date:$year.$month.$day"
719  ttk::radiobutton $w.f.g.new -textvar ::tr(ClassifyNew) -variable classifyOption(AllGames) -value nocode
720  set row 0
721  foreach f {all filter year month new} {
722  grid $w.f.g.$f -row $row -column 0 -sticky w
723  incr row
724  }
725  ttk::label $w.f.codes -font font_Bold -textvar ::tr(ClassifyCodes:)
726  ttk::radiobutton $w.f.extended -textvar ::tr(ClassifyBasic) -variable classifyOption(ExtendedCodes) -value 0
727  ttk::radiobutton $w.f.basic -textvar ::tr(ClassifyExtended) -variable classifyOption(ExtendedCodes) -value 1
728 
729  ttk::frame $w.f.b
730  ttk::button $w.f.b.go -textvar ::tr(Classify) -command {
731  .classify.f.b.cancel configure -command "progressBarCancel"
732  .classify.f.b.cancel configure -textvar ::tr(Stop)
733  progressBarSet .classify.f.progress 301 21
734  grab .classify.f.b.cancel
735  if {[catch {sc_eco base $classifyOption(AllGames) $classifyOption(ExtendedCodes)} result]} {
736  grab release .classify.f.b.cancel
737  ERROR::MessageBox
738  } else {
739  grab release .classify.f.b.cancel
740  }
741  .classify.f.b.cancel configure -command {focus .; destroy .classify}
742  .classify.f.b.cancel configure -textvar ::tr(Close)
743  ::windows::gamelist::Refresh
744  }
745  ttk::button $w.f.b.cancel -textvar ::tr(Close) -command "focus .; destroy $w"
746  canvas $w.f.progress -width 300 -height 20 -bg white -relief solid -border 1
747  $w.f.progress create rectangle 0 0 0 0 -fill blue -outline blue -tags bar
748  $w.f.progress create text 295 10 -anchor e -font font_Regular -tags time \
749  -fill black -text "0:00 / 0:00"
750 
751  pack $w.f.label $w.f.g -side top -pady 5
752  addHorizontalRule $w.f
753  pack $w.f.codes $w.f.extended $w.f.basic -side top -pady 5
754  addHorizontalRule $w.f
755  pack $w.f.b -side top -pady 5 -fill x
756  pack $w.f.progress -side bottom -padx 2 -pady 2
757  pack $w.f.b.cancel $w.f.b.go -side right -pady 10 -padx 10
758  wm resizable $w 0 0
759  bind $w <F1> {helpWindow ECO}
760  bind $w <Escape> "$w.b.cancel invoke"
762 }
763 
764 proc updateClassifyWin {} {
765  set w .classify
766  if {! [winfo exists $w]} { return}
767  set state disabled
768  if {[sc_base inUse]} { set state normal}
769  $w.f.b.go configure -state $state
770 }
771 
772 # Twin checker window:
773 # Shows PGN of current game, and its twin.
774 
775 set twincheck(left) 0
776 set twincheck(right) 0
777 
778 proc updateTwinChecker {} {
779  global twincheck
780  set w .twinchecker
781  if {![winfo exists $w]} {
782  toplevel $w
783  pack [ttk::frame $w.b] -side bottom -fill x
784  pack [ttk::frame $w.f] -side top -fill both -expand yes
785  ttk::frame $w.f.left
786  pack $w.f.left -side left -fill y -expand yes
787  ttk::frame $w.f.split -width 2 -borderwidth 2 -relief sunken
788  pack $w.f.split -side left -fill y -padx 5
789  ttk::frame $w.f.right
790  pack $w.f.right -side left -fill y -expand yes
791  foreach i {left right} {
792  set f $w.f.$i
793  pack [ttk::frame $f.title] -side top -fill x
794  ttk::label $f.title.label -font font_Bold -text [concat $::tr(game) " 0: "]
795  ttk::checkbutton $f.title.d -text $::tr(Deleted) -variable twincheck($i) -style Small.TCheckbutton
796  ttk::label $f.title.note -font font_Small
797  pack $f.title.label $f.title.d $f.title.note -side left
798  ttk::label $f.tmt -font font_Small -text "" -anchor w -width 1 -relief sunken
799  pack $f.tmt -side bottom -fill x
800  autoscrollframe $f.t text $f.t.text \
801  -height 16 -width 40 -background white \
802  -takefocus 0 -wrap word
803  $f.t.text tag configure h -background lightSteelBlue
804  pack $f.t -side top -fill both -expand yes
805  }
806  $w.f.left.title.note configure -text [concat "(\"1\"" $::tr(TwinCheckUndelete)]
807  $w.f.right.title.note configure -text [concat "(\"2\"" $::tr(TwinCheckUndelete)]
808  ttk::button $w.b.prev -text $::tr(TwinCheckprevPair) \
809  -command {::game::LoadNextPrev previous}
810  ttk::button $w.b.next -text $::tr(TwinChecknextPair) -underline 0 \
811  -command {::game::LoadNextPrev next}
812  ttk::button $w.b.share -text $::tr(TwinCheckTag) -underline 0
813  ttk::button $w.b.delete -text $::tr(DeleteTwins) -underline 0 \
814  -command "markTwins $w"
815  ttk::button $w.b.help -text $::tr(Help) -command {helpWindow Maintenance Twins}
816  ttk::button $w.b.close -text $::tr(Close) -command "focus .; destroy $w"
817  pack $w.b.close $w.b.help $w.b.delete -side right -padx 5 -pady 2
818  pack $w.b.prev $w.b.next $w.b.share -side left -padx 5 -pady 2
819  bind $w <F1> "$w.b.help invoke"
820  bind $w <Escape> "focus .; destroy $w"
821  bind $w <Alt-p> {::game::LoadNextPrev previous}
822  bind $w <KeyPress-p> {::game::LoadNextPrev previous}
823  bind $w <Alt-n> {::game::LoadNextPrev next}
824  bind $w <KeyPress-n> {::game::LoadNextPrev next}
825  bind $w <Alt-d> "markTwins $w"
826  bind $w <KeyPress-d> "markTwins $w"
827  bind $w <KeyPress-1> "$w.f.left.title.d invoke"
828  bind $w <KeyPress-$::MB2> "$w.f.right.title.d invoke"
829  bind $w <KeyPress-s> "$w.b.share invoke"
830  bind $w <KeyPress-u> {
831  if {$twincheck(left)} {.twinchecker.f.left.title.d invoke}
832  if {$twincheck(right)} {.twinchecker.f.right.title.d invoke}
833  }
834  bind $w <Alt-u> {
835  if {$twincheck(left)} {.twinchecker.f.left.title.d invoke}
836  if {$twincheck(right)} {.twinchecker.f.right.title.d invoke}
837  }
838  wm resizable $w 0 1
839  wm title $w $::tr(TwinChecker)
840  }
841 
842  set gn [sc_game number]
843  set dup 0
844  if {$gn > 0} {
845  set dup [sc_game info duplicate]
846  }
847  set twincheck(left) 0
848  set twincheck(right) 0
849 
850  $w.f.left.title.label configure -text [concat $::tr(game) " $gn: "]
851 
852  if {$gn > 0} {
853  set twincheck(left) [sc_base gameflag [sc_base current] $gn get del]
854  $w.f.left.title.d configure -command "sc_base gameflag \[sc_base current\] $gn invert del; ::notify::GameChanged"
855  $w.f.left.title.d configure -state normal
856  set tmt [sc_game crosstable count +deleted]
857  $w.f.left.tmt configure -text [concat $::tr(TwinCheckTournament) $tmt]
858  } else {
859  $w.f.left.title.d configure -state disabled
860  $w.f.left.tmt configure -text ""
861  }
862  if {$dup > 0} {
863  set twincheck(right) [sc_base gameflag [sc_base current] $dup get del]
864  $w.f.right.title.label configure -text [concat $::tr(game) " $dup: "]
865  $w.f.right.title.d configure -command "sc_base gameflag \[sc_base current\] $dup invert del; ::notify::GameChanged"
866  $w.f.right.title.d configure -state normal
867  set tmt [sc_game crosstable count -game $dup +deleted]
868  $w.f.right.tmt configure -text [concat $::tr(TwinCheckTournament) $tmt]
869  } else {
870  $w.f.right.title.label configure -text $::tr(TwinCheckNoTwin)
871  $w.f.right.title.d configure -state disabled
872  $w.f.right.tmt configure -text ""
873  }
874 
875  $w.b.share configure -state disabled -command {}
876  if {$gn > 0 && $dup > 0} {
877  if {[llength [sc_game tags share check $gn $dup]] > 0} {
878  $w.b.share configure -state normal -command "shareTwinTags $gn $dup $w"
879  }
880  }
881  set t $w.f.left.t.text
882  $t configure -state normal
883  $t delete 1.0 end
884  $t insert end [sc_game pgn]
885 
886  set t $w.f.right.t.text
887  $t configure -state normal
888  $t delete 1.0 end
889  if {$dup > 0} {
890  $t insert end [sc_game pgn -gameNumber $dup]
891  } else {
892  $t insert end $::tr(TwinCheckNoTwinfound)
893  }
894 
895  # Now color the differences if appropriate:
896  if {$dup > 0} {
897  set rlen [$w.f.right.t.text index end-1c]
898  set llen [$w.f.left.t.text index end-1c]
899 
900  for {set i 0} {$i < $rlen} {incr i} {
901  set line [$w.f.right.t.text get $i.0 "$i.0 lineend"]
902  set length [string length $line]
903  set max 0
904  for {set j 0} {$j < $llen} {incr j} {
905  set otherLine [$w.f.left.t.text get $j.0 "$j.0 lineend"]
906  set plen [strPrefixLen $line $otherLine]
907  if {$plen > $max} { set max $plen}
908  }
909  if {$max < $length} {
910  if {![string compare [string index $line 0] "\["]} { set max 0}
911  $w.f.right.t.text tag add h $i.$max "$i.0 lineend"
912  }
913  }
914 
915  for {set i 0} {$i < $llen} {incr i} {
916  set line [$w.f.left.t.text get $i.0 "$i.0 lineend"]
917  set length [string length $line]
918  set max 0
919  for {set j 0} {$j < $rlen} {incr j} {
920  set otherLine [$w.f.right.t.text get $j.0 "$j.0 lineend"]
921  set plen [strPrefixLen $line $otherLine]
922  if {$plen > $max} { set max $plen}
923  }
924  if {$max < $length} {
925  if {![string compare [string index $line 0] "\["]} { set max 0}
926  $w.f.left.t.text tag add h $i.$max "$i.0 lineend"
927  }
928  }
929  }
930 
931  if {[sc_base inUse]} {
932  $w.b.delete configure -state normal
933  } else {
934  $w.b.delete configure -state disabled
935  }
936 
937  foreach side {left right} {
938  $w.f.$side.t.text configure -state disabled
939  }
940 
941 }
942 
943 # shareTwinTags:
944 # Updates the tags of two twin games by sharing information,
945 # filling in the date, round or ratings of each game based on
946 # the other where possible.
947 #
948 proc shareTwinTags {g1 g2 {parent .}} {
949  set sharelist [sc_game tags share check $g1 $g2]
950  if {[llength $sharelist] == 0} { return}
951 
952  set msg $::tr(TwinChangeTag)
953  foreach {gn tag old new} $sharelist {
954  append msg [concat $::tr(game) " $gn: $tag: \"$old\" -> \"$new\""]
955  append msg "\n"
956  }
957  set answer [tk_messageBox -parent $parent -title "Scid" \
958  -type okcancel -default ok -icon question -message $msg]
959  if {$answer != "ok"} { return}
960  sc_game tags share update $g1 $g2
961  sc_game tags reload
962  updateBoard -pgn
964 }
965 
966 # baseIsCompactable:
967 # Returns true only if the current base is compactable.
968 #
969 proc baseIsCompactable {} {
970  # Only a database that is in use, not read-only, and not the
971  # clipbase, can be compacted:
972  set curr_base [sc_base current]
973  if {[sc_base isReadOnly $curr_base]} { return 0}
974  if {$curr_base == $::clipbase_db} { return 0}
975  return 1
976 }
977 
978 proc compactDB {{base -1}} {
979  if {$base < 0} { set base [sc_base current]}
980  if {[::game::Clear] == "cancel"} { return}
981  if {[catch {sc_base compact $base stats} stats]} {
982  return [ERROR::MessageBox "$::tr(CompactDatabase)\n"]
983  }
984  set msg "[sc_base filename $base]\n\n"
985  append msg "Deleted games: [lindex $stats 0]\n"
986  append msg "Unused names: [lindex $stats 1]\n"
987  append msg "Sparse games: [lindex $stats 2]\n"
988  append msg "Missing names (bad idx): [lindex $stats 3]"
989  append msg "\n\nProceed?"
990  set confirm [tk_messageBox -type okcancel -icon info -parent . \
991  -title [concat "Scid: " $::tr(CompactDatabase)] \
992  -message "$msg"]
993  if {$confirm != "ok"} { return}
994 
995  #Ugly, but the safest approach, because:
996  # On windows child process inherits the file handles (if the child process was created
997  # after opening the database std::remove in scidBaseT::compact will fail)
998  # A child process may cause a racing condition (indirectly calling sc_base functions)
999  # i.e. in "annotate mode" an engine can save a game during the compaction
1000  # and it is difficult and too risky to try to predict all cases
1001  # TODO: avoid file handle inheritance
1002  # close the database before the compaction
1003  #
1004  destroy .analysisWin1
1005  destroy .analysisWin2
1006  destroy .serGameWin
1007  destroy .coachWin
1008  destroy .tacticsWin
1009  destroy .reviewgame
1010  if {[winfo exists .calvarWin]} { ::calvar::stop}
1011  destroy .inputengineconsole
1012 
1013  progressWindow "Scid" [concat $::tr(CompactDatabase) "..."] $::tr(Cancel)
1014  set err [catch {sc_base compact $base} result]
1016  if {$err} {
1017  set extra "$::tr(CompactDatabase)\n"
1018  if {$::errorCode == $::ERROR::FileOpen} {
1019  append extra "\n$::ERROR::msg(CompactCreate)"
1020  }
1021  ERROR::MessageBox "$extra"
1022  ::file::SwitchToBase $::clipbase_db 0
1024  } else {
1025  set msg "[sc_base filename $base]\n\n"
1026  append msg [tr GameFileCompacted]
1027  tk_messageBox -type ok -icon info -parent . \
1028  -title [concat "Scid: " $::tr(CompactDatabase)] \
1029  -message "$msg"
1032  }
1033 }
1034 
1035 # allocateRatings:
1036 # Allocate player ratings to games based on the spellcheck file.
1037 #
1038 set addRatings(overwrite) 0
1039 set addRatings(filter) 0
1040 
1041 proc allocateRatings {} {
1042  if {[catch {sc_name ratings -test 1} result]} {
1043  tk_messageBox -type ok -icon info -parent . -title "Scid" -message $result
1044  return
1045  }
1046  set w .ardialog
1047  toplevel $w
1048  wm title $w "Scid"
1049  ttk::label $w.lab -wraplength 3i -justify center -text $::tr(AllocRatingDescription)
1050  pack $w.lab -side top -expand 1 -fill x -anchor center
1052  pack [ttk::frame $w.r] -side top
1053  ttk::label $w.r.lab -text $::tr(RatingOverride)
1054  ttk::radiobutton $w.r.yes -variable addRatings(overwrite) \
1055  -value 1 -text $::tr(Yes)
1056  ttk::radiobutton $w.r.no -variable addRatings(overwrite) \
1057  -value 0 -text $::tr(No)
1058  pack $w.r.lab $w.r.yes $w.r.no -side left
1060  pack [ttk::frame $w.g] -side top -expand 1 -fill x
1061  ttk::label $w.g.lab -text $::tr(AddRatings)
1062  ttk::radiobutton $w.g.all -variable addRatings(filter) \
1063  -value 0 -text $::tr(SelectAllGames)
1064  ttk::radiobutton $w.g.filter -variable addRatings(filter) \
1065  -value 1 -text $::tr(SelectFilterGames)
1066  pack $w.g.lab $w.g.all $w.g.filter -side top
1068  pack [ttk::frame $w.b] -side top -fill x
1069  ttk::button $w.b.ok -text "OK" \
1070  -command "catch {grab release $w}; destroy $w; doAllocateRatings"
1071  ttk::button $w.b.cancel -text $::tr(Cancel) \
1072  -command "catch {grab release $w}; destroy $w"
1073  pack $w.b.cancel $w.b.ok -side right -padx 3 -pady 3
1074  catch {grab $w}
1075  focus $w.b.ok
1076 }
1077 
1078 proc doAllocateRatings {} {
1079  global addRatings
1080  if {[catch {sc_name ratings -test 1} result]} {
1081  tk_messageBox -type ok -icon info -parent . -title "Scid" -message $result
1082  return
1083  }
1084  progressWindow "Scid" "Adding Elo ratings..." $::tr(Cancel)
1085  set err [catch {sc_name ratings -change $addRatings(overwrite) -filter $addRatings(filter)} result]
1087  if {$err} {
1089  } else {
1090  set r [::utils::thousands [lindex $result 0]]
1091  set g [::utils::thousands [lindex $result 1]]
1092  tk_messageBox -type ok -icon info -parent . \
1093  -title "Scid" -message [subst $::tr(AddedRatings)]
1094  }
1095  ::notify::DatabaseModified $::curr_db
1096 }
1097 
1098 
1099 # stripTags:
1100 # Strip unwanted PGN tags from the current database.
1101 
1102 array set stripTagCount {}
1103 
1104 proc stripTags {} {
1105  global stripTagChoice stripTagCount
1106  set w .striptags
1107  if {[winfo exists $w]} {
1108  raise $w
1109  return
1110  }
1111  set stripTagList {}
1112 
1113  # Find extra PGN tags:
1114  progressWindow "Scid" "Searching for extra PGN tags..." $::tr(Cancel)
1115  set err [catch {sc_base tag list} result]
1117  if {$err} {
1119  return
1120  }
1121 
1122  # Make list of extra tags and their frequency:
1123  array unset stripTagCount
1124  set nTags 0
1125  foreach {tag count} $result {
1126  set stripTagCount($tag) $count
1127  incr nTags
1128  }
1129 
1130  if {$nTags == 0} {
1131  tk_messageBox -title "Scid" -icon info -type ok \
1132  -message "No extra tags were found."
1133  return
1134  }
1135 
1136  toplevel $w
1137  wm title $w "Scid: $::tr(StripTags)"
1138  ttk::label $w.title -text "Extra PGN tags:" -font font_Bold -anchor center
1139  pack $w.title -side top -fill x -anchor center
1140  pack [ttk::frame $w.f] -side top -fill x
1142  pack [ttk::frame $w.b] -side bottom -fill x
1143 
1144  set row 0
1145  foreach tag [lsort [array names stripTagCount]] {
1146  set count $stripTagCount($tag)
1147  ttk::radiobutton $w.f.t$tag -text "$tag " -variable stripTagChoice -value $tag
1148  ttk::label $w.f.c$tag -text [::utils::thousands $count]
1149  if {$row == 0} { set stripTagChoice $tag}
1150  grid $w.f.t$tag -row $row -column 0 -sticky w
1151  grid $w.f.c$tag -row $row -column 1 -sticky e
1152  incr row
1153  }
1154  ttk::button $w.b.find -text $::tr(SetFilter) -command findStripTags
1155  ttk::button $w.b.strip -text $::tr(StripTag...) -command {
1156  set removed [doStripTags .striptags]
1157  set stripTagCount($stripTagChoice) \
1158  [expr {$stripTagCount($stripTagChoice) - $removed} ]
1159  .striptags.f.c$stripTagChoice configure -text \
1160  [::utils::thousands $stripTagCount($stripTagChoice)]
1161  }
1162  ttk::button $w.b.cancel -text $::tr(Cancel) \
1163  -command "catch {grab release $w}; destroy $w"
1164  pack $w.b.cancel $w.b.strip $w.b.find -side right -padx 2 -pady 2
1165  wm resizable $w 0 0
1166  update
1167  catch {grab $w}
1168 }
1169 
1170 proc doStripTags {{parent .}} {
1171  global stripTagChoice
1172  set msg "Do you really want to remove all occurrences of the PGN tag"
1173  append msg " \"$stripTagChoice\" from this database?"
1174  set result [tk_messageBox -title "Scid" -parent $parent \
1175  -icon question -type yesno -message $msg]
1176  if {$result == "no"} { return 0}
1177  progressWindow "Scid" "Removing the PGN tag $stripTagChoice..." $::tr(Cancel)
1178  set err [catch {sc_base tag strip $stripTagChoice} result]
1180  if {$err} {
1182  return 0
1183  }
1184  set count 0
1185  set count $result
1186  set result "Removed $result instances of \"$stripTagChoice\"."
1187  append result "\n\n"
1188  append result "To save space and maintain database efficiency, it is a "
1189  append result "good idea to compact the game file after removing tags."
1190  tk_messageBox -title "Scid" -parent $parent -type ok -icon info \
1191  -message $result
1192  return $count
1193 }
1194 
1195 proc findStripTags {} {
1196  global stripTagChoice
1197  progressWindow "Scid" "Finding games with the PGN tag $stripTagChoice..." $::tr(Cancel)
1198  set err [catch {sc_base tag find $stripTagChoice} result]
1201 }
1202 
1203 
1204 # cleanerWin:
1205 # Open a dialog so the user can choose several maintenance tasks
1206 # in one action.
1207 
1208 set cleaner(players) 1
1209 set cleaner(events) 1
1210 set cleaner(sites) 1
1211 set cleaner(rounds) 1
1212 set cleaner(eco) 1
1213 set cleaner(elo) 1
1214 set cleaner(twins) 1
1215 set cleaner(cgames) 0
1216 
1217 proc cleanerWin {} {
1218  set w .mtoolWin
1219  if {[winfo exists $w]} { return}
1220 
1221  toplevel $w
1222  wm title $w "Scid: $::tr(Cleaner)"
1223  bind $w <F1> {helpWindow Maintenance Cleaner}
1224  pack [ttk::frame $w.f]
1225 
1226  pack [ttk::frame $w.f.help] -side top -fill x
1227  text $w.f.help.text -width 1 -height 8 -wrap word \
1228  -relief ridge -cursor top_left_arrow -yscrollcommand "$w.f.help.ybar set"
1229  ttk::scrollbar $w.f.help.ybar -orient vertical -command "$w.f.help.text yview" \
1230  -takefocus 0
1231  pack $w.f.help.ybar -side right -fill y
1232  pack $w.f.help.text -side left -fill x -expand yes
1233  $w.f.help.text insert end [string trim $::tr(CleanerHelp)]
1234  $w.f.help.text configure -state disabled
1235 
1236  pack [ttk::frame $w.f.f] -side top -padx 20
1237  foreach i {players events sites rounds} j {Players Events Sites Rounds} {
1238  ttk::label $w.f.f.$i -text "$::tr(Spellchecking): $::tr($j)"
1239  }
1240  ttk::label $w.f.f.eco -text $::tr(ReclassifyGames)
1241  ttk::label $w.f.f.elo -text $::tr(AddEloRatings)
1242  ttk::label $w.f.f.twins -text $::tr(DeleteTwins)
1243  ttk::label $w.f.f.cgames -text $::tr(CompactDatabase)
1244 
1245  foreach i {players events sites rounds eco elo twins cgames} {
1246  ttk::radiobutton $w.f.f.y$i -variable cleaner($i) -value 1 -text $::tr(Yes)
1247  ttk::radiobutton $w.f.f.n$i -variable cleaner($i) -value 0 -text $::tr(No)
1248  }
1249  set row 0
1250  foreach i {players events sites rounds eco elo twins cgames} {
1251  grid $w.f.f.$i -row $row -column 0 -sticky w
1252  grid $w.f.f.y$i -row $row -column 1 -sticky w
1253  grid $w.f.f.n$i -row $row -column 2 -sticky w
1254  incr row
1255  }
1256 
1257  addHorizontalRule $w.f
1258  pack [ttk::frame $w.f.b] -side bottom -fill x
1259  ttk::button $w.f.b.ok -text "OK" -command "catch {grab release $w}; destroy $w; doCleaner"
1260  ttk::button $w.f.b.cancel -text $::tr(Cancel) -command "catch {grab release $w}; destroy $w"
1261  pack $w.f.b.cancel $w.f.b.ok -side right -padx 2 -pady 2
1262  wm resizable $w 0 0
1263  # Remove the scrollbar if it is not needed:
1264  update
1265  set yview [$w.f.help.text yview]
1266  if {[lindex $yview 0] <= 0.01 && [lindex $yview 1] >= 0.99} {
1267  pack forget $w.f.help.ybar
1268  }
1269  catch {grab $w}
1270 }
1271 
1272 # Maximum nr of corrections to be scanned
1273 # Set to zero to find them all
1274 # Set to some positive number to limit
1275 #
1276 set cleaner_maxSpellCorrections 0
1277 
1278 
1279 proc doCleaner {} {
1280  global cleaner twinSettings
1281  global cleaner_maxSpellCorrections
1282 
1283  set dbase [sc_base current]
1284 
1285  set answer [tk_dialog .mtoolDialog "Scid" \
1286  [string trim $::tr(CleanerConfirm)] "" \
1287  0 $::tr(Yes) $::tr(No)]
1288  if {$answer != 0} { return}
1289 
1290  set w .mtoolStatus
1291  if {! [winfo exists $w]} {
1292  toplevel $w
1293  wm title $w "Scid: $::tr(Cleaner)"
1294  pack [ttk::frame $w.f]
1295  pack [ttk::frame $w.f.b] -side bottom -fill x -expand yes
1296  pack [ttk::frame $w.f.t] -side top -fill both -expand yes
1297  text $w.f.t.text -width 60 -height 10 -wrap none -setgrid 1 \
1298  -cursor top_left_arrow -yscrollcommand "$w.f.t.ybar set"
1299  ttk::scrollbar $w.f.t.ybar -orient vertical -command "$w.f.t.text yview" -takefocus 0
1300  pack $w.f.t.ybar -side right -fill y
1301  pack $w.f.t.text -side left -fill both -expand yes
1302  ttk::button $w.f.b.close -text $::tr(Close) -command "catch {grab release $w}; destroy $w"
1303  pack $w.f.b.close -side right -padx 2 -pady 2
1304  wm minsize $w 20 5
1305  }
1306 
1307  busyCursor .
1308  catch {grab $w}
1309  set t $w.f.t.text
1310  $t delete 1.0 end
1311  $t insert end "$::tr(Cleaner)."
1312  $t insert end " $::tr(Database): [file tail [sc_base filename $dbase]]\n"
1313 
1314  $w.f.b.close configure -state disabled
1315 
1316  set count 1
1317 
1318  foreach nameType {Player Event Site Round} {
1319  set names $nameType
1320  append names "s"
1321  set tag [string tolower $names]
1322  if {$cleaner($tag)} {
1323  mtoolAdd $t "$count: $::tr(Spellchecking): $::tr($names)..."
1324  incr count
1325  set err [catch {sc_name spellcheck -max $cleaner_maxSpellCorrections $nameType} corrections]
1326  if {! $err} {
1327  update
1328  set err [catch {sc_name correct $nameType $corrections} result]
1329  }
1330  if {$err} {
1331  set msg [ERROR::getErrorMsg]
1332  } else {
1333  set msg "Number of games corrected: [lindex $result 2]\n"
1334  }
1335  $t insert end " $msg\n"
1336  $t see end
1337  }
1338  }
1339 
1340  if {$cleaner(eco)} {
1341  mtoolAdd $t "$count: $::tr(ReclassifyGames)..."
1342  incr count
1343  catch {sc_eco base $::classifyOption(AllGames) \
1344  $::classifyOption(ExtendedCodes)} result
1345  $t insert end " $result\n"
1346  $t see end
1347  }
1348 
1349  if {$cleaner(elo)} {
1350  mtoolAdd $t "$count: $::tr(AddEloRatings)..."
1351  incr count
1352  if {[catch {sc_name ratings} result]} {
1353  $t insert end " $result\n"
1354  } else {
1355  set r [::utils::thousands [lindex $result 0]]
1356  set g [::utils::thousands [lindex $result 1]]
1357  $t insert end " Scid added $r Elo ratings in $g games.\n"
1358  }
1359  }
1360 
1361  if {$cleaner(twins)} {
1362  mtoolAdd $t "$count: $::tr(DeleteTwins)..."
1363  incr count
1364  if {$twinSettings(undelete) == "Yes"} {
1365  sc_base gameflag [sc_base current] all unset del
1366  }
1367  if {[catch {sc_base duplicates [sc_base current] \
1368  -colors $twinSettings(colors) \
1369  -event $twinSettings(event) -site $twinSettings(site) \
1370  -round $twinSettings(round) -year $twinSettings(year) \
1371  -month $twinSettings(month) -day $twinSettings(day) \
1372  -result $twinSettings(result) -eco $twinSettings(eco) \
1373  -moves $twinSettings(moves) -players $twinSettings(players) \
1374  -setfilter $twinSettings(setfilter) \
1375  -usefilter $twinSettings(usefilter) \
1376  -comments $twinSettings(comments) \
1377  -variations $twinSettings(variations) \
1378  -delete $twinSettings(delete)} result]} {
1379  set message $result
1380  } else {
1381  set message "Scid found $result twin games"
1382  if {$result > 0} {append message " and set their delete flags"}
1383  }
1384  $t insert end " $message.\n"
1385  }
1386 
1387  if {$cleaner(cgames)} {
1388  mtoolAdd $t "$count: $::tr(CompactDatabase)..."
1389  incr count
1390  if {[catch {sc_base compact $dbase stats} stats]} {
1391  $t insert end " Error: unable to compacwt the database.\n"
1392  } else {
1393  if {[lindex $stats 0] == 0 && [lindex $stats 1] == 0 && \
1394  [lindex $stats 2] == 0 && [lindex $stats 3] == 0} {
1395  $t insert end " Database already compacted.\n"
1396  } else {
1397  if {[catch {sc_base compact $dbase} result]} {
1398  $t insert end " Error: unable to compact the database.\n"
1399  } else {
1400  $t insert end " Done.\n"
1401  }
1402  }
1403  }
1404  $t see end
1405  }
1406 
1407  mtoolAdd $t "Done."
1409  ::notify::DatabaseModified $::curr_db
1410  $w.f.b.close configure -state normal
1411  catch {grab release $w}
1412  unbusyCursor .
1413 }
1414 
1415 proc mtoolAdd {tw title} {
1416  set time [clock format [clock seconds] -format "%H:%M:%S"]
1417  $tw insert end "\n\[$time\]\n"
1418  if {$title != ""} { $tw insert end "$title\n"}
1419  $tw see end
1420  update
1421 }
1422