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

[CGM] 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]

****Live Demo****
[Jeff Smith] 2023-09-17 : Below is an online demo using [CloudTk]. This demo runs  “ReacTcl example: Grv” in an Alpine Linux Docker Container. It is a 27.8MB image which is made up of Alpine Linux + tclkit + ReacTcl-example-Grvt.kit +  libx11 + libxft + fontconfig. It is run under a user account in the Container. The Container is restrictive with permissions for "Other" removed for "execute" and "read" for certain directories.

'''N.B.''' Click on the "v" in the upper left corner when it appears to change the window view.

<<inlinehtml>>

<iframe height="750" width="750" src="https://cloudtk.tcl-lang.org/cloudtk/VNC?session=new&Tk=ReacTcl-example-Grv" allowfullscreen></iframe>

<<inlinehtml>>


----

****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
}
======