Scid  4.6.5
finder.tcl
Go to the documentation of this file.
1 ####################
2 # File finder window
3 
4 set ::file::finder::data(dir) [pwd]
5 set ::file::finder::data(sort) name
6 set ::file::finder::data(recurse) 0
7 set ::file::finder::data(stop) 0
8 set ::file::finder::data(Scid) 1
9 set ::file::finder::data(PGN) 1
10 set ::file::finder::data(Rep) 1
11 set ::file::finder::data(EPD) 1
12 set ::file::finder::data(Old) 1
13 
14 proc ::file::finder::Open {} {
15  set w .finder
16  if {[winfo exists $w]} { return}
17 
18  toplevel $w
19  wm title $w "Scid: $::tr(FileFinder)"
20  bind $w <F1> {helpWindow Finder}
22  bind $w <Configure> "recordWinSize $w"
23 
24  menu $w.menu
25  $w configure -menu $w.menu
26 
27  $w.menu add cascade -label FinderFile -menu $w.menu.file
28  menu $w.menu.file
29  $w.menu.file add checkbutton -label FinderFileSubdirs \
30  -variable ::file::finder::data(recurse) -onvalue 1 -offvalue 0 \
31  -command ::file::finder::Refresh
32  $w.menu.file add separator
33  $w.menu.file add command -label FinderFileClose -command "destroy $w"
34 
35  $w.menu add cascade -label FinderSort -menu $w.menu.sort
36  menu $w.menu.sort
37  foreach {name value} {Type type Size size Mod mod Filename name Path path} {
38  $w.menu.sort add radiobutton -label FinderSort$name \
39  -variable ::file::finder::data(sort) -value $value \
40  -command {::file::finder::Refresh -fast}
41  }
42 
43  $w.menu add cascade -label FinderTypes -menu $w.menu.types
44  menu $w.menu.types
45  foreach type {Scid Old PGN Rep EPD} {
46  $w.menu.types add checkbutton -label FinderTypes$type \
47  -variable ::file::finder::data($type) -onvalue 1 -offvalue 0 \
48  -command ::file::finder::Refresh
49  }
50 
51  $w.menu add cascade -label FinderHelp -menu $w.menu.helpmenu
52  menu $w.menu.helpmenu
53  $w.menu.helpmenu add command -label FinderHelpFinder \
54  -accelerator F1 -command {helpWindow Finder}
55  $w.menu.helpmenu add command -label FinderHelpIndex -command {helpWindow Index}
56 
57  pack [frame $w.d] -side top -fill x
58  label $w.d.label -text "$::tr(FinderDir):" -font font_Small
59  set ::file::finder::data(menu) [tk_optionMenu $w.d.mb ::file::finder::data(dir) ""]
60  $w.d.mb configure -font font_Small -width 1 -anchor e
61  $::file::finder::data(menu) configure -font font_Small
62  button $w.d.up -image tb_updir -command {::file::finder::Refresh ..}
63  pack $w.d.label -side left -padx 5
64  pack $w.d.up -side right -padx 5
65  pack $w.d.mb -side left -fill x -expand yes
66 
67  frame $w.t
68  frame $w.b
69  text $w.t.text -width 65 -height 25 -font font_Small -wrap none \
70  -fg black -bg white -yscrollcommand "$w.t.ybar set" -setgrid 1 \
71  -cursor top_left_arrow
72  scrollbar $w.t.ybar -command "$w.t.text yview" -width 12
73  $w.t.text tag configure Dir -foreground brown
74  $w.t.text tag configure Vol -foreground gray25
75  $w.t.text tag configure PGN -foreground blue
76  $w.t.text tag configure Scid -foreground red
77  $w.t.text tag configure Old -foreground black
78  $w.t.text tag configure Rep -foreground darkGreen
79  $w.t.text tag configure EPD -foreground orange
80  $w.t.text tag configure bold -font font_SmallBold
81  $w.t.text tag configure center -justify center
82  set xwidth [font measure [$w.t.text cget -font] "x"]
83  set tablist {}
84  foreach {tab justify} {15 r 30 r 32 l 50 l} {
85  set tabwidth [expr {$xwidth * $tab}]
86  lappend tablist $tabwidth $justify
87  }
88  $w.t.text configure -tabs $tablist
89 
90  checkbutton $w.b.sub -text [tr FinderFileSubdirs] \
91  -variable ::file::finder::data(recurse) -onvalue 1 -offvalue 0 \
92  -command ::file::finder::Refresh
93  dialogbutton $w.b.stop -textvar ::tr(Stop) -command {set finder(stop) 1 }
94  dialogbutton $w.b.help -textvar ::tr(Help) -command {helpWindow Finder}
95  dialogbutton $w.b.close -textvar ::tr(Close) -command "destroy $w"
96  bind $w <Escape> {
97  if {[winfo exists .finder.t.text.ctxtMenu]} {
98  destroy .finder.t.text.ctxtMenu
99  focus .finder
100  } else {
101  .finder.b.stop invoke
102  }
103  }
104  # Bind left button to close ctxt menu:
105  bind $w <ButtonPress-1> {
106  if {[winfo exists .finder.t.text.ctxtMenu]} {
107  destroy .finder.t.text.ctxtMenu
108  focus .finder
109  }
110  }
111  pack $w.b -side bottom -fill x
112  packbuttons right $w.b.close $w.b.help $w.b.stop
113  packbuttons left $w.b.sub
114  pack $w.t -side top -fill both -expand yes
115  pack $w.t.ybar -side right -fill y
116  pack $w.t.text -side left -fill both -expand yes
119 }
120 
121 proc ::file::finder::Refresh {{newdir ""}} {
122  variable data
123  set w .finder
124  if {! [winfo exists $w]} { return}
125  set t $w.t.text
126 
127  # When parameter is "-fast", just re-sort the existing data:
128  set fastmode 0
129  if {$newdir == "-fast"} {
130  set fastmode 1
131  set newdir ""
132  }
133  if {$newdir == ".."} { set newdir [file dirname $data(dir)]}
134  if {$newdir != ""} { set data(dir) $newdir}
135 
136  busyCursor .
137  set data(stop) 0
138  $w.b.close configure -state disabled
139  $w.b.help configure -state disabled
140  $w.b.sub configure -state disabled
141  $w.b.stop configure -state normal
142  catch {grab $w.b.stop}
143  $t configure -state normal
144  update
145 
146  if {$fastmode} {
147  set flist $data(flist)
148  } else {
149  set flist [::file::finder::GetFiles $data(dir)]
150  set data(flist) $flist
151  }
152 
153  switch $data(sort) {
154  "none" {}
155  "type" { set flist [lsort -decreasing -index 1 $flist]}
156  "size" { set flist [lsort -integer -decreasing -index 0 $flist]}
157  "name" { set flist [lsort -dict -index 2 $flist]}
158  "path" { set flist [lsort -dict -index 3 $flist]}
159  "mod" { set flist [lsort -integer -decreasing -index 4 $flist]}
160  }
161 
162  set hc yellow
163  $t delete 1.0 end
164  set dcount 0
165  $t insert end "$::tr(FinderDirs)\n" {center bold}
166  set dlist {}
167 
168  # Insert drive letters, on Windows:
169  if {$::windowsOS} {
170  foreach drive [lsort -dictionary [file volume]] {
171  $t insert end " $drive " [list Vol v$drive]
172  $t insert end " "
173  $t tag bind v$drive <1> [list ::file::finder::Refresh $drive]
174  $t tag bind v$drive <Any-Enter> \
175  "$t tag configure [list v$drive] -background $hc"
176  $t tag bind v$drive <Any-Leave> \
177  "$t tag configure [list v$drive] -background {}"
178  }
179  $t insert end "\n"
180  }
181 
182  # Insert parent directory entry:
183  lappend dlist ..
184 
185  # Generate other directory entries:
186  set dirlist [lsort -dictionary [glob -nocomplain [file join $data(dir) *]]]
187  foreach dir $dirlist {
188  if {[file isdir $dir]} {
189  lappend dlist $dir
190  }
191  }
192  foreach dir $dlist {
193  if {$dcount != 0} {
194  set sep "\n"
195  if {$dcount % 2 != 0} { set sep "\t\t\t"}
196  $t insert end $sep
197  }
198  incr dcount
199  if {$dir == ".."} {
200  set d ..
201  $t insert end " .. ($::tr(FinderUpDir)) " [list Dir d..]
202  } else {
203  set d [file tail $dir]
204  $t insert end " $d " [list Dir d$d]
205  }
206  $t tag bind d$d <1> [list ::file::finder::Refresh $dir]
207  $t tag bind d$d <Any-Enter> \
208  "$t tag configure [list d$d] -background $hc"
209  $t tag bind d$d <Any-Leave> \
210  "$t tag configure [list d$d] -background {}"
211  }
212 
213  # Add File section headings:
214  $t insert end "\n\n"
215  if {[llength $flist] != 0} {
216  foreach i {Type Size Mod Name Path} v {type size mod name path} {
217  $t tag configure s$i -font font_SmallBold
218  $t tag bind s$i <1> "set ::file::finder::data(sort) $v; ::file::finder::Refresh -fast"
219  $t tag bind s$i <Any-Enter> "$t tag config s$i -foreground red"
220  $t tag bind s$i <Any-Leave> "$t tag config s$i -foreground {}"
221  }
222  $t insert end "$::tr(FinderFiles)\n" {center bold}
223  $t insert end " "
224  $t insert end "[tr FinderSortType]" sType
225  $t insert end "\t"
226  $t insert end "[tr FinderSortSize]" sSize
227  $t insert end "\t"
228  $t insert end "[tr FinderSortMod]" sMod
229  $t insert end "\t"
230  $t insert end "[tr FinderSortName]" sName
231  $t insert end "\t"
232  $t insert end "[tr FinderSortPath]" sPath
233  $t insert end "\n"
234  }
235 
236  # Add each file:
237  foreach i $flist {
238  set size [lindex $i 0]
239  set type [lindex $i 1]
240  set fname [lindex $i 2]
241  set path [lindex $i 3]
242  set mtime [lindex $i 4]
243  set est [lindex $i 5]
244  $t insert end "\n "
245  $t insert end $type [list $type f$path]
246  set esize ""
247  if {$est} { set esize "~"}
248  append esize [::utils::thousands $size]
249  $t insert end "\t$esize" f$path
250  $t insert end "\t[clock format $mtime -format {%b %d %Y}]" f$path
251  $t insert end "\t$fname\t" f$path
252  set dir [file dirname $path]
253  set tail [file tail $path]
254  if {$dir == "."} {
255  set fullpath $data(dir)/$tail
256  } else {
257  set fullpath $data(dir)/$dir/$tail
258  }
259 
260  $t tag bind f$path <ButtonPress-1> "::file::Open [list $fullpath]"
261  # Bind right button to popup a contextual menu:
262  $t tag bind f$path <ButtonPress-$::MB3> "::file::finder::contextMenu .finder.t.text [list $fullpath] %x %y %X %Y"
263 
264  $t tag bind f$path <Any-Enter> \
265  "$t tag configure [list f$path] -background $hc"
266  $t tag bind f$path <Any-Leave> \
267  "$t tag configure [list f$path] -background {}"
268  if {$dir == "."} {
269  set fullpath "$data(dir)/$tail"
270  } else {
271  $t tag configure p$path -foreground darkblue
272  $t insert end "$dir/" [list p$path f$path]
273  }
274  $t tag configure t$path -foreground blue
275  $t insert end $tail [list t$path f$path]
276  }
277  $t configure -state disabled
278 
279  # Update directory menubutton:
280  $data(menu) delete 0 end
281  set mlist {}
282  set d {}
283  foreach subdir [file split $data(dir)] {
284  set d [file join $d $subdir]
285  lappend mlist $d
286  }
287  foreach m $mlist {
288  $data(menu) add command -label $m -command "::file::finder::Refresh [list $m]"
289  }
290 
291  catch {grab release $w.b.stop}
292  $w.b.stop configure -state disabled
293  $w.b.help configure -state normal
294  $w.b.close configure -state normal
295  $w.b.sub configure -state normal
296  unbusyCursor .
297 
298 }
299 ################################################################################
300 #
301 ################################################################################
302 proc ::file::finder::contextMenu {win fullPath x y xc yc} {
303 
304  update idletasks
305 
306  set mctxt $win.ctxtMenu
307 
308  if { [winfo exists $mctxt] } { destroy $mctxt}
309 
310  menu $mctxt
311  $mctxt add command -label [tr FinderCtxOpen] -command "::file::Open [list $fullPath]"
312  $mctxt add command -label [tr FinderCtxBackup] -command "::file::finder::backup [list $fullPath]"
313  $mctxt add command -label [tr FinderCtxCopy] -command "::file::finder::copy [list $fullPath]"
314  $mctxt add command -label [tr FinderCtxMove] -command "::file::finder::move [list $fullPath]"
315  $mctxt add separator
316  $mctxt add command -label [tr FinderCtxDelete] -command "::file::finder::delete $fullPath"
317 
318  $mctxt post [winfo pointerx .] [winfo pointery .]
319 
320 }
321 ################################################################################
322 # will backup a base in the form name-date.ext
323 ################################################################################
324 proc ::file::finder::backup { f } {
325  set r [file rootname $f]
326  set d [clock format [clock seconds] -format "-%Y.%m.%d-%H%M"]
327  set ext [string tolower [file extension $f]]
328  if { $ext == ".si4" } {
329  if { [catch { file copy "$r.sg4" "$r$d.sg4" ; file copy "$r.sn4" "$r$d.sn4"} err] } {
330  tk_messageBox -title Scid -icon error -type ok -message "File copy error $err"
331  return
332  }
333  catch { file copy "$r.stc" "$r$d.stc"}
334  }
335 
336  if { [catch { file copy "$r[file extension $f]" "$r$d[file extension $f]"} err] } {
337  tk_messageBox -title Scid -icon error -type ok -message "File copy error $err"
338  return
339  }
340 
342 }
343 ################################################################################
344 #
345 ################################################################################
346 proc ::file::finder::copy { f } {
347  if {[sc_base slot $f] != 0} {
348  tk_messageBox -title Scid -icon error -type ok -message "Close base first"
349  return
350  }
351  set dir [tk_chooseDirectory -initialdir [file dirname $f]]
352  if {$dir != ""} {
353  if { [string tolower [file extension $f]] == ".si4" } {
354  if { [catch { file copy "[file rootname $f].sg4" "[file rootname $f].sn4" $dir} err] } {
355  tk_messageBox -title Scid -icon error -type ok -message "File copy error $err"
356  return
357  }
358 
359  catch { file copy "[file rootname $f].stc" $dir}
360  }
361 
362  if { [catch { file copy $f $dir} err] } {
363  tk_messageBox -title Scid -icon error -type ok -message "File copy error $err"
364  return
365  }
366 
367  }
368 }
369 ################################################################################
370 #
371 ################################################################################
372 proc ::file::finder::move { f } {
373  if {[sc_base slot $f] != 0} {
374  tk_messageBox -title Scid -icon error -type ok -message "Close base first"
375  return
376  }
377  set dir [tk_chooseDirectory -initialdir [file dirname $f]]
378  if {$dir != ""} {
379  if { [string tolower [file extension $f]] == ".si4" } {
380 
381  if { [catch { file rename "[file rootname $f].sg4" "[file rootname $f].sn4" $dir} err] } {
382  tk_messageBox -title Scid -icon error -type ok -message "File rename error $err"
383  return
384  }
385  catch { file rename "[file rootname $f].stc" $dir}
386  }
387 
388  if { [catch { file rename $f $dir} err] } {
389  tk_messageBox -title Scid -icon error -type ok -message "File rename error $err"
390  return
391  }
392  }
394 }
395 ################################################################################
396 #
397 ################################################################################
398 proc ::file::finder::delete { f } {
399  if {[sc_base slot $f] != 0} {
400  tk_messageBox -title Scid -icon error -type ok -message "Close base first"
401  return
402  }
403  set answer [tk_messageBox -title Scid -icon warning -type yesno -message "Are you sure you want to permanently delete $f ?"]
404  if {$answer == "yes"} {
405  if { [string tolower [file extension $f]] == ".si4" } {
406  file delete "[file rootname $f].sg4" "[file rootname $f].sn4" "[file rootname $f].stc"
407  }
408  file delete $f
409  }
411 }
412 ################################################################################
413 #
414 ################################################################################
415 proc ::file::finder::ConfigMenus {{lang ""}} {
416  if {! [winfo exists .finder]} { return}
417  if {$lang == ""} { set lang $::language}
418  set m .finder.menu
419  foreach idx {0 1 2 3} tag {File Sort Types Help} {
420  configMenuText $m $idx Finder$tag $lang
421  }
422  foreach idx {0 2} tag {Subdirs Close} {
423  configMenuText $m.file $idx FinderFile$tag $lang
424  }
425  foreach idx {0 1 2 3 4} tag {Type Size Mod Name Path} {
426  configMenuText $m.sort $idx FinderSort$tag $lang
427  }
428  foreach idx {0 1 2 3 4} tag {Scid Old PGN Rep EPD} {
429  configMenuText $m.types $idx FinderTypes$tag $lang
430  }
431  foreach idx {0 1} tag {Finder Index} {
432  configMenuText $m.helpmenu $idx FinderHelp$tag $lang
433  }
434 }
435 
436 proc ::file::finder::GetFiles {dir {len -1}} {
437  variable data
438  set dlist {}
439  set flist {}
440  if {$len < 0} {
441  set len [expr {[string length $dir] + 1}]
442  }
443 
444  foreach f [glob -nocomplain [file join $dir *]] {
445  if {[file isdir $f]} {
446  lappend dlist $f
447  } elseif {[file isfile $f]} {
448  set ext [string tolower [file extension $f]]
449  if {[catch {set mtime [file mtime $f]}]} { set mtime 0}
450  set showFile 0
451  set rootname [file rootname $f]
452  set type PGN
453  if {$ext == ".si4"} {
454  set showFile 1
455  set type Scid
456  } elseif {$ext == ".si3"} {
457  set showFile 1
458  set type Old
459  } elseif {$ext == ".sor"} {
460  set showFile 1
461  set type Rep
462  } elseif {$ext == ".epd"} {
463  set type EPD
464  set showFile 1
465  } elseif {$ext == ".pgn"} {
466  set showFile 1
467  } elseif {$ext == ".gz"} {
468  set rootname [file rootname $rootname]
469  if {[regexp {\.epd\.gz} $f]} { set showFile 1; set type EPD}
470  if {[regexp {\.pgn\.gz} $f]} { set showFile 1}
471  }
472  if {$showFile && [info exists data($type)] && $data($type)} {
473  set path [string range $f $len end]
474  set est 0
475  if {[catch {set size [sc_info fsize $f]}]} {
476  # Could not determine file size, probably a PGN or EPD file
477  # that the user does not have permission to read.
478  set est 1
479  set size 0
480  }
481  if {$size < 0} {
482  set est 1
483  set size [expr {0 - $size}]
484  }
485  if {[file dirname $path] == "."} { set path "./$path"}
486  lappend flist [list $size $type [file tail $rootname] $path $mtime $est]
487  }
488  }
489  update
490  if {$data(stop)} { break}
491  }
492  if {$data(recurse)} {
493  foreach f $dlist {
494  foreach i [::file::finder::GetFiles $f $len] {
495  lappend flist $i
496  update
497  if {$data(stop)} { break}
498  }
499  }
500  }
501  return $flist
502 }
503