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