[Arjen Markus] (18 february 2003) I wanted a good, concise script that shows what Tcl is good at. That is, a script that performs tasks that are difficult or awkward in ''system programming languages'' or require lots of code. The script below uses the following techniques: * Glob-style string matching * Regular expressions * Interaction with the file system * Graphical user-interface in just a handful of lines of code * Reading from files without having to worry about the length of strings etc. What it does is this: * Look for files matching the given pattern * Read each line and see if they match the textual pattern * If so, display the line and the (first) matching part in the main window It could be enhanced with lots of extra options, manoeuvre through the directory tree, and so on. But to get people at least somewhat familiar with the techniques, this script (170 lines including comments) is adequate - I hope. ---- # agrep.tcl -- # Script to emulate the UNIX grep command with a small GUI # # createWindow -- # Create the main window # # Arguments: # None # Result: # None # Side effects: # Controls added to main window # proc createWindow {} { global filemask global pattern global ignore_case # # Menubar (simple) # frame .menubar -relief raised -borderwidth 1 pack .menubar -side top -fill x menubutton .menubar.file -text File -menu .menubar.file.menu menu .menubar.file.menu -tearoff false .menubar.file.menu add command -label Exit -command exit pack .menubar.file -side left # # Fill in fields # frame .f1 label .f1.empty -text " " label .f1.mask_label -text "Files:" -justify left label .f1.patt_label -text "Regular expression:" -justify left entry .f1.filemask -textvariable filemask entry .f1.pattern -textvariable pattern checkbutton .f1.ignore_case -variable ignore_case -text "Ignore case" button .f1.search -command searchFiles -text "Search" grid .f1.empty x x grid .f1.mask_label .f1.filemask .f1.search -sticky w grid .f1.patt_label .f1.pattern .f1.ignore_case -sticky w pack .f1 -side top -fill x # # Result window # frame .f2 text .f2.text -font "Courier 10" \ -yscrollcommand {.f2.y set} \ -xscrollcommand {.f2.x set} scrollbar .f2.x -command {.f2.text xview} -orient horizontal scrollbar .f2.y -command {.f2.text yview} grid .f2.text .f2.y -sticky ns grid .f2.x x -sticky we pack .f2 -side top # # Just for the fun of it: define the styles for the "matched", # "error" and "fn" tags # .f2.text tag configure "matched" -underline 1 -background yellow .f2.text tag configure "fn" -underline 1 -background lightblue .f2.text tag configure "error" -background red } # searchFiles -- # Search for files in the current directory that match the given # mask # # Arguments: # None # Result: # None # Side effects: # Calls "searchPattern" to fill the result window # proc searchFiles {} { global filemask global pattern global ignore_case # # Clear the result window, then get a list of files # .f2.text delete 0.1 end if { $filemask == "" } { set filemask "*" } foreach file [glob $filemask] { if { [file isdirectory $file] } { continue ;# Might become a recursive descent later :) } else { searchPattern $file $pattern $ignore_case } } } # searchPattern -- # Search for lines containing the given pattern in a file # # Arguments: # filename Name of the file to be searched # pattern Given regular expression # ignore_case Ignore the case or not # Result: # None # Side effects: # Fills the result window # proc searchPattern {filename pattern ignore_case} { if { [ catch { set infile [open $filename "r"] .f2.text insert end "$filename:\n" fn while { [gets $infile line] >= 0 } { if { $ignore_case } { set match [regexp -nocase -indices -- $pattern $line indices] } else { set match [regexp -indices -- $pattern $line indices] } if { $match } { set first [lindex $indices 0] set last [lindex $indices 1] .f2.text insert end [string range $line 0 [expr {$first-1}]] .f2.text insert end [string range $line $first $last] "matched" .f2.text insert end [string range $line [expr {$last+1}] end] .f2.text insert end "\n" } } close $infile } msg ] } { .f2.text insert end "$msg\n" } .f2.text insert end "\n" } # main -- # Main code to get it all going # global filemask global pattern global ignore_case set filemask "*" set pattern {} set ignore_case 1 createWindow ---- [Mike Tuxford]: This is more than adequate. The essentials are all quite easy tp apply and I thank you for that. It can't mach GNU grep for speed but the display has it's benefits, especially in this gui-oriented world. This is a 'keeper'. I added a simple timer output in miliseconds and ran it against grep on a directory with 57 files at 45MB. burp:/home/moogy/irclogs# ls | wc -l && du -s ./ 57 45132 . burp:/home/moogy/irclogs# time grep foobar * > /tmp/foobar real 0m1.600s user 0m0.120s sys 0m0.210s burp:/tcl/skel/misc# ./agrep.tcl 17192 milliseconds ---- see also [grep]. ---- see also '''Hits!''' [http://tclbuzz.com/v0/hits] ---- [TV] I'm not sure it is superfluous, but [bwise] for a long time had this one packed with it: proc grep { {a} {fs {*}} } { set o {} foreach n [lsort -incr -dict [glob $fs]] { set f [open $n r] set c 0 set new 1 while {[eof $f] == 0} { set l [gets $f] incr c if {[string first $a $l] > -1} { if {$new == 1} {set new 0; append o "*** $n:" \n} append o "$c:$l" \n } } close $f } return $o } The variable which contains the return value is formatted to be OK in a shell or console, but can easily be computer formatted too. Efficiency was fine on older PC's. It errs on subdirs when they match the searchpattern I just came up with, but it is small. [category command]