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