Purpose: to show a tcl prototype that provides full text searching of the contents of one or more files. Files can be specified on the comand line or on stdin. The following code was written back in 1998 by [JCW] and [Alexandre Ferrieux] based on comments and feedback by [Larry Virden]. Further optimizations would be appreciated. The idea behind this was this - in the ''olden days'' (back when I was a boy...) the people who had released Visicalc had a product (whose name escaped me) where searches took place in real time. The more data you added to the database, the faster you got to the data, because as you typed, the app would read more and more data as it spun under the extremely slow disk head, and by noting sectors which matched the keystrokes entered to date, could find the hit faster than waiting until the entire search term was entered and then searching all the sectors. One thing that is needed below is more error handling - like if a file doesn't exist, if no data files are supplied and stdin is a keyboard, etc. Also needs more docs on what the program '''does'''. ---- #! /bin/sh #untcl\ exec tclsh $0 -- "$@" # --------------------- History -------------------------------- # Authors: Jean-Claude Wippler, Alexandre Ferrieux, Larry Virden # Purpose: return one or more lines that match string typed into entry widget # default returns the line where hit occurs # application expects you to provide either one or more files on the # command line or data via stdin. # Usage: incrfilter -v -l +l {-p } {-f filter} file1 [file2 ...] - # -f allows one to specify a filter program as a second argument # -p indicates that searches should return a paragraph and not just a line # -l file mode - return the name of the file that contains the hit # +l line mode - return the line that contains the hit (default) # - read data from stdin # -v verbose mode # v0.00 --- (Flat multi-grep.) # Added interruptible search # v0.05 --- # Added context window, highlighting, and +/-l,-f modes # v0.10 --- # Replaced 'string match' by 'string first'. Faster ! (bad # perf with regexp; this delays JC's \<) # Moved -f's filter to visualization only. (So we match raw # data only).Faster ! (esp. useful with "nroff -man | col -b") # v0.15 --- # Added bottom status label. Improved visual feedback. # Added key bindings to both windows to help navigation # v0.16 --- # Added color highlighting # Added paragraph (-p {list of strings}) mode # v0.165 --- # Added internal expansion of wildcards (for Windows) # Added to interactively open new files # on platforms with no command line arguments (MacOS). # v0.17 # v0.18 --- # Prepared for dropping into Tcler's Wiki # v0.19 --- (current) # Added default switch settings and worked on stdin support # v0.20 # added Tk dependency # -------------------- init --------------------------------------------- set lmode line set master {} set idx 0 set running 0 set ent {} # -------------------- GUI setup ---------------------------------------- set lab "Loading" package require Tk wm title . IncrFilter entry .e -textvariable ent pack .e -side top -fill x label .l -textvariable lab -justify left -font [.e cget -font] pack .l -side bottom -anchor w frame .f pack .f -side bottom -fill both -expand yes text .f.t -yscrollcommand ".f.s set" -setgrid 1 -width 80 -state disabled scrollbar .f.s -command ".f.t yview" pack .f.s -side right -fill y pack .f.t -side left -expand 1 -fill both focus .e bind .e exit bind .e {moveline -1} bind .e {moveline 1} bind .e addfile .f.t tag configure hilite -background black -foreground white bind .f.t {clickline [lindex [split [.f.t index "@%x,%y linestart"] .] 0];break} bind .f.t break # --- early util --- proc ssplitN {s tt} { set l {} while {[string length $s]} { set z $s set n 0 foreach t $tt { set ii [string first $t $z] if {$ii<0} continue set z [string range $z 0 [expr {$ii-1}]] set n [string length $t] } lappend l $z set s [string range $s [expr {[string length $z]+$n}] end] } return $l } proc ssplit1 {s t} { set n [string length $t] set l {} while {1} { set ii [string first $t $s] if {$ii<0} { lappend l $s break } lappend l [string range $s 0 [expr {$ii-1}]] set s [string range $s [expr {$ii+$n}] end] } return $l } proc ssplit {s tt} { if {[llength $tt]==1} {ssplit1 $s [lindex $tt 0]} else {ssplitN $s $tt} } proc scopesplit {s mo} { switch -glob -- $mo { line {split $s \n} file {list $s} para:* {ssplit $s [string range $mo 5 end]} default { ; } } } proc swallowfile {f} { global idx verbose lab master lmode para filter tab if {[regexp -- {[\[*?]} $f]} { foreach f2 [glob $f] { swallowfile $f2 } return } incr idx if {$verbose} {puts stderr " (loading $f)"} if {![expr {($idx-1) % 10}]} { set lab "Loading $f" update } if { $f != "stdin" } { set ff [open $f "r"] } else { set ff "stdin" } } lappend master $idx if {$lmode=="para"} {append lmode :[subst -nocommands -novariables $para]} set tab($idx,lmode) $lmode set tab($idx,file) $f set tab($idx,filter) $filter set tab($idx,data) [scopesplit [read $ff] $lmode] if { $f != "stdin" } { close $ff } } proc modalentry {window title prompt destvar} { global entryvar global isok upvar $destvar dest catch {destroy $window} set oldf [focus] set isok 2 toplevel $window raise $window wm title $window $title label $window.l -text $prompt -anchor w append dest "" set entryvar $dest set okcmd "set isok 1" set cancelcmd "set isok 0" entry $window.e -width 40 -relief sunken -bd 2 -textvariable entryvar $window.e selection range 0 end bind $window.e "$okcmd;break" bind $window.e "$cancelcmd;break" bind $window.e "$cancelcmd;break" button $window.ok -text OK -command $okcmd button $window.cancel -text Cancel -command $cancelcmd pack $window.l $window.e $window.ok $window.cancel -side left -pady 5 -padx 5 update idletasks focus $window.e grab set $window tkwait variable isok grab release $window focus $oldf destroy $window if {$isok} {set dest $entryvar} return $isok } proc alert s { tk_dialog .a Arrgh $s "" 0 Okay! } proc modedialog f { global lmode para set e "+l" while {1} { if {![modalentry .d "Mode?" "Mode for \"[file tail $f]\":" e]} { return 0 } switch -glob -- $e { +l {set lmode line} -l {set lmode file} -p* {set lmode para;set para [lindex $e 1]} default {alert "Bad mode: $e";continue} } return 1 } } proc addfile {} { set f [tk_getOpenFile -title {Open File:}] if {$f==""} return if {[modedialog $f]} { swallowfile $f recalc } } # --------------------- opts and args -------------------------------- proc usage {} {puts stderr {Usage: incrfilter [-v] [+l|-l|-p ] [-f ] [] [-]};exit 1} set para "" set filter "" set verbose 0 set want "" set f "stdin" foreach a $argv { if {$want!=""} { set [lindex $want 0] $a set want [lrange $want 1 end] continue } switch -glob -- $a { -f {set want filter;continue} -p {set want para;set lmode para;continue} -v {set verbose 1;continue} -l {set lmode file;continue} +l {set lmode line;continue} - {set f stdin} -* {usage} default {set f $a} } } swallowfile $f switch -- [llength $master] { 0 {set tit IncrFilter} 1 {set tit $tab(1,file)} default {set tit "$tab(1,file) ..."} } wm title . "IncrFilter $tit" # --------------------- interaction --------------------------------------- proc recalc {} { global ent result lab set lab "Filtering..." update if {![applyfilter $ent]} return .f.t configure -state normal .f.t delete 1.0 end .f.t insert end [join $result \n] .f.t configure -state disabled } proc tracer args { global running interrupt if {$running} {set interrupt 1} else {after idle recalc} } trace variable ent w tracer proc allmatches {s pat} { set len [string length $pat] set l {} set off 0 while {1} { set res [string first $pat $s] if {$res<0} break lappend l [expr {$off+$res}] [expr {$off+$res+$len}] set delta [expr {$res+$len}] set s [string range $s $delta end] incr off $delta } return $l } set oldidx nope proc showctxwin {idx l pat} { global tab oldidx if {![winfo exists .ctx]} { toplevel .ctx if {!$idx} {lower .ctx .} text .ctx.t -yscrollcommand ".ctx.s set" -setgrid 1 \ -width 80 -state disabled scrollbar .ctx.s -command ".ctx.t yview" pack .ctx.s -side right -fill y pack .ctx.t -side left -expand 1 -fill both foreach i {1 2 3 4 5} c {red blue green brown black} { .ctx.t tag configure hilite$i -background $c -foreground white } bind .ctx exit bind .ctx {.ctx.t yview scroll -1 units} bind .ctx {.ctx.t yview scroll 1 units} bind .ctx {.ctx.t yview scroll -1 pages} bind .ctx {.ctx.t yview scroll -1 pages} bind .ctx {.ctx.t yview scroll 1 pages} bind .ctx {.ctx.t yview scroll 1 pages} } .ctx.t configure -state normal if {$oldidx!=$idx} { set oldidx $idx .ctx.t delete 1.0 end set reload 1 } else { foreach t [.ctx.t tag names] { .ctx.t tag remove $t 1.0 end } set reload 0 } .ctx.t configure -state disabled wm title .ctx Context if {!$idx} return wm title .ctx "Context in $tab($idx,file)" set lmode $tab($idx,lmode) .ctx.t configure -state normal if {$tab($idx,filter)==""} { set data $tab($idx,data) } else { update set raw [exec sh -c \ "$tab($idx,filter);exit 0" \ < $tab($idx,file) 2>@ stderr] set data [scopesplit $raw $lmode] } if {$reload} { .ctx.t insert end [join $data \n] } switch -glob -- $lmode { line { set ii $l.0 set xx [lindex $data [expr {$l-1}]] } file { set ii 1.0 set xx [lindex $data 0] } para:* { set ss [string length [join [lrange $data 0 [expr {$l-2}]] \n]] if {$l>1} {incr ss} set ii [.ctx.t index "1.0 +${ss}c"] set xx [lindex $data [expr {$l-1}]] } default { ; } } set i1 "" set ci 0 foreach pp $pat { if {$ci<5} {incr ci} foreach {i1 i2} [allmatches $xx $pp] { .ctx.t tag add hilite "$ii + ${i1}c" "$ii + ${i2}c" .ctx.t tag add hilite$ci "$ii + ${i1}c" "$ii + ${i2}c" } } .ctx.t configure -state disabled if {[catch { .ctx.t see [lindex [.ctx.t tag nextrange hilite $ii] 0] }]} { .ctx.t tag add hilite5 $ii "$ii + 1l" .ctx.t see $ii } } proc clickline l { global result2 ent clickedline set clickedline $l .f.t tag remove hilite 1.0 end if {!$l} {showctxwin 0 0 {};return} set ab [lindex $result2 [expr {$l-1}]] .f.t tag add hilite $l.0 "$l.0 + 1l" update showctxwin [lindex $ab 0] [lindex $ab 1] $ent .f.t see $clickedline.0 } proc moveline off { global result clickedline incr clickedline $off if {$clickedline<1} {set clickedline 1} set nn [llength $result] if {$clickedline>$nn} {set clickedline $nn} clickline $clickedline } # ----------------------- real meat -------------------------------------- proc applyfilter {f} { global running interrupt result result2 master tab lab set lmas [llength $master] set result {} set result2 {} set tot 0 set cnt 0 set t [lindex [time { foreach idx $master { set lmode $tab($idx,lmode) if {$lmas>1} {set pref "$tab($idx,file):\t"} else {set pref ""} set lnum 0 foreach x $tab($idx,data) { incr tot incr lnum if {![expr {$tot % 200}]} { set running 1 set interrupt 0 update set running 0 if {$interrupt} { after idle recalc return 0 } } set ok 1 #set x [string tolower $x] foreach pat $f { if {0>[string first $pat $x]} {set ok 0;break} } if {$ok} { incr cnt switch -glob -- $lmode { para:* { lappend result "${pref}($lnum)" lappend result2 "$idx $lnum" } line { lappend result "$pref$x" lappend result2 "$idx $lnum" } file { lappend result "$tab($idx,file)" lappend result2 "$idx 0" } default { ; } } } } } }] 0] set lab "$cnt items. ([expr {$t/1000}] ms)" clickline 0 return 1 } # ------------------------ Go ! ------------------------------------------ recalc ---- !!!!!! %| [Category Application] | [Category Word and Text Processing] | [Category File] |% !!!!!!