Updated 2008-11-02 12:49:09 by hae

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.entry

The 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.