#------------------------------------------------------------------------------
# TextFind -- Utility to do a text search on a text file (sort of like 'grep').
#
#------------------------------------------------------------------------------
#
# ToDo List:
# - allow increasing and decreasing font size
# - screen type option changes (that don't require redoing the pattern search)
#   should happen right away
#------------------------------------------------------------------------------

# We use "trace add execution" which is found 8.4+.
package require Tcl 8.4
package require Tk 8.4

#------------------------------------------------------------------------------
# Globals
set trace_enabled 1 ;# Set to 0 in final release
set appname "TextFind"
set settings_file "~/.$appname"
set output_buffer [list] ;# Will have the matching lines
set line_number_buffer [list] ;# Will have the line numbers of matching lines

#------------------------------------------------------------------------------
# Set settings to sane defaults
#  Search settings
set non_matching_lines 0
set pattern_is_regex 0
set case_sensitive 0
#  Display settings
set search_in_results 0
set show_line_numbers 0
set wrap_lines 0
#  Other parameters
set num_lines_before 0
set num_lines_after 0
#  History variables
set pattern_history [list]
set file_history [list]
#  Indices into the history lists
set file_history_index 0
set pattern_history_index 0

#------------------------------------------------------------------------------
# Utility routines
proc show_message { part_title message } {
        tk_messageBox -title "$::appname: $part_title" -type ok -message $message
}

proc show_trace { trace_message } {
        if { $::trace_enabled } {
                show_message "Trace Message" $trace_message
        }
}

proc show_warning { warning_message } {
        show_message "WARNING!" $warning_message
}

proc show_error { error_message } {
        show_message "ERROR!" $error_message
}

proc select_file_dialog { filename_retvar win } {
        upvar $filename_retvar new_filename

        if { [llength $::file_history] } {
                set initial_dir [file dirname [lindex $::file_history 0]]
        } else {
                set initial_dir ""
        }

        set filename [tk_getOpenFile -initialdir $initial_dir]
        if { [string length $filename] != 0 } {
                set new_filename $filename
        }
}

#------------------------------------------------------------------------------
# Save settings
proc save_settings { args } {
        set rc [catch {
                set fp [open $::settings_file "w"]
                if { $::non_matching_lines == 1 } {
                        puts $fp "non_matching_lines=1"
                }
                if { $::pattern_is_regex == 1 } {
                        puts $fp "pattern_is_regex=1"
                }
                if { $::case_sensitive == 1 } {
                        puts $fp "case_sensitive=1"
                }
                if { $::search_in_results == 1 } {
                        puts $fp "search_in_results=1"
                }
                if { $::show_line_numbers == 1 } {
                        puts $fp "show_line_numbers=1"
                }
                if { $::wrap_lines == 1 } {
                        puts $fp "wrap_lines=1"
                }
                if { [string match $::num_lines_before ""] } {
                        set ::num_lines_before 0
                }
                if { [string match $::num_lines_after ""] } {
                        set ::num_lines_after 0
                }
                if { $::num_lines_before } {
                        puts $fp "num_lines_before=$::num_lines_before"
                }
                if { $::num_lines_after } {
                        puts $fp "num_lines_after=$::num_lines_after"
                }
                set idx 0
                foreach pattern $::pattern_history {
                        puts $fp "pattern_$idx=$pattern"
                        incr idx
                }
                set idx 0
                foreach file $::file_history {
                        puts $fp "file_$idx=$file"
                        incr idx
                }
                close $fp
        } errstr]
        if { $rc } {
                show_warning "Could not save settings to settings file $::settings_file ($errstr)"
        }
}

# Load settings
proc load_settings { } {

        # If settings file exists, then load settings into the appropriate globals
        if { ! [file exists $::settings_file] } {
                return
        }
        set rc [catch {
                set fp [open "$::settings_file"]
                set settings_data [read $fp]
                close $fp
        } errstr]
        if { $rc } {
                show_warning "Unable to read settings file $::settings_file ($errstr) -- will fallback to defaults"
                return
        }

        set ignored_some_settings 0

        # Settings are lines of the form "lhs=rhs".
        set settings_list [split $settings_data "\n"]
        foreach setting $settings_list {
                if { [string length [string trim $setting]] == 0 } {
                        continue
                }
                set lhs_rhs_list [split $setting "="]
                if { [llength $lhs_rhs_list] != 2 } {
                                set ignored_some_settings 1
                        continue ;# Skip entries we don't understand
                }
                set lhs [string trim [lindex $lhs_rhs_list 0]]
                set rhs [string trim [lindex $lhs_rhs_list 1]]
                switch -glob -- $lhs {
                        non_matching_lines { 
                                if { [string equal $rhs "1"] } {
                                        set ::non_matching_lines 1
                                }
                        }
                        pattern_is_regex { 
                                if { [string equal $rhs "1"] } {
                                        set ::pattern_is_regex 1
                                }
                        }
                        case_sensitive { 
                                if { [string equal $rhs "1"] } {
                                        set ::case_sensitive 1
                                }
                        }
                        search_in_results { 
                                if { [string equal $rhs "1"] } {
                                        set ::search_in_results 1
                                }
                        }
                        show_line_numbers { 
                                if { [string equal $rhs "1"] } {
                                        set ::show_line_numbers 1
                                }
                        }
                        wrap_lines { 
                                if { [string equal $rhs "1"] } {
                                        set ::wrap_lines 1
                                }
                        }
                        num_lines_before {
                                if { [string is digit $rhs] } {
                                        set ::num_lines_before $rhs
                                }
                        }
                        num_lines_after {
                                if { [string is digit $rhs] } {
                                        set ::num_lines_after $rhs
                                }
                        }
                        pattern_* { ;# Pattern history
                                set pattern_split [split $lhs "_"]
                                set pattern_num [lindex $pattern_split 1]
                                if { ! [string is digit -strict $pattern_num] } {
                                        break
                                }
                                set ::pattern_history [linsert $::pattern_history $pattern_num $rhs]
                        }
                        file_* { ;# File history
                                set file_split [split $lhs "_"]
                                set file_num [lindex $file_split 1]
                                if { ! [string is digit -strict $file_num] } {
                                        break
                                }
                                set ::file_history [linsert $::file_history $file_num $rhs]
                        }
                        default {
                                set ignored_some_settings 1
                        }
                }
        }
        if { $ignored_some_settings == 1 } {
                show_warning "Ignored some settings in file $::settings_file."
        }
}

#------------------------------------------------------------------------------
# Main code starts here
load_settings
trace add execution exit enter save_settings

wm title . $appname
wm protocol . WM_DELETE_WINDOW exit


#------------------------------------------------------------------------------
# Start displaying the UI

frame .top_frame
frame .top_frame.grep_options
bind .top_frame.grep_options <Return> { .entry.grep invoke }

checkbutton .top_frame.grep_options.non_matching_lines -variable non_matching_lines -text "Show non-matching lines"
bind .top_frame.grep_options.non_matching_lines <Return> { .entry.grep invoke }

checkbutton .top_frame.grep_options.pattern_is_regex -variable pattern_is_regex -text "Pattern is regular expression"
bind .top_frame.grep_options.pattern_is_regex <Return> { .entry.grep invoke }

checkbutton .top_frame.grep_options.case_sensitive -variable case_sensitive -text "Case sensitive"
bind .top_frame.grep_options.case_sensitive <Return> { .entry.grep invoke }

checkbutton .top_frame.grep_options.search_in_results -variable search_in_results -text "Search within results"
bind .top_frame.grep_options.search_in_results  <Return> { .entry.grep invoke }

checkbutton .top_frame.grep_options.show_line_numbers -variable show_line_numbers -text "Show line numbers"
bind .top_frame.grep_options.show_line_numbers  <Return> { .entry.grep invoke }

checkbutton .top_frame.grep_options.wrap_lines -variable wrap_lines -text "Wrap lines"
bind .top_frame.grep_options.wrap_lines  <Return> { .entry.grep invoke }

set num_lines [frame .top_frame.grep_options.num_lines]
label $num_lines.num_lines_before_label -text "Lines before match:"
entry $num_lines.num_lines_before -textvar num_lines_before -validate key -validatecommand [list string is digit %P] -width 4
bind $num_lines.num_lines_before <Return> { .entry.grep invoke }

label $num_lines.num_lines_after_label -text "Lines after match:"
entry $num_lines.num_lines_after -textvar num_lines_after -validate key  -validatecommand [list string is digit %P] -width 4
bind $num_lines.num_lines_after <Return> { .entry.grep invoke }


grid .top_frame.grep_options.non_matching_lines .top_frame.grep_options.pattern_is_regex .top_frame.grep_options.case_sensitive -sticky w
grid .top_frame.grep_options.search_in_results .top_frame.grep_options.show_line_numbers .top_frame.grep_options.wrap_lines -sticky w
grid $num_lines -columnspan 3

grid $num_lines.num_lines_before_label $num_lines.num_lines_before $num_lines.num_lines_after_label $num_lines.num_lines_after

frame .top_frame.actions
button .top_frame.actions.clear_history -text "Clear History" -command { 
        set pattern_history [list]
        set file_history [list]
        .top_frame.actions.clear_history configure -state disabled
}

# Disable 'clear history' button if nothing to clear; starts of enabled
if { [llength $pattern_history] == 0 && [llength $file_history] == 0 } {
        .top_frame.actions.clear_history configure -state disabled
}

pack .top_frame.actions.clear_history
pack .top_frame.grep_options -expand yes -fill x -side left
pack .top_frame.actions -fill both -side right
pack .top_frame -anchor n -fill x

frame .entry

set target_file ""
button .entry.b_target_file -text "File to search:" -command { select_file_dialog target_file %W } 
entry .entry.target_file -textvar target_file -background white -foreground black
bind .entry.target_file <Return> { .entry.grep invoke }
bind .entry.target_file <Down> {
        if { $file_history_index > 0 } {
                incr file_history_index -1
                set ::target_file [lindex $::file_history $file_history_index]
        } else {
                set ::target_file ""
        }
}
bind .entry.target_file <Up> {
        set ::target_file [lindex $::file_history $file_history_index]
        if { $file_history_index < [expr [llength $file_history] - 1] } {
                incr file_history_index
        }
}

grid .entry.b_target_file -row 0 -column 0 -sticky w
grid .entry.target_file -row 0 -column 1 -sticky ew

label .entry.l_pattern -text "Search pattern:"
entry .entry.pattern -textvar search_pattern -background white -foreground black
bind .entry.pattern <Return> { .entry.grep invoke }
bind .entry.pattern <Down> {
        if { $pattern_history_index > 0 } {
                incr pattern_history_index -1
                set ::search_pattern [lindex $::pattern_history $pattern_history_index]
        } else {
                set ::search_pattern ""
        }
}
bind .entry.pattern <Up> {
        set ::search_pattern [lindex $::pattern_history $pattern_history_index]
        if { $pattern_history_index < [expr [llength $pattern_history] - 1] } {
                incr pattern_history_index
        }
}

grid .entry.l_pattern -row 1 -column 0 -sticky w
grid .entry.pattern -row 1 -column 1 -sticky ew

button .entry.grep -text "Find" -command { do_grep .output_window_frame.output_window }

grid .entry.grep -row 0 -column 2 -rowspan 2 -sticky news

grid columnconfigure .entry 1 -weight 1

pack .entry -fill x -anchor n

frame .output_window_frame
scrollbar .output_window_frame.vscroll -command { .output_window_frame.output_window yview } -orient vertical
scrollbar .output_window_frame.hscroll -command { .output_window_frame.output_window xview } -orient horizontal

text .output_window_frame.output_window -background white -foreground black -xscrollcommand { .output_window_frame.hscroll set } -yscrollcommand { .output_window_frame.vscroll set }

# Create text window tags for line numbers and regular text
.output_window_frame.output_window tag configure LINE_NUMBER_TAG -font { Courier 8 }
.output_window_frame.output_window tag configure SEARCH_TEXT_TAG -font { Courier 8 }

grid .output_window_frame.output_window -row 0 -column 0 -sticky news
grid .output_window_frame.vscroll -row 0 -column 1 -sticky ns
grid .output_window_frame.hscroll -row 1 -column 0 -sticky ew
grid rowconfigure .output_window_frame 0 -weight 1
grid columnconfigure .output_window_frame 0 -weight 1

pack .output_window_frame -expand 1 -fill both

frame .status

set num_matching_lines 0
label .status.matches_str -text "Matches: "
pack .status.matches_str -side left
label .status.num_matching_lines -textvar num_matching_lines
pack .status.num_matching_lines -side left

set pattern_used ""
label .status.pattern_used_str -text "Pattern: "
pack .status.pattern_used_str -side left
label .status.pattern_used -textvar pattern_used
pack .status.pattern_used -side left

set grep_time 0
label .status.grep_time_str -text "Time Taken: "
pack .status.grep_time_str -side left
label .status.grep_time -textvar grep_time
pack .status.grep_time -side left


pack .status -fill x

set geom [wm geometry .]
after idle {
        update idletasks
        wm minsize . [winfo reqwidth .] [winfo reqheight .]
}
wm deiconify .
focus .

proc do_grep { output_window } {
        set ::grep_time [time {

        if { [string length $::num_lines_before] == 0 } {
                set ::num_lines_before 0
        }

        if { [string length $::num_lines_after] == 0 } {
                set ::num_lines_after 0
        }

        # Save the pattern and file in the history lists
        set ::pattern_history [linsert $::pattern_history 0 $::search_pattern]
        set ::file_history [linsert $::file_history 0 $::target_file]
        # Enable clear history button
        .top_frame.actions.clear_history configure -state normal
        # Reset index into the history lists
        set ::pattern_history_index 0
        set ::file_history_index 0

        set lines [list]

        if { $::search_in_results } {
                if { [llength $::line_number_buffer] == 0 } {
                        return
                }
        } else {
                set error [catch {
                        set file_descriptor [open $::target_file]
                        set data [read $file_descriptor]
                        set ::output_buffer [split $data "\n"]
                        close $file_descriptor
                        unset file_descriptor
                } error_message]

                if { $error } {
                        show_error "$::target_file: $error_message"
                        return
                }

                wm title . "$::appname ($::target_file)"

                set ::line_number_buffer [list]
        }

        # Clear the output
        $output_window delete 1.0 end

        # Actually do the search
        tk_grep

        if { $::wrap_lines } {
                $output_window configure -wrap char
        } else {
                $output_window configure -wrap none
        }

        show_output_buffer $output_window
}]
}

proc show_output_buffer { output_window } {
        if { $::show_line_numbers } {
                set lno_str_len [string length [lindex $::line_number_buffer end]]
                foreach line_num $::line_number_buffer line $::output_buffer {
                        if { [string is digit $line_num] } {
                                set lno [format "%0${lno_str_len}d" $line_num]
                                $output_window insert end "$lno: " LINE_NUMBER_TAG
                                $output_window insert end "$line\n" SEARCH_TEXT_TAG
                        } else {
                                $output_window insert end "---\n" LINE_NUMBER_TAG
                        }
                }
        } else {
                foreach line $::output_buffer {
                        $output_window insert end "$line\n" SEARCH_TEXT_TAG
                }
        }
}

proc tk_grep { } {
        set input_buffer $::output_buffer
        set input_line_number_buffer $::line_number_buffer
        if { [llength $input_line_number_buffer] == 0 } {
                set use_input_line_number_buffer 0
        } else {
                set use_input_line_number_buffer 1
        }

        set ::output_buffer [list]
        set ::line_number_buffer [list]

        set command_prefix [list]
        if { $::pattern_is_regex } {
                lappend command_prefix "regexp"
                set pattern $::search_pattern
        } else {
                lappend command_prefix "string"
                lappend command_prefix "match"
                set pattern "*$::search_pattern*" ;# For string match purposes
        }
        if { ! $::case_sensitive } {
                lappend command_prefix "-nocase"
        }
        # Below should be after above -- sequence matters here
        if { $::pattern_is_regex } {
                lappend command_prefix "--"
        }
        lappend command_prefix $pattern

        set line_number 1
        set ::num_matching_lines 0
        set ::pattern_used $pattern
        foreach line $input_buffer {
                set cmd $command_prefix
                lappend cmd $line
                set result [eval $cmd]
                if { $::non_matching_lines && ! $result || ! $::non_matching_lines && $result } {
                        if { $use_input_line_number_buffer } {
                                set lstidx [expr $line_number - 1]
                                set base_lno [lindex $input_line_number_buffer $lstidx]
                        } else {
                                set base_lno $line_number
                        }
                        if { $::num_lines_before } {
                                set n $::num_lines_before
                                while { $n > 0 } {
                                        set lno [expr $base_lno - $n]
                                        set ll [lindex $input_buffer [expr $lno - 1]]
                                        lappend ::output_buffer "$ll"
                                        lappend ::line_number_buffer "$lno"
                                        incr n -1
                                }
                        }
                        lappend ::line_number_buffer "$base_lno"
                        lappend ::output_buffer "$line"
                        if { $::num_lines_after } {
                                set n 1
                                while { $n <= $::num_lines_after } {
                                        set lno [expr $base_lno + $n]
                                        if { $lno >= [llength $input_buffer] } {
                                                break;
                                        }
                                        set ll [lindex $input_buffer $lno]
                                        lappend ::output_buffer "$ll"
                                        lappend ::line_number_buffer "$lno"
                                        incr n
                                }
                        }
                        if { $::num_lines_before || $::num_lines_after } {
                                lappend ::output_buffer "--"
                                lappend ::line_number_buffer "--"
                        }
                        incr ::num_matching_lines
                }
                incr line_number
        }
}