Purpose: to show a tcl application that provides full text searching of
file information.

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.

----

 #! /bin/sh
 #untcl\
 exec wish $0 -- "$@"
 
 # --------------------- History --------------------------------
 # Authors: Jean-Claude Wippler, Alexandre Ferrieux, Larry Virden
 
 # v0.0  --- (Flat multi-grep.)
 
 #       Added interruptible search
 
 # v0.05         ---
 
 #       Added context window, highlighting, and +/-l,-f modes
 
 # v0.1  ---
 
 #       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  <Control-x><Control-f> to interactively open new files
 #      on platforms with no command line arguments (MacOS).
 
 # v0.17  --- (current)
 
 # -------------------- init ---------------------------------------------
 
 set lmode line
 set master {}
 set idx 0
 
 set running 0
 set ent {}
 
 # -------------------- GUI setup ----------------------------------------
 
 set lab "Loading"
 
 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 <Control-x><Control-c> exit
 bind .e <Up> {moveline -1}
 bind .e <Down> {moveline 1}
 
 bind .e <Control-x><Control-f> addfile
 
 .f.t tag configure hilite -background black -foreground white
 
 bind .f.t <Button-1> {clickline [lindex [split [.f.t index "@%x,%y linestart"] .] 0];break}
 bind .f.t <B1-Motion> 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]}
        }
 }
 
 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
        }
        set ff [open $f r]
        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]
        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 <Return> "$okcmd;break"
        bind $window.e <Escape> "$cancelcmd;break"
        bind $window.e <Control-g> "$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]}
                 * {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 <list of strings>)? (-f <filter>)? (<file>|-)+)+};exit 1}
 
 set para ""
 set filter ""
 set verbose 0
 
 set want ""
 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}
         *  {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 <Control-x><Control-c> exit
                bind .ctx <Up> {.ctx.t yview scroll -1 units}
                bind .ctx <Down> {.ctx.t yview scroll 1 units}
                bind .ctx <Prior> {.ctx.t yview scroll -1 pages}
                bind .ctx <Meta-v> {.ctx.t yview scroll -1 pages}
                bind .ctx <Next> {.ctx.t yview scroll 1 pages}
                bind .ctx <Control-v> {.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}]]
         }
        }
 
        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"
                                 }
                                }
                        }
                }
           }
        }] 0]
 
        set lab "$cnt items. ([expr {$t/1000}] ms)"
 
        clickline 0
        return 1
 }
 
 # ------------------------ Go ! ------------------------------------------
 
 recalc
 
----