As a result of the recent postings on clt, concerning a tcl/tk only file finder for windows, the following is a crude, slow, but working script (which really has a lot of room for improvement), however, it does work;
# A little piece of work due to recent discussions on clt
# drives.tcl from the tclers Wiki
# find from Jeffery Hobbs, from the tcllib, from the Wiki
# pp interface etc by Steve Offutt Thursday January 11, 2001
#mapped drives:
#from the tcler's Wiki
proc drives {} {
foreach drive \
[list a b c d e f g h i j k l m n o p q r s t u v w x y z] {
if {[catch {file stat ${drive}: dummy}] == 0} {
lappend drives $drive
}
}
return $drives
}
#source drives.tcl
set mylist [drives]
#just in case we need to know how many
set count [llength $mylist]
#which it turns out we dont - yet
global file_count
set file_count "0"
set current [pwd]
set drv_ltr [string index $current 0]
set drive "$drv_ltr:/"
proc make_rb { list parent} {
global drv_ltr
foreach item $list {
grid [radiobutton $parent.$item -text [string toupper "$item:"] -variable drv_ltr \
-command {chg_drv} -value [string toupper "$item" ] ]
}
}
proc chg_drv { } {
global drive
global drv_ltr
set drive "$drv_ltr:/"
}
menu .menubar -type menubar
.menubar add cascade -label "File" -menu .menubar.file -underline 0
.menubar add cascade -label "New Search" -menu .menubar.new -underline 0
menu .menubar.file -tearoff 0
.menubar.file add command -label Exit -underline 1 -command { exit}
menu .menubar.new -tearoff 0
.menubar.new add command -label Clear -underline 0 -command { clear }
. configure -menu .menubar
frame .main -bd 1 -relief groove -width 300 -height 300
frame .main.top -bd 2 -relief groove -width 300 -height 150
frame .main.bl -bd 2 -relief flat -width 150 -height 150
frame .main.br -bd 2 -relief flat -width 150 -height 150
listbox .main.br.lb -yscrollcommand ".main.br.scroll set" -selectmode browse \
-xscrollcommand ".main.br.x_scroll set" \
-bg white -width 30
scrollbar .main.br.scroll -command ".main.br.lb yview"
scrollbar .main.br.x_scroll -command ".main.br.lb xview" -orient horizontal
label .main.bl.label -text "Drives:"
label .main.top.label -text "File to find:"
entry .main.top.entry -textvariable find_this -width 30
label .main.top.l2 -text "Current directory:"
label .main.top.l3 -text [pwd]
label .main.top.l4 -text "Drive to search:"
entry .main.top.e4 -textvariable drive
button .main.top.b1 -text "Search now" -command {search_now} -relief groove
label .main.top.l5 -relief flat -textvariable file_count
grid .main.top.label .main.top.entry -sticky ew
grid .main.top.l2 .main.top.l3 -sticky ew
grid .main.top.l4 .main.top.e4 -sticky ew
grid .main.top.b1 .main.top.l5 -sticky ew -columnspan 1
grid .main.top -sticky ew -column 0 -columnspan 2
grid .main.bl.label -sticky ew -columnspan 1
make_rb $mylist .main.bl
grid .main.bl -sticky news -columnspan 1 -column 0
label .main.br.label -text "Matching files:"
grid .main.br.label -sticky ew
grid .main.br.lb .main.br.scroll -sticky nsew
grid .main.br.x_scroll -sticky snew
grid .main.br -sticky news -row 1 -column 1 -columnspan 1
grid .main -columnspan 2
global my_file_list
set my_file_list { }
namespace eval ::fileutil {}
proc ::fileutil::find {{basedir .} {filtercmd {}}} {
#another change
global files
set oldwd [pwd]
cd $basedir
set cwd [pwd]
set filenames [glob -nocomplain * .*]
set files {}
set filt [string length $filtercmd]
# If we don't remove . and .. from the file list, we'll get stuck in an infinite loop
foreach special [list "." ".."] {
set index [lsearch -exact $filenames $special]
set filenames [lreplace $filenames $index $index]
}
foreach filename $filenames {
# Use uplevel to eval the command, not eval, so that variable
# substitutions occur in the right context.
if {!$filt || [uplevel $filtercmd [list $filename]]} {
lappend files [file join $cwd $filename]
}
if {[file isdirectory $filename]} {
set files [concat $files [find $filename $filtercmd]]
}
}
cd $oldwd
return $files
}
# Use like:
#::fileutil::find $dir {string equal README}
proc search_now { } {
global find_this
global my_file_list
global drive
global file_count
set dir $drive
set my_string "string equal -nocase $find_this"
set my_file_list [::fileutil::find $dir $my_string]
show_list
set file_count [llength $my_file_list]
}
bind .main.top.entry <Return> {search_now}
proc show_list { } {
global my_file_list
foreach item $my_file_list {
.main.br.lb insert end $item
}
}
proc clear { } {
.main.br.lb delete 0 end
.main.top.entry delete 0 end
}
console hide
wm title . "Tk File Finder (windoze)"
wm deiconify .
focus .main.top.entryThe one thing that you can do with this is to build lists of files with varying filenames across different drives. You will have to script a way to export the list for yourself... ;^)
so
In order to properly search an NTFS system (where a user might not have permissions on all directories, change the following: In
proc ::fileutil::find {{basedir .} {filtercmd {}}} {# assorted commands removed
if {![catch [cd $basedir]]} {# assorted commands removed
}
cd $oldwd
return $files
}Ryan Casey
LES Of course it is slow. You'll be a lot better off building and saving a file name list that can be searched later on instead of scanning disks in every search. In my system, whenever PowerPro detects lack of mouse and keyboard activity for 30 minutes, it launches my Tcl script to scan all drives and update the list. When I run a search, I'm only searching a flat text-based list, so it is fast. It would be even faster with an SQLite database (although the first query within a certain time span always is slow).
And I almost forgot to add an interesting bit: my method follows exactly the same model of the updatedb/slocate pair of Unix tools, but in my experience, Tcl always seems to scan and index my disks considerably faster than updatedb.
Another way of recursively file walking is shown on page Matthias Hoffmann - Tcl-Code-Snippets.