****grv - GRep/View files in a directory tree****

This page is intended to provide a non-trivial example of how the [ReacTcl] framework can be used.

Grv is a program to dig around a source code tree.  The name indicates that
it '''gr'''eps and then '''v'''iews.  It uses a simple GUI where you can enter literal
text or a regular expression which will then be searched for in all the files
in the current directory and its subdirectories.  You can also enter a
glob-style pattern to restrict the files searched to those with matching
names.  The results of this search are displayed in a table.  Clicking on one
of these results will open the corresponding file at that line in a text
window, with the matched text highlighted.

I originally wrote this program in a rather ad-hoc style, and have used it heavily
for several years.  I recently refactored it to use the ReacTcl framework,
which I think suits it quite well.  To keep the program responsive with a large source tree it's important
not to waste time by re-doing operations unnecessarily, and the ReacTcl
framework provides a natural way of tracking what needs to be re-done at any
time and what does not.
****Screenshots****

Main Screen showing search results

[grv_main]

A File View window with search results highlighted

[grv_file]

****Code****

======
# Grep/View source tree
#

source [file join [file dirname [info script]] reactcl.tcl]

########################### Set up screen ############################
# Set up main screen - this has input fields for filename pattern and
# content search pattern, then a table to show the matches found.

package require treectrl

frame .sf
ttk::label .sf.patlabel -text { Search for (Regex):}
pack .sf.patlabel -side left

set pat [ttk::combobox .sf.pat]
bind $pat <Return> run_find
focus $pat
pack .sf.pat -side left -expand true -fill x

ttk::label .sf.fpatlabel -text {  in Files matching (glob):}
set fpat [ttk::entry .sf.fpat]
$fpat insert 0 *
bind $fpat <Return> run_find
pack .sf.fpatlabel .sf.fpat -side left

ttk::button .sf.run -text Run -width 6 -command run_find
pack .sf.run -side right

treectrl .tc -yscrollcommand {.ys set} -xscrollcommand {.xs set} -width 800 -height 400
foreach col {Filename Line Text} {
    .tc column create -text $col
}
.tc element create el1 text
.tc style create s1
.tc style elements s1 el1
.tc style layout s1 el1 -ipadx 2
.tc element configure el1 -fill {red active}
.tc configure -treecolumn 0

scrollbar .ys -command {.tc yview} -orient vertical
scrollbar .xs -command {.tc xview} -orient horizontal
grid .sf -sticky ew -padx 10
grid .tc .ys
grid .tc -sticky nsew
grid .ys -sticky ns
grid .xs -sticky ew

grid columnconfigure . 0 -weight 1
grid columnconfigure . 1 -weight 0
grid rowconfigure . 0 -weight 0
grid rowconfigure . 1 -weight 1

bind .tc <1> "left_click %x %y"
bind .tc <Return> "left_click %x %y"

bind $pat <1> {$pat set {}}

wm title . "grv - GRep/View in [pwd]"

########################### Scan Files ############################

react text_pattern

react file_pattern

# Search for the pattern in the specified files and display the results
proc run_find {} {

    if {[catch {$::pat get} pattern]} return

    text_pattern == $pattern

    file_pattern == [$::fpat get]

    set col [pattern_colour $pattern]
    $::pat configure -values [lreverse [dict keys [pattern_colours]]]

    matches_shown

    highlight_all
}

# Display search results in the table
react matches_shown := {

    catch {
        .tc item delete [.tc item firstchild root] [.tc item lastchild root]
    }

    foreach {file_name file_matches} [all_matches] {
        foreach {lineno line line_matches} $file_matches {

            set item [.tc item create -button 0]
            .tc item style set $item 0 s1
            .tc item text $item 0 $file_name
            .tc item style set $item 1 s1 2 s1
            .tc item text $item 1 $lineno
            .tc item text $item 2 $line
            .tc item lastchild root $item
        }
    }
}

# Look for the text pattern in all the specified files
react all_matches := {

    set all_matches {}
    foreach fname [file_names] {

        set matches [matches get $fname [text_pattern]]

        if {[llength $matches]} {
            lappend all_matches $fname $matches
        }
    }
    set all_matches
}

# Find the list of files whose names match the file pattern
react file_names := {

    set namelist {}
    add_filenames . [file_pattern] namelist
    return $namelist
}

proc add_filenames {dir fpat listVar} {
    upvar $listVar namelist

    foreach f [lsort [glob -directory $dir -nocomplain -type {f r} -- $fpat]] {
        lappend namelist $f
    }

    foreach d [lsort [glob -directory $dir -nocomplain -type {d r} -- *]] {
        add_filenames $d $fpat namelist
    }
}


# Search the text from one file for the specified pattern
react_map matches {filename txtpat} {

    if {$txtpat eq ""} {
        return {0 {} {}}
    }
    set file_matches {}
    foreach line [contents get $filename] {
        incr lineno
        set line_matches [regexp -nocase -all -inline -indices -- $txtpat $line]
        if {[llength $line_matches]} {
            lappend file_matches $lineno $line $line_matches
        }
    }
    return $file_matches
}


# Read in the specified file
react_map contents filename {
    set fh [open $filename]
    try {
        set text [read $fh 1000000]; # limit text size to 1MB
        if {[string first \0 $text] >= 0} {return {##########}}; # binary file?
        split $text \n
    } finally {
        close $fh
    }
}


########################### Display Files ############################

set displayed_files [dict create]
react displayed_files <= displayed_files

# When a line in the results table is clicked, display that file
proc left_click {x y} {
    set item [lindex [.tc identify $x $y] 1]
    if {$item eq ""} return
    set filename [.tc item text $item 0]
    set lineno [.tc item text $item 1]
    displays get $filename
    highlights get $filename
    dict set ::displayed_files $filename {}

    set win [windows get $filename]
    wm deiconify $win
    raise $win
    $win.t see $lineno.0
}

# Create a window to display the specified file
react_map windows filename {

    set tl .top[incr ::displaycount]
    toplevel $tl
    wm title $tl $filename
    wm iconbitmap $tl gray12

    set text $tl.t
    text $text -height 65 -width 110 -bg white -yscroll "$tl.sb set"
    set sb [ttk::scrollbar $tl.sb -command "$text yview"]
    grid $sb -column 0 -row 0 -sticky ns
    grid $text -column 1 -row 0 -sticky nsew
    # let text box only expand
    grid rowconfigure $tl 0 -weight 1
    grid columnconfigure $tl 1 -weight 1

    foreach colour $::colours {
        $text tag configure $colour -background $colour
    }

    # disable editing the text
    bind $text <<PasteSelection>> break
    bind $text <Delete> break
    bind $text <Key> {if {[string length %A]} break}

    wm protocol $tl WM_DELETE_WINDOW [list wm withdraw $tl]

    return $tl
}

# Display the file in its window
react_map displays filename {
    set text [windows get $filename].t
    $text delete 1.0 end
    foreach line [contents get $filename] {
        $text insert end $line {} \n {}
    }
}

################### Highlight Pattern Matches In Files ####################

# Highlight the matches of all patterns in all displayed files
react highlight_all := {
    dict for {filename -} [displayed_files] {
        highlights get $filename
    }
}

# Highlight the matches of all patterns in one file
react_map highlights filename {
    dict for {pat -} [pattern_colours] {
        pat_highlights get $filename $pat
    }
}

# Highlight the matches of one pattern in one file
react_map pat_highlights {filename txtpat} {

    set text [windows get $filename].t
    set clr [dict get $::tpat_cols $txtpat]
    $text tag remove $clr 1.0 end ;# Clear all the found tags.
    $text tag raise $clr

    foreach {lineno line line_matches} [matches get $filename $txtpat] {
        foreach match $line_matches {
            lassign $match first last
            $text tag add $clr $lineno.$first "$lineno.$last + 1 chars"
        }
    }
}

# Map each text pattern to a different colour
set colours [list lightgreen yellow orange pink violet {light sky blue} ]

set tpat_cols [dict create]
react pattern_colours <= tpat_cols

proc pattern_colour tpat {
    if {[dict exists $::tpat_cols $tpat]} {
        set colour [dict get $::tpat_cols $tpat]
        dict unset ::tpat_cols $tpat
    } else {
        set colour [lindex $::colours [incr ::col_index]-1]
        if {$colour eq {}} {
            set old_pat [lindex [dict keys $::tpat_cols] 0]
            set colour [dict get $::tpat_cols $old_pat]
            dict unset ::tpat_cols $old_pat
        }
    }
    dict set ::tpat_cols $tpat $colour
    return $colour
}
======