#!/usr/local/bin/wish
set VERSION {termite,v 1.1.1.1 2004/02/29 21:52:24 jcc Exp}

#
# Termite: Eat logs, etc.
#
# Author: J. Chris Coppick
#
# Usage: termite \[options\] <filename>"
#        Options:  -fp <regex>     - Filter Pattern"
#                  -csf            - Case-Sensitive Filtering"
#                  -hp <regex>     - Highlighting Pattern"
#                  -hc <color>     - Highlighting Color"
#                  -csh            - Case-Sensitive Highlighting"
#                  -as             - Auto-Scrolling"
#                  -ln             - Line Numbering"
#

# Sample X resources:
#
#   Termite*Font:             7x14bold
#   Termite*selectBackground: SlateGrey
#   Termite*selectForeground: yellow
#   Termite*background:       SlateGrey
#   Termite*foreground:       WhiteSmoke
#   Termite*highlightThickness: 0
#   Termite*troughColor:      grey
#   Termite*activeForeground: yellow
#   Termite*activeBackground: grey
#   Termite*highlightColor:   grey
#   Termite.scroll.activeBackground: Slategrey
#   Termite.log.foreground:   white
#   Termite.log.background:   black
#   Termite.log.font:         9x15bold
#   Termite.log.width:        80
#   Termite.log.height:       24
#   Termite*hc:               red
#   Termite*ln:               false
#   Termite*as:               true
#

#
# Procs...
#

#
# My tkFDialog_Done doesn't challenge the user when appending to an
# existing file...
#
catch {auto_load tkFDialog_Done}
set file_append 0
proc tkFDialog_Done {w {selectFilePath ""}} {
    upvar #0 $w data
    global tkPriv file_append

    if ![string compare $selectFilePath ""] {
	set selectFilePath [file join $data(selectPath) $data(selectFile)]
	set tkPriv(selectFile)     $data(selectFile)
	set tkPriv(selectPath)     $data(selectPath)

	if {[file exists $selectFilePath] && !$file_append &&
	    ![string compare $data(type) save]} {

	    set reply [tk_messageBox -icon warning -type yesno \
	        -message "File \"$selectFilePath\" already exists.\nDo you want to overwrite it?"]
	    if ![string compare $reply "no"] {
		return
	    }
	}
    }
    set tkPriv(selectFilePath) $selectFilePath
}


#
# Highlight log text that matches some pattern
#
proc hilite_text {} {

   global hpattern hcase_option hcolor

   scan [.log index end] %d numlines
   for {set i 1} {$i<=$numlines} {incr i} {
      .log mark set line ${i}.0
      if {[regexp $hcase_option $hpattern [.log get line "line lineend"]]} {
         .log tag add hilite line "line lineend"
      }
   }
   .log tag configure hilite -foreground $hcolor
}

#
# Create a dialog that allows the user to set highlighting options.
#
proc hilite_dialog {} {

   global hnewpattern

   toplevel .hd -class Dialog
   wm title .hd "Highlight Settings"
   wm iconname .hd "Dialog"

   frame .hd.top -relief raised -bd 1
   frame .hd.opts -relief raised -bd 1
   frame .hd.bot -relief sunken
   pack .hd.top -side top -fill both
   pack .hd.opts -side top -fill both
   pack .hd.bot -side bottom -fill both

   label .hd.top.label -text "Pattern: "
   entry .hd.top.pattern -width 40 -relief sunken -bd 2 \
         -textvariable hnewpattern
   bind .hd.top.pattern <Return> {hilite_apply $hnewpattern}
   pack .hd.top.label .hd.top.pattern -side left -padx 1m -pady 2m

   checkbutton .hd.opts.case -text "Case Sensitivity" \
               -command {hilite_case_toggle}
   pack .hd.opts.case -side left

   button .hd.bot.apply -text "Apply" -command {hilite_apply $hnewpattern}
   button .hd.bot.cancel -text "Cancel" -command {hilite_cancel}
   pack .hd.bot.apply .hd.bot.cancel -side left -expand 1 -padx 2 -pady 2
}

#
# Cancel highlighting dialog
#
proc hilite_cancel {} {
   destroy .hd
}

#
# Apply highlight changes
#
proc hilite_apply {hnewpattern} {

   global hpattern hcase_option highlighting hcolor

   set hpattern $hnewpattern
   catch {destroy .hd}
   set highlighting 1
   hilite_text
}
   
#
# Manage toggle of highlighting states
#
proc hilite_toggle {} {

   global highlighting hpattern hcolor

   if {$highlighting} {
      if {$hpattern != ""} {
         hilite_text
      } else {
         hilite_dialog
      }
   } else {
      .log tag remove hilite 1.0 end
   }
}
       
#
# Manage toggle of highlighting case sensitivity 
#
proc hilite_case_toggle {} {

   global hcase_option

   if {$hcase_option == "-nocase"} {
      set hcase_option "--"
   } else {
      set hcase_option "-nocase"
   }
}

#
# Create a dialog that allows the user to set filtering options.
#
proc filter_dialog {} {

   global newpattern 

   toplevel .fd -class Dialog
   wm title .fd "Filter Settings"
   wm iconname .fd "Dialog"

   frame .fd.top -relief raised -bd 1
   frame .fd.opts -relief raised -bd 1
   frame .fd.bot -relief sunken
   pack .fd.top -side top -fill both
   pack .fd.opts -side top -fill both
   pack .fd.bot -side bottom -fill both

   label .fd.top.label -text "Pattern: "
   entry .fd.top.pattern -width 40 -relief sunken -bd 2 -textvariable newpattern
   bind .fd.top.pattern <Return> {filter_apply $newpattern}
   pack .fd.top.label .fd.top.pattern -side left -padx 1m -pady 2m

   checkbutton .fd.opts.case -text "Case Sensitivity" \
               -command {filter_case_toggle}
   pack .fd.opts.case -side left

   button .fd.bot.apply -text "Apply" -command {filter_apply $newpattern}
   button .fd.bot.cancel -text "Cancel" -command {filter_cancel}
   pack .fd.bot.apply .fd.bot.cancel -side left -expand 1 -padx 2 -pady 2
}

#
# Cancel filter dialog
#
proc filter_cancel {} {
   destroy .fd
}

#
# Apply filter changes
#
proc filter_apply {newpattern} {

   global pattern filtering

   set pattern $newpattern
   catch {destroy .fd}
   if {$pattern != ""} {
      set filtering 1
      force_reread
   } else {
      set filtering 0
      force_reread
   }
}
   
#
# Manage toggle of filter states
#
proc filter_toggle {} {

   global filtering pattern bgevent

   if {$filtering} {
      if {$pattern != ""} {
         filter_apply $pattern
      } else {
         filter_dialog
      }
   } else {
      force_reread
   }
}
       
#
# Manage toggle of filter case sensitivity 
#
proc filter_case_toggle {} {

   global case_option

   if {$case_option == "-nocase"} {
      set case_option "--"
   } else {
      set case_option "-nocase"
   }
}

#
# Clear the log pane
#
proc clear {} {

   set filesize 0
   .f1.size configure -text 0
   .log configure -state normal
   .log delete 1.0 end
   .log configure -state disabled
}

#
# Indicate lack of current file
#
proc set_no_file {} {

   global logfile gotfile

   clear
   set logfile "No File"
   set gotfile 0
} 

#
# Create a dialog that allows the user to set the print command.
#
set print_cmd "lp"
proc print_dialog {} {

   global print_cmd new_print_cmd

   toplevel .pd -class Dialog
   wm title .pd "Print Command"
   wm iconname .pd "Dialog"

   frame .pd.top -relief raised -bd 1
   frame .pd.bot -relief sunken
   pack .pd.top -side top -fill both
   pack .pd.bot -side bottom -fill both

   label .pd.top.label -text "Print Command: "
   set new_print_cmd $print_cmd
   entry .pd.top.cmd -width 40 -relief sunken -bd 2 -textvariable new_print_cmd
   bind .pd.top.cmd <Return> {destroy .pd; set print_cmd $new_print_cmd;}
   pack .pd.top.label .pd.top.cmd -side left -padx 1m -pady 2m

   button .pd.bot.print -text "Print" -command {destroy .pd; set print_cmd $new_print_cmd}
   button .pd.bot.cancel -text "Cancel" -command {destroy .pd; set print_cmd $print_cmd}
   pack .pd.bot.print .pd.bot.cancel -side left -expand 1 -padx 2 -pady 2

   tkwait variable print_cmd
   return $print_cmd
}

#
# Print the current selection
#
proc print_sel {} {

   if {!$gotfile} {
      tk_dialog .md "Termite: Error" "No Current File" "" 0 "OK"
   } elseif [catch {set owned [selection own]}] {
      tk_dialog .md "Termite: Error" "No Selected Text" "" 0 "OK"
   } elseif {$owned == ""} {
      tk_dialog .md "Termite: Error" "No Selected Text" "" 0 "OK"
   } elseif {[set sel [selection get]] == ""} {
      tk_dialog .md "Termite: Error" "No Selected Text" "" 0 "OK"
   } else {
      set cmd [print_dialog]
      if {$cmd == ""} {
	 tk_dialog .md "Termite: Error" "No Print Command Specified" "" 0 "OK"
      } else {
	 if {[catch {set lpid [open "|$cmd" r+]}]} {
	    tk_dialog .md "Termite: Error" "Couldn't open pipe to $cmd" "" 0 "OK"
	 } else {
	    puts $lpid $sel
	    catch {close $lpid}
	 }
      }
   }
}

#
# Print the file
#
proc print_file {} {

   if {!$gotfile} {
      tk_dialog .md "Termite: Error" "No Current File" "" 0 "OK"
   } elseif [catch {set owned [selection own]}] {
      tk_dialog .md "Termite: Error" "No Selected Text" "" 0 "OK"
   } elseif {$owned == ""} {
      tk_dialog .md "Termite: Error" "No Selected Text" "" 0 "OK"
   } elseif {[set sel [selection get]] == ""} {
      tk_dialog .md "Termite: Error" "No Selected Text" "" 0 "OK"
   } else {
      set cmd [print_dialog]
      if {$cmd == ""} {
	 tk_dialog .md "Termite: Error" "No Print Command Specified" "" 0 "OK"
      } else {
	 if {[catch {set lpid [open "|$cmd" r+]}]} {
	    tk_dialog .md "Termite: Error" "Couldn't open pipe to $cmd" "" 0 "OK"
	 } else {
	    puts -nonewline $lpid [.log get 1.0 end]
	    catch {close $lpid}
	 }
      }
   }
}

#
# Open new file
#
proc new_file {} {

   global logfile gotfile bgevent

   set filename [tk_getOpenFile]
   if {$filename != ""} {
      catch {after cancel $bgevent}
      clear
      set logfile $filename
      set gotfile 1
      again
   }
}

#
# Save to file
#
proc save_file {} {

   if {!$gotfile} {
      tk_dialog .md "Termite: Error" "No Current File" "" 0 "OK"

   } else {

      set filename [tk_getSaveFile -title "Save as..."]
      if {$filename != ""} {
	 if {[catch {set saveid [open "$filename" w]}]} {
	    tk_dialog .md "Termite: Error" "Couldn't open $filename" "" 0 "OK"
	 } else {
	    puts -nonewline $saveid [.log get 1.0 end]
	    close $saveid
	 }
      }
   }
}
 
#
# Append selection to some file
#
proc save_sel {} {

   global file_append

   if [catch {set owned [selection own]}] {
      tk_dialog .md "Termite: Error" "No Selected Text" "" 0 "OK"
   } elseif {$owned == ""} {
      tk_dialog .md "Termite: Error" "No Selected Text" "" 0 "OK"
   } elseif {[set sel [selection get]] == ""} {
      tk_dialog .md "Termite: Error" "No Selected Text" "" 0 "OK"
   } else {
      set file_append 1
      set filename [tk_getSaveFile -title "Append selection to..."]
      set file_append 0
      if {$filename != ""} {
	 if {[catch {set saveid [open "$filename" a]}]} {
	    tk_dialog .md "Termite: Error" "Couldn't open $filename" "" 0 "OK"
	 } else {
	    puts $saveid \
		 "\n*** Excerpt from $logfile \[[exec /bin/date]\] ***"
	    puts $saveid $sel
	    close $saveid
	 }
      }
   }
}

#
# Update file percentage, scroll text window
#
proc set_percent {first last} {

   .scroll set $first $last
   .f2.percent configure -text "View Location: [expr round($last*100)]%"
}   

#
# Force reset and reread
#
proc force_reread {} {

   global bgevent filesize

   catch {after cancel $bgevent}
   clear
   set filesize 0
   again
}
   
#
# Read log entries into text window
#
proc read_text {fileid} {

   global filtering pattern case_option numbering

   set linenum 0
   set longline 80
   .log configure -state normal
   while {[gets $fileid logentry] >= 0} {
      incr linenum 1
      if {$filtering} {
         if {[regexp $case_option $pattern $logentry]} {
            if {$numbering} {
               set logentry "${linenum}: ${logentry}"
            }
            .log insert end $logentry
            .log insert end "\n"
         }
      } else {
         if {$numbering} {
            set logentry "${linenum}: ${logentry}"
         }
         .log insert end $logentry
         .log insert end "\n"
      }
   }
   .log configure -state disabled
}

#
# Does most of the work... gets run every 3 seconds and checks to
# see if the file has changed, updates display if necessary
#
proc again {} {

   global argv0 filesize autoscroll \
          logfile bgevent highlighting gotfile

   if {!$gotfile} {
      return
   }

   if {[catch {set newsize [file size $logfile]}]} {
      tk_dialog .md "Termite: Error" "Couldn't access $logfile" "" 0 "OK"
      set_no_file
      return
   }

   # The file has grown... read the newest file contents and display them
   if {$newsize > $filesize} {
      set offset [expr $filesize-$newsize]
      if {[catch {set fileid [open "$logfile"]}]} {
	 tk_dialog .md "Termite: Error" "Error opening $logfile" "" 0 "OK"
	 set_no_file
      } else {
	 seek $fileid $offset end
	 read_text $fileid
	 close $fileid
	 set filesize [file size $logfile]
	 if {[catch {set filesize [file size $logfile]}]} {
	    tk_dialog .md "Termite: Error" "Couldn't access $logfile" "" 0 "OK"
	    set_no_file
	    return
	 }
	 .f1.size configure -text $filesize
	 if {$highlighting} {
	    hilite_text
	 }
	 if {$autoscroll} {
	    .log yview moveto 1
	 }
      }
   }

   # The file has been/is being truncated... sleep for a few seconds, then
   # do a reality check (reread the file)
   if {$newsize < $filesize} {
      exec sleep 2
      .log configure -state normal
      if {[catch {set fileid [open "$logfile"]}]} {
	 tk_dialog .md "Termite: Error" "Error opening $logfile" "" 0 "OK"
	 set_no_file
      } else {
	 read_text $fileid
	 close $fileid
	 set filesize [file size $logfile]
	 .f1.size configure -text $filesize
	 if {$highlighting} {
	    hilite_text
	 }
	 .log yview moveto 1
      }
   }
   set bgevent [after 3000 again]
}

proc usage {} {

  puts "Usage: termite \[options\] <filename>"
  puts "       Options:  -fp <regex>     - Filter Pattern"
  puts "                 -csf            - Case-Sensitive Filtering"
  puts "                 -hp <regex>     - Highlighting Pattern"
  puts "                 -hc <color>     - Highlighting Color"
  puts "                 -csh            - Case-Sensitive Highlighting"
  puts "                 -as             - Auto-Scrolling"
  puts "                 -ln             - Line Numbering"
  puts ""
  exit 1
}

#
# Main...
#

# Resource fun...
if {[catch {set resdir $env(XAPPLRESDIR)}]} {
   set resdir "/usr/lib/X11/app-defaults"
}
catch {option readfile "${resdir}/Termite" startupFile}

# Argument fun...

# Setup line numbering option...
if {[set oi [lsearch -exact $argv {-ln}]] != -1} {
   set numbering 1
   set argv [lreplace $argv $oi $oi]; incr argc -1
} elseif \
  {[regexp -nocase {^(true|1)$} [option get . ln Ln]]} {
   set numbering 1
} else {
   set numbering 0
}

# Setup autoscroll option...
if {[set oi [lsearch -exact $argv {-as}]] != -1} {
   set autoscroll 1
   set argv [lreplace $argv $oi $oi]; incr argc -1
} elseif \
  {[regexp -nocase {^(true|1)$} [option get . as As]]} {
   set autoscroll 1
} else {
   set autoscroll 0
}

# Setup initial filtering...
if {[set oi [lsearch -exact $argv {-fp}]] != -1} {
   set pattern [lindex $argv [expr $oi+1]]
   set filtering 1
   set argv [lreplace $argv $oi [expr $oi+1]]; incr argc -2
} else {
   set pattern ""
   set filtering 0
}
set newpattern $pattern

if {[set oi [lsearch -exact $argv {-csf}]] != -1} {
   set case_option "--"
   set argv [lreplace $argv $oi $oi]; incr argc -1
} else {
   set case_option "-nocase"
}

# Setup initial highlighting...
if {[set oi [lsearch -exact $argv {-hp}]] != -1} {
   set hpattern [lindex $argv [expr $oi+1]]
   set highlighting 1
   set argv [lreplace $argv $oi [expr $oi+1]]; incr argc -2
} else {
   set hpattern ""
   set highlighting 0
}
set hnewpattern $hpattern

if {[set oi [lsearch -exact $argv {-hc}]] != -1} {
   set hcolor [lindex $argv [expr $oi+1]]
   set argv [lreplace $argv $oi [expr $oi+1]]; incr argc -2
} elseif {[set hcolor [option get . hc Hc]] == ""} {
   set hcolor "red"
}

if {[set oi [lsearch -exact $argv {-csh}]] != -1} {
   set hcase_option "--"
   set argv [lreplace $argv $oi $oi]; incr argc -1
} else {
   set hcase_option "-nocase"
}

# Set logfile
if {$argc == 1} {
   set logfile [lindex $argv 0]
   set gotfile 1
} elseif {$argc == 0} {
   set logfile "No File"
   set gotfile 0
} elseif {$argc > 1} {
   usage
}

# Titles, etc...
wm title . "Termite"
wm iconname . "Termite"

# Buttons, info, etc...
frame .f -relief raised -bd 2
pack .f -side top -fill both

frame .f1 -relief groove -bd 2
label .f1.size
.f1.size configure -text 0
label .f1.sizelabel -text "File Size: "
pack .f1.sizelabel .f1.size -side left -fill both

frame .f2 -relief groove -bd 2
label .f2.percent
pack .f2.percent -side left -fill both

frame .f3 -relief groove -bd 2
label .f3.name -textvariable logfile
label .f3.namelabel -text "File: "
pack .f3.namelabel .f3.name -side left -fill both

pack .f1 .f2 .f3 -in .f -side right -padx 5 -pady 5

menubutton .f.file -text "File" -menu .f.file.menu
menu .f.file.menu -tearoff 0
.f.file.menu add command -label "Open" -command {new_file}
.f.file.menu add command -label "Save as" -command {save_file}
.f.file.menu add command -label "Save selection" -command {save_sel}
.f.file.menu add command -label "Print" -command {print_file}
.f.file.menu add command -label "Print selection" -command {print_sel}
.f.file.menu add command -label "Quit" -command {exit}

menubutton .f.opts -text "Settings" -menu .f.opts.menu
menu .f.opts.menu
.f.opts.menu add command -label "Filter Settings..." -command {filter_dialog}
.f.opts.menu add command -label "Highlight Settings..." -command {hilite_dialog}
pack .f.file .f.opts -side left -padx 5 -pady 5

# Text pane...
text .log -yscroll "set_percent" -relief ridge -bd 10
pack .log -side left -fill both -expand 1

# Scrollbar...
scrollbar .scroll -command ".log yview" -width 20
pack .scroll -side right -fill y

# Status frame
frame .status -relief raised -bd 2
pack .status -side top -after .f -fill both
checkbutton .status.autoscroll -text "Autoscroll" -variable autoscroll
checkbutton .status.filtering -text "Filtering" -variable filtering \
             -command {filter_toggle}
checkbutton .status.highlighting -text "Highlighting" -variable highlighting \
             -command {hilite_toggle}
checkbutton .status.numbering -text "Line Numbers" -variable numbering \
             -command {force_reread}
pack .status.autoscroll .status.filtering .status.highlighting \
     .status.numbering -side left -padx 2 -pady 2 -expand 1

set filesize 0
if {$gotfile} {
   # Read the file and display...
   force_reread
}