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