#!/opt/tcl8.0/bin/wish -f # Set to old style colormodel # It works better for this app - white would be okay though tk_bisque # # This is a program that watches log files for certain events and displays them # according to certain simple rules in a priority or a normal window # # Menu-bar # File # Load.. Load a pre-formatted file of syslog info, or info saved # by logger previously (can be slow with large file) # Save.. Save all information in both windows to a file # Watch Logs.. After a load operation, to continue normal watching # Reread Re-read .tkloggerrc in home directory for new rules # Clear Clear out both windows # # Options # File Associations Currently unused # Misc Settings (saved between sessions) # Polling interval in milliseconds (to check log files) # scrollback buffer size for both windows # top window height # bottom window height # Find Options # highlighted in place Choose to hilite found matches in place # shown in separate window A new pop-up window is created # Colors - currently doesn't do much of anything besides showing used colors # It is not recommended to add or delete colors at this time. # # Find Show a popup that lets you search for matches # uses scanmatch to find matches # Find Next available IFF hilite in place is set, and more than one # more than one match is available. dehilites automatically # # NOTE - this program won't work without a configuration file # A sample configuration file can be found at: # ftp.eng.auburn.edu:/pub/doug/.tkloggerrc # # A configuration file other than ~/.tkloggerrc can be defined using the # -f flag to tklogger # # # Configuration - # # command arg1 arg2 # # file filehandle filepath # filehandle used for colors # color filehandle color # color for items from that filehandle # ignore regexpr # regular expression (don't show match) # match regexpr color # anything matching expr gets color # # options list1 list2 ... listn # Don't Touch! saved options! # # NEW in tklogger2-beta and above # match can also contain a Tcl/Tk procedure to execute as the second # argument. The procedure and any arguments must be enclosed in curly # brackets if it has any arguments. Also, any arguments that have spaces # must also be enclosed in nested curly brackets. See the .tkloggerrc # file for example syntax. # Search below here for 'predefined' to find the section where some example # functions are defined. When you define your own functions they should be # in a file called .tklogger-procs in your home directory. These are just # normal functions written in Tcl/Tk. The last argument is always the # message that was matched. Even functions that would normally take no # arguments (like beep below) must accept this last data string even if # they do nothing at all with it. See the examples below for ideas on # how to construct your own functions. # # File handles are just short identifiers that tcl uses to keep the # internal number for the file handle. the filepath should be the full # path to the file you are watching. colors are valid colors defined # in the RGB database. regular expressions are valid regular expressions. # wildcards should not be used unless they are in the middle of an # expression. (case sensitive substrings are the default). Expressions # containing spaces should be enclosed in curly brackets {}. Regular # expressions are case sensitive or not depending on the options that you # pick for normal find under "Find Options" # # Comments can be inserted by putting a '#' character as the first # character of a line (only). # # To subscribe to a mailing list concerning tklogger updates, information, # etc, send mail to majordomo@eng.auburn.edu, with a line in the body # of the message that says: # subscribe tklogger-info # # If you have a Tcl/Tk version less than 7.5/4.0, then you must statically # link TclX with your wish executable. Otherwise it is recommended that you # dynamically load the tclx library as below. # if {$tk_version > 4.0} { if {[catch {package require Tclx}]} { if {[catch {load $tk_library/../libtclx.so TclX}]} { puts "You must have the TclX extension installed." puts "It is available at the Tcl/Tk web archive at neosoft.com" exit } } } # If we have user-defined procedures, load them here if {[file exists $env(HOME)/.tklogger-procs]} { source $env(HOME)/.tklogger-procs } # A list of all log files set LOGN "" # These defaults can be modified from the User Interface and # permanently saved from there. set Polling_Interval 10000 set ScrollBack 500 set ConfigFile $env(HOME)/.tkloggerrc set TmpDir /tmp # ============================================================================ # # # These are predefined action functions and can be used as examples # # ============================================================================ # # # For Tcl versions > 7.5, getclock in TclX is deleted in favor of # Tcl builtin clock procedure # if {$tcl_version > 7.5} { proc getclock {} { return [clock seconds] } } # # This one only beeps, it won't display any data. If you want display, you # should have another match that just does the color display with the same # regex argument # proc beep {data} { puts -nonewline "\007" } # # This one sends email, same display constraints as beep # proc email {users subject msg} { exec echo "$msg" | mail -s "$subject" $users } # # This is just a sample of changing the font and making it italic # in a strange color # proc italicfont {data} { global lines1 incr lines1 .f.t tag configure italicfont -font {*-helvetica-bold-o-normal--14*} \ -foreground blue .f.t insert end "$data\n" italicfont .f.t yview -pickplace end } # # Here's one that plays a user-defined sound file and then # displays the 'data' in 'color' # proc playsound {soundfile color data} { # This line will have to be modified to reflect the conventions # for playing sounds on your system. exec showaudio $soundfile & if {[string match "*red*" $color]} { .f.t2 tag configure $color -foreground $color } else { .f.t tag configure $color -foreground $color } display "$data" $color } # # Here's one that pops up a dialog box with the message in it # Pcount has a unique number so that can be more than one at a time # proc popup {data} { global Pcount incr Pcount mkDialog .info$Pcount "-width 10c -text \"$data\"" {{OK}} } # ============================================================================ # # User contributed or extended functions # ============================================================================ # # - tk demo app included with tk4.0 and earlier, but omitted from # tk4.1 and later. Included here for consistency # # mkDialog w msgArgs list list ... # # Create a dialog box with a message and any number of buttons at # the bottom. # # Arguments: # w - Name to use for new top-level window. # msgArgs - List of arguments to use when creating the message of the # dialog box (e.g. text, justifcation, etc.) # list - A two-element list that describes one of the buttons that # will appear at the bottom of the dialog. The first element # gives the text to be displayed in the button and the second # gives the command to be invoked when the button is invoked. # # @(#) mkDialog.tcl 1.1 94/08/10 15:35:00 proc mkDialog {w msgArgs args} { catch {destroy $w} toplevel $w -class Dialog wm title $w "Dialog box" wm iconname $w "Dialog" # Create two frames in the main window. The top frame will hold the # message and the bottom one will hold the buttons. Arrange them # one above the other, with any extra vertical space split between # them. frame $w.top -relief raised -border 1 frame $w.bot -relief raised -border 1 pack $w.top $w.bot -side top -fill both -expand yes # Create the message widget and arrange for it to be centered in the # top frame. eval message $w.top.msg -justify center \ -font -Adobe-times-medium-r-normal--*-180-*-*-*-*-*-* $msgArgs pack $w.top.msg -side top -expand yes -padx 3 -pady 3 # Create as many buttons as needed and arrange them from left to right # in the bottom frame. Embed the left button in an additional sunken # frame to indicate that it is the default button, and arrange for that # button to be invoked as the default action for clicks and returns in # the dialog. if {[llength $args] > 0} { set arg [lindex $args 0] frame $w.bot.0 -relief sunken -border 1 pack $w.bot.0 -side left -expand yes -padx 10 -pady 10 button $w.bot.0.button -text [lindex $arg 0] \ -command "[lindex $arg 1]; destroy $w" pack $w.bot.0.button -expand yes -padx 6 -pady 6 bind $w "[lindex $arg 1]; destroy $w" focus $w set i 1 foreach arg [lrange $args 1 end] { button $w.bot.$i -text [lindex $arg 0] \ -command "[lindex $arg 1]; destroy $w" pack $w.bot.$i -side left -expand yes -padx 10 set i [expr $i+1] } } bind $w [list focus $w] focus $w } # # Spinner contributed by Peter da Silva # displays 'buzzing' Poll while polling # proc spinner {} { global clock spincolors .top.spinner configure -foreground orange incr clock if {$clock > 8} {set clock 0} update idletasks .top.spinner configure -foreground [lindex $spincolors $clock] } # ============================================================================ # # Callbacks for buttons and functions # ============================================================================ # # # Callback to save options to .tkloggerrc # proc save_opts {} { global OPTIONS ConfigFile TmpDir set f [open $TmpDir/.tknew w] set optionsfnd 0 set fh [open $ConfigFile r] while {[gets $fh data] > 0} { if {[lindex $data 0] == "options"} { set optionsfnd 1 puts -nonewline $f "options " foreach key [array names OPTIONS] { puts -nonewline $f "{$key $OPTIONS($key)} " } puts $f {} } else { puts $f $data } } if {!$optionsfnd} { puts -nonewline $f "options " foreach key [array names OPTIONS] { puts -nonewline $f "{$key $OPTIONS($key)} " } puts $f {} } close $f eval exec mv $TmpDir/.tknew $ConfigFile } # # Clear out both log windows # proc clearwins {} { global lines2 lines1 .f.t delete 0.0 [expr $lines1 +1].0 ; set lines1 0] .f2.t delete 0.0 [expr $lines2 +1].0 ; set lines2 0] set lines2 0 set lines1 0 } # # Read and parse config file updating matchreg and ignorereg # proc read_config_file {} { global filearray matchreg OPTIONS LOGN ignorereg handlearray ConfigFile # filearray is files and values # matchreg is list of colors for regular expressions # matchlist is keyed list containing matchreg and matches # ignorereg is list of field positions for ignorelist # Close old files foreach file $LOGN { upvar #0 $file f_num close $f_num } set LOGN "" set ignorereg {} catch {foreach reg [array names matchreg] { unset matchreg($reg) }} set fh [open $ConfigFile r] while {[gets $fh data] > 0} { # If comment, skip it. if {[string range $data 0 0] == "#"} { continue } set rule [lindex $data 0] if {$rule == "options"} { foreach litem [lrange $data 1 end] { set cmd [lrange $litem 1 end] # Tcl8 takes care of escaping the $ stuff automatically if {$tcl_version < 8.0} { eval uplevel #0 \{$cmd\} } else { eval uplevel #0 $cmd } set OPTIONS([lindex $litem 0]) $cmd } continue } set arg1 [lindex $data 1] set arg2 [lindex $data 2] if {$rule == "file"} { lappend LOGN $arg1 eval uplevel #0 set handle_array($arg1) $arg2 if {[catch {set targ [open $arg2 r]}]} { exec touch $arg2 set targ [open $arg2 r] } eval uplevel #0 set $arg1 $targ } elseif {$rule == "color"} { set filearray($arg1) $arg2 addcolor $arg2 } elseif {$rule == "match"} { # add the color, make color name global variable to hold regexp # if it's not an action set t [lindex $arg2 0] if {[info proc $t] != $t} { addcolor $arg2 } # Can be more than one regular expression per color if {[catch {set x $matchreg($arg2)}]} { set matchreg($arg2) "$arg1" } else { append matchreg($arg2) "|$arg1" } } elseif {$rule == "ignore"} { if {[llength $ignorereg] > 0} { append ignorereg "|$arg1" } else { append ignorereg "$arg1" } } } uplevel #0 { foreach log $LOGN { upvar #0 $log lval set mname ${log}_om seek $lval 0 end set $mname [file mtime $handle_array($log)] upvar #0 $mname oldmtime } } } # # Currently unused, future for setting up GUI for file associations # proc file_assoc {} { toplevel .fa wm title .fa "File Associations" frame .fa.handle frame .fa.path frame .fa.color } # # Save all the text in both windows into a file, possibly for further # processing. Saves as a 2 element list, with color being the first # element, and the message as the second element # proc save_text {} { global lines2 lines1 toplevel .fe wm title .fe "File Entry" label .fe.l -text "File name: (Press to accept)" entry .fe.e -relief sunken -width 40 -textvariable filename button .fe.c -text "Cancel" -width 8 -command {destroy .fe} pack .fe.l .fe.e .fe.c -side top -anchor w -pady 10 -padx 10 uplevel #0 set holder 1 bind .fe {focus .fe.e} bind .fe.e { if {[catch {set o [open $filename w]}]} { tk_dialog .badfile "Bad File Name" "File/Directory not writable." \ error {} {OK} } else { for {set i 1} {$i <= $lines1} {incr i} { puts $o "{[.f.t tag names $i.1]} {[.f.t get $i.0 $i.end]}" } for {set i 1} {$i <= $lines2} {incr i} { puts $o "{[.f2.t tag names $i.1]} {[.f2.t get $i.0 $i.end]}" } close $o destroy .fe } } uplevel #0 set holder 0 } # # Set scrollback window value proc commit_misc {} { global Tmp ScrollBack Polling_Interval if {$Tmp < 55} { tk_dialog .badscroll "Error" \ "ScrollBack less than 55. Reset to default." \ error {} {OK} set Tmp 500 return } else { set ScrollBack $Tmp } if {$Polling_Interval < 5000} { tk_dialog .badpoll "Error" "Polling Interval < 5 seconds. Reset to 5." \ error {} {OK} set Polling_Interval 5000 return } uplevel #0 set holder 0 destroy .pi } # # Callback for setting polling interval # proc setpoll {} { uplevel #0 set holder 1 toplevel .pi wm title .pi "Misc Settings.." message .pi.message -text "Press Return in each window after you modify a value. Press OK when done" -width 200 pack .pi.message -side top -expand true -fill both -ipady 10 -ipadx 15 frame .pi.f1 -relief raised -bd 2 pack .pi.f1 -expand yes -fill both -side top -ipady 5 label .pi.f1.l -text "New polling interval (msecs.): " entry .pi.f1.e -relief sunken -width 5 -textvariable Polling_Interval pack .pi.f1.l -side left -padx 5 pack .pi.f1.e -side right -padx 5 frame .pi.f2 -relief raised -bd 2 pack .pi.f2 -expand yes -fill both -side top -ipady 5 label .pi.f2.l -text "New scrollback buffer size: " entry .pi.f2.e -relief sunken -width 5 -textvariable Tmp pack .pi.f2.l -side left -padx 5 pack .pi.f2.e -side right -padx 5 frame .pi.f3 -relief raised -bd 2 pack .pi.f3 -expand yes -fill both -side top -ipady 5 label .pi.f3.l -text "Top window height: " entry .pi.f3.e -relief sunken -width 5 -textvariable topwheight pack .pi.f3.l -side left -padx 5 pack .pi.f3.e -side right -padx 5 uplevel #0 {set topwheight [lindex [.f.t configure -height] 4]} frame .pi.f4 -relief raised -bd 2 pack .pi.f4 -expand yes -fill both -side top -ipady 5 label .pi.f4.l -text "Priority window height: " entry .pi.f4.e -relief sunken -width 5 -textvariable priwheight pack .pi.f4.l -side left -padx 5 pack .pi.f4.e -side right -padx 5 uplevel #0 {set priwheight [lindex [.f2.t configure -height] 4]} button .pi.b -width 5 -text OK -command commit_misc pack .pi.b -side bottom -pady 8 uplevel #0 {set Tmp $ScrollBack} bind .pi.f1.e {focus .pi.f1.e} bind .pi.f1.e { set OPTIONS(Polling_Interval) \ "{set Polling_Interval $Polling_Interval}" set ofg [lindex [.pi.f1.e configure -bg] 4] .pi.f1.e configure -bg yellow update idletasks after 300 .pi.f1.e configure -bg $ofg } bind .pi.f2.e {focus .pi.f2.e} bind .pi.f2.e { set OPTIONS(ScrollBack) "set ScrollBack $Tmp" set ofg [lindex [.pi.f2.e configure -bg] 4] .pi.f2.e configure -bg yellow update idletasks after 300 .pi.f2.e configure -bg $ofg } bind .pi.f3.e {focus .pi.f3.e} bind .pi.f3.e { set OPTIONS(mainwheight) ".f.t configure -height $topwheight" .f.t configure -height $topwheight set ofg [lindex [.pi.f3.e configure -bg] 4] .pi.f3.e configure -bg yellow update idletasks after 300 .pi.f3.e configure -bg $ofg } bind .pi.f4.e {focus .pi.f4.e} bind .pi.f4.e { set OPTIONS(prioritywheight) ".f2.t configure -height $priwheight" .f2.t configure -height $priwheight set ofg [lindex [.pi.f4.e configure -bg] 4] .pi.f4.e configure -bg yellow update idletasks after 300 .pi.f4.e configure -bg $ofg } } # # Loading pre-formatted text from save file or un-formatted text from raw file # proc load_text_cb {} { global filename lines1 lines2 matchreg ignorereg casesensitive if {[catch {set o [open $filename]}]} { tk_dialog .badfile "Bad File Name" "File/Directory not readable." \ error {} {OK} exit } else { close $o pack forget .f.t .f2.t # clear out all old lines .f.t delete 0.0 [expr $lines1 +1].0 .f2.t delete 0.0 [expr $lines2 +1].0 set lines1 0 set lines2 0 mkDialog .loading \ "-text \"Loading text file. This could take a little while.\"" \ {{OK}} #initialize matching #loop through file set fh [open $filename r] while {[gets $fh data] > 0} { set displayed 0 set c black # ignore line? if {[llength $ignorereg] > 0 && [regexp $casesensitive $ignorereg $data]} { continue } # Tagged file regsub -all {\"} $data {} data if {[llength $data] == 2} { set c [lindex $data 0] set data [lindex $data 1] } foreach color [array names matchreg] { if {[regexp $casesensitive $matchreg($color) $data]} { display $data $color incr displayed } } if {$displayed} { continue } else { display $data $c } } catch {destroy .fe} catch {destroy .loading} } pack .f.t .f2.t -fill both -expand true } # # Load a text file, processing it according to current rules, or # colors/text if already present # proc load_text {} { global Polling_Interval uplevel #0 set holder 1 set ddd 0 toplevel .flush label .flush.bm -bitmap info -bg lightblue message .flush.msg -text "Flushing buffers..." -width 150 \ -font {-*-times-bold-r-normal-*-180-*-*-*-*-*-*} pack .flush.bm .flush.msg -ipadx 20 -ipady 30 -side left tkwait visibility .flush update idletasks update catch {destroy .flush} toplevel .fe wm title .fe "File Entry" label .fe.l -text "File name: (press to accept)" entry .fe.e -relief sunken -width 40 -textvariable filename message .fe.m -text "Note: window my momentarily shrink" -width 12c button .fe.c -text "Cancel" -width 8 -command {destroy .fe} pack .fe.l .fe.e .fe.m .fe.c -side top -anchor w -pady 10 -padx 10 bind .fe {focus .fe.e} bind .fe.e load_text_cb } # Will delete a color, but this is of dubious value at the moment proc killcolor {} { if {[catch [set cdel [.co.list.l curselection]]]} { foreach el [selection get] { .f.t tag delete $el .f2.t tag delete $el } set ndel [llength $cdel] set first [lindex $cdel 0] for {set i 0} {$i < $ndel} {incr i} { .co.list.l delete $first } .co.e delete 0 end } } # Adds a color, also of dubious value proc addcolor {color} { global ddd if {$color != ""} { set ddd 0 if {[catch ".f.t tag configure $color -foreground $color"]} { mkDialog .badc "-text \"Unknown color - $color\"" {{OK} {set ddd 1}} tkwait variable ddd } else { .f2.t tag configure $color -foreground $color } return } elseif {[catch [set c [.co.e get]]]} { if {[catch {.f.t tag configure $c -foreground $c}]} { mkDialog .badc "-text \"Unknown color - $c\"" {{OK} {focus .co.e}} return } else { .f2.t tag configure $c -foreground $c } .co.list.l insert 0 $c .co.list.l yview 0 .co.e delete 0 end } } # # Sort the colors # proc sortcolors {} { set items [lsort [lrange [.f.t tag names] 1 end]] .co.list.l delete 0 end foreach i $items { .co.list.l insert end $i } } # # Pop up a browser that allows viewing, adding and deleting of current colors # proc cbrowser {} { toplevel .co wm title .co "Color Browser" frame .co.list listbox .co.list.l -width 30 -height 15 -setgrid yes -relief sunken \ -yscroll ".co.list.s set" scrollbar .co.list.s -command ".co.list.l yview" pack .co.list.s -side left -fill y pack .co.list.l -side right -expand true -fill both entry .co.e -width 30 -textvariable cname -relief sunken bind .co.e {addcolor {} } pack .co.list .co.e -side top -pady 10 frame .co.f pack .co.f -side top -expand true -fill both frame .co.f.l -relief raised -bd 2 pack .co.f.l -side left -expand true -fill both button .co.f.l.add -text "Add" -width 9 -command {addcolor {}} button .co.f.l.remove -text "Remove" -width 9 -command killcolor button .co.f.l.sort -text "Sort" -width 9 -command sortcolors button .co.f.ok -text "OK" -width 9 -command {destroy .co; return} pack .co.f.l.add .co.f.l.remove .co.f.l.sort -side top -padx 8 -pady 3 pack .co.f.ok -side right -padx 5 -pady 5 -anchor c -expand true text .co.bot -wrap word -width 30 -height 5 .co.bot insert end "Note: Deleted colors are not checked for validity. You must make sure they are not in use. This window doesn't currently do much of anything." pack .co.bot -side top -pady 5 foreach color [lsort [lrange [.f.t tag names] 1 end]] { .co.list.l insert end $color } bind .co.list.l { set L_index [.co.list.l nearest %y] set cname [.co.list.l get $L_index] } } # ============================================================================ # # Main loop functions # ============================================================================ # # # Put the messages up in the windows # proc display {data color} { global lines1 lines2 ScrollBack # Command, high priority, or regular priority set pname [lindex $color 0] if {[info proc $pname] == $pname} { eval $color \{$data\} } elseif {[string match "*red*" $color]} { incr lines2 raise . if {![winfo ismapped .]} { wm deiconify . } .f2.t insert end "$data\n" $color .f2.t yview -pickplace $lines2 if {$lines2 > $ScrollBack} { incr lines2 -50 .f2.t delete 1.0 51.0 } } else { incr lines1 .f.t insert end "$data\n" $color .f.t yview -pickplace $lines1 if {$lines1 > $ScrollBack} { incr lines1 -50 .f.t delete 1.0 51.0 } } update idletasks } # # The main body that checks the logs # proc pollit {} { global LOGN filearray matchreg holder Polling_Interval ignorereg global casesensitive handle_array if {$holder} { tkwait variable holder } foreach log $LOGN { spinner upvar #0 $log lval set mname ${log}_om upvar #0 $mname oldmtime # Get last modification time set newmtime [file mtime $handle_array($log)] if {$newmtime > $oldmtime} { while {[gets $lval data] != -1} { spinner set displayed 0 if {[llength $ignorereg] > 0 && [regexp $casesensitive $ignorereg $data]} { continue } foreach color [array names matchreg] { regsub -all {["{}]} $data {} data if {[regexp $casesensitive $matchreg($color) $data]} { display $data $color incr displayed } } if {$displayed} { continue } if {! [catch {set c $filearray($log)} err]} { display $data $c } else { # puts "not file" } } global $mname set $mname $newmtime } } .top.spinner configure -foreground bisque after $Polling_Interval pollit } # # Toggle case sensitive option # proc togglecase {} { global OPTIONS casesensitive caseval if {$casesensitive == ""} { set OPTIONS(casesensitive) {set casesensitive "-nocase"} set OPTIONS(caseval) {set caseval 0} set casesensitive "-nocase" set caseval 0 } else { set OPTIONS(casesensitive) {set casesensitive ""} set OPTIONS(caseval) {set caseval 1} set casesensitive "" set caseval 1 } } # ============================================================================ # # Find stuff # ============================================================================ # # # Find options # proc findopts {} { global findopt OPTIONS matchtype caseval matchval toplevel .fo wm title .fo "Find Options" label .fo.l -text "Found output should be:" -width 40 pack .fo.l -side top -anchor c -ipady 10 -ipadx 10 frame .fo.f1 -relief groove -bd 3 pack .fo.f1 -expand true -fill both -side top # Button 1 and color radiobutton .fo.f1.r1 -text "Highlighted in place." \ -variable findopt -value 1 -relief flat \ -command { .fo.f1.f2.color configure -fg black -state normal .fo.f1.f2.label configure -fg black .fo.f1.f1.color configure -fg black -state normal .fo.f1.f1.label configure -fg black bind .fo.f1.f2.color { set OPTIONS(fghilitecolor) $fghilitecolor } bind .fo.f1.f1.color { set OPTIONS(bghilitecolor) $bghilitecolor } set OPTIONS(findopt) "set findopt 1"} frame .fo.f1.f1 label .fo.f1.f1.label -text "Background Color:" -relief flat entry .fo.f1.f1.color -textvariable bghilitecolor -width 15 -relief sunken frame .fo.f1.f2 label .fo.f1.f2.label -text "Foreground Color:" -relief flat entry .fo.f1.f2.color -textvariable fghilitecolor -width 15 -relief sunken pack .fo.f1.r1 .fo.f1.f1 .fo.f1.f2 -side top -pady 5 -padx 10 -anchor w pack .fo.f1.f1.label .fo.f1.f1.color -side left -padx 5 pack .fo.f1.f2.label .fo.f1.f2.color -side left -padx 6 # Button 2 - separate window frame .fo.f2 -relief groove -bd 3 pack .fo.f2 -expand true -fill both -side top radiobutton .fo.f2.r2 -text "Shown in separate window." \ -variable findopt -value 0 -relief flat \ -command { .fo.f1.f2.color configure -fg gray60 -state disabled .fo.f1.f2.label configure -fg gray60 .fo.f1.f1.color configure -fg gray60 -state disabled .fo.f1.f1.label configure -fg gray60 set OPTIONS(findopt) "set findopt 0"} pack .fo.f2.r2 -side top -pady 10 -anchor w -padx 10 # Other find options frame .fo.f3 -relief ridge -bd 3 pack .fo.f3 -expand true -fill both -side top -pady 4 radiobutton .fo.f3.r1 -text "Exact match" -variable matchval -value 0 \ -relief flat \ -command { set OPTIONS(matchtype) "set matchtype -exact" set OPTIONS(matchval) "set matchval 0" set matchtype "-exact" } radiobutton .fo.f3.r2 -text "Regular Expression" -variable matchval \ -value 1 -relief flat \ -command { set OPTIONS(matchtype) "set matchtype -regexp" set OPTIONS(matchval) "set matchval 1" set matchtype "-regexp" } checkbutton .fo.f3.c1 -text "Case Sensitive" -relief flat \ -variable caseval -command togglecase pack .fo.f3.r1 .fo.f3.r2 .fo.f3.c1 -side left -padx 10 -pady 10 # Bottom OK button button .fo.ok -text OK -width 10 -command {destroy .fo} pack .fo.ok -side bottom -anchor c -pady 10 uplevel #0 set hilitecolor lightblue if {$findopt == 0} { .fo.f1.f2.color configure -fg gray60 -state disabled .fo.f1.f2.label configure -fg gray60 .fo.f1.f1.color configure -fg gray60 -state disabled .fo.f1.f1.label configure -fg gray60 } bind .fo.f1.f2.color {set OPTIONS(fghilitecolor) $fghilitecolor } bind .fo.f1.f2.color { } bind .fo.f1.f2.color { } bind .fo.f1.f2.color {focus .fo.f1.f2.color} bind .fo.f1.f1.color {set OPTIONS(bghilitecolor) $bghilitecolor } bind .fo.f1.f1.color { } bind .fo.f1.f1.color { } bind .fo.f1.f1.color {focus .fo.f1.f1.color} } # # Cancel the currently running in-line find process # proc done_find {} { global FIND LNAMES SAVETAG matchcnt pack forget .top.cancel $SAVETAG(window) tag remove hilite $SAVETAG(line) \ "$SAVETAG(line) + $matchcnt chars" .top.search configure -state normal .top.next configure -state disabled foreach h [array names FIND] { unset FIND($h) } } # # Hilite selected found items in place # proc found_next {} { global SAVETAG FIND LNAMES findexp matchcnt # If SAVETAG is set, delete old hilite from that position if {[llength [array names FIND]] <= 1} { .top.next configure -state disabled # Set a timeout to unhilite last item after 5000 {eval $SAVETAG(window) tag remove hilite $SAVETAG(line) \ \"$SAVETAG(line) + $matchcnt chars\"} .top.search configure -state normal pack forget .top.cancel } else { .top.next configure -state normal .top.search configure -state disabled pack .top.cancel -side left -padx 8 } # Get line number for remaining in list set key [lindex $LNAMES 0] set window [lindex [split $key {_}] 0] set line [lindex [split $key {_}] 1] $window see $line if {![catch {set x $SAVETAG(window)}]} { set oldwindow $SAVETAG(window) set oldline $SAVETAG(line) $oldwindow tag remove hilite $oldline "$oldline + $matchcnt chars" } set SAVETAG(window) $window set SAVETAG(line) $line $window tag add hilite $line "$line + $matchcnt chars" $window tag raise hilite unset FIND($key) set LNAMES [lreplace $LNAMES 0 0] } # # Sort out a FIND array list of keys # proc qsort {arg1 arg2} { set a1 [split $arg1 {_}] set a2 [split $arg2 {_}] set x [string compare [lindex $a1 0] [lindex $a2 0]] if {$x == 0} { set b1 [lindex $a1 1] set b2 [lindex $a2 1] if {$b1 < $b2} { return -1 } elseif {$b1 == $b2} { return 0 } else { return 1 } } else { return $x } } # # The guts of Find.. # # LNAMES is just the names of the array items found - easy sorting # proc find_proc {} { global findopt FIND LNAMES findexp casesensitive matchtype matchcnt if {[catch {set findexp [.finder.top.e get]}]} { return } if {[string length $findexp] == 0} { return } set srchindx 1.0 regsub -all {\[} $findexp {\\[} findexp regsub -all {\]} $findexp {\\]} findexp while {[set i [eval .f.t search -count matchcnt -forwards $casesensitive $matchtype $findexp $srchindx end]] != ""} { set line [lindex [split $i {.}] 0] set FIND(.f.t_$i) [list [.f.t get $line.0 $line.end] [.f.t tag names $i] $line] set srchindx [expr $i + 1] } set srchindx 1.0 while {[set i [eval .f2.t search -count matchcnt -forwards $casesensitive $matchtype $findexp $srchindx end]] != ""} { set line [lindex [split $i {.}] 0] set FIND(.f2.t_$i) [list [.f2.t get $line.0 $line.end] [.f2.t tag names $i] $line] set srchindx [expr $i + 1] } # Check for any match if {![llength [array names FIND]]} { return } if {$findopt} { set LNAMES [lsort -command qsort [array names FIND]] .f.t see 1.0 catch {destroy .finder} found_next } else { set wname .findout[getclock] toplevel $wname wm minsize $wname 500 150 wm maxsize $wname 1000 600 wm title $wname "Find Output" frame $wname.f1 -relief sunken -bd 3 pack $wname.f1 -expand true -fill both text $wname.f1.text -wrap word -height 15 -width 95 \ -yscrollcommand "$wname.f1.scroll set" scrollbar $wname.f1.scroll -command "$wname.f1.text yview" pack $wname.f1.scroll -fill y -side left -expand false pack $wname.f1.text -side left -expand true -fill both button $wname.dismiss -text "Dismiss.." -width 10 \ -command "destroy $wname" pack $wname.dismiss -side bottom -pady 15 -anchor c set nentries [llength [array names FIND]] if {$nentries < 15} { $wname.f1.text configure -height [expr $nentries + 1] } foreach key [lsort [array names FIND]] { set tagname [lindex $FIND($key) 1] $wname.f1.text tag configure $tagname -foreground $tagname $wname.f1.text insert end "[lindex $FIND($key) 0]\n" $tagname unset FIND($key) } } } # # Draw the find window # proc find_draw {} { toplevel .finder frame .finder.top -relief groove -bd 3 label .finder.top.l -text "Enter Regular Expression below" -width 40 entry .finder.top.e -width 30 -relief sunken -textvariable findexp pack .finder.top.l .finder.top.e -side top -pady 6 pack .finder.top -expand true -fill both frame .finder.f button .finder.f.find -text Find -width 6 -command find_proc button .finder.f.cancel -text Dismiss -width 8 -command {destroy .finder} pack .finder.f.find .finder.f.cancel -side left -fill both -expand true \ -padx 20 -pady 10 pack .finder.f -expand true -fill both bind .finder.top.e find_proc bind .finder.top.e { } bind .finder.top.e { } bind .finder {focus .finder.top.e} } # ============================================================================ # # ============================================================================ # # ============================================================================ # # ============================================================================ # # Main procedure # ============================================================================ # # ============================================================================ # # ============================================================================ # # ============================================================================ # # # Draw main, set defaults, and open log files # # Pcount - just a globally unique number # lines2 - current # lines in hot-window # lines1 - current # lines in regular window # holder - pause/continue # clock - used from spinner # findopt - find options # matchcnt - number of matches # matchtype - regular expression or exact match # topwheight - height in lines of regular window set Pcount 0 set lines2 0 set lines1 0 set holder 0 set findopt 0 set matchcnt 0 set clock 0 set spincolors {gray10 gray20 gray30 gray40 gray50 gray60 gray70 gray80 gray90} set bghilitecolor blue set fghilitecolor yellow set casesensitive "-nocase" set matchtype "" frame .top -relief raised -bd 2 pack .top -fill both -expand true menubutton .top.file -text "File" -menu .top.file.m -underline 0 menu .top.file.m .top.file.m add command -label "Load.." -underline 0 -command load_text .top.file.m add command -label "Save.." -underline 0 -command save_text .top.file.m add command -label "Watch Logs.." -underline 0 \ -command {set holder 0} .top.file.m add separator .top.file.m add command -label "Reread Config File" -command read_config_file .top.file.m add command -label "Clear Windows" -command clearwins .top.file.m add separator .top.file.m add command -label "Quit" -underline 0 -command exit menubutton .top.options -text "Options" -menu .top.options.m -underline 0 menu .top.options.m .top.options.m add command -label "Misc Settings" -command setpoll .top.options.m add command -label "Find Options" -command findopts .top.options.m add command -label "Colors" -command cbrowser .top.options.m add separator .top.options.m add command -label "Save Options" -command save_opts pack .top.file .top.options -side left tk_menuBar .top .top.file .top.options label .top.spacer -width 10 pack .top.spacer -side left button .top.search -text "Find.." -width 9 -command find_draw button .top.next -text "Find Next.." -width 9 -command found_next # The below buttons is invisible most of the time button .top.cancel -text "Done Find" -width 9 -command done_find pack .top.search .top.next -side left -padx 8 .top.next configure -state disabled # Spinner contributed by Peter da Silva peter@nmti.com label .top.spinner -text {POLL} pack .top.spinner -side right focus .top frame .f pack .f -side top -fill both -expand true text .f.t -wrap word -width 80 -height 10 \ -yscrollcommand ".f.s set" -setgrid on pack .f.t -side right -expand yes -fill both scrollbar .f.s -command ".f.t yview" label .middlebar -text "Priority Messages" -relief raised pack .middlebar -side top -fill both -ipady 4 -expand true pack .f.s -side left -fill y frame .f2 -relief raised -bd 2 pack .f2 -side top -fill both -expand true text .f2.t -wrap word -width 80 -height 5 \ -yscrollcommand ".f2.s set" -setgrid on pack .f2.t -side right -expand yes -fill both scrollbar .f2.s -command ".f2.t yview" pack .f2.s -side left -fill y frame .bottom -relief ridge -bd 2 pack .bottom -expand true -side bottom -fill both radiobutton .bottom.b1 -variable holder -text "Pause" -value 1 -relief flat radiobutton .bottom.b2 -variable holder -text "Continue" -value 0 -relief flat pack .bottom.b1 .bottom.b2 -side left -padx 5 -pady 5 -anchor c \ -expand yes -fill x # Keep us from being careless bind .f.t {} bind .f2.t {} bind .f.t {focus .f} bind .f2.t {focus .f} bind .f.t {focus .f} bind .f2.t {focus .f} update idletasks wm minsize . 80 1 # Setup hilite tag .f.t tag configure hilite -foreground $fghilitecolor -background $bghilitecolor .f2.t tag configure hilite -foreground $fghilitecolor -background $bghilitecolor set argc [llength $argv] if {[string match [lindex $argv 0] "-f"]} { set ConfigFile [lindex $argv 1] set argv [lrange $argv 2 end] incr argc -2 } # # Open log files and .tkloggerrc startup file ; go to end of logfile # read_config_file if {$argc > 0} { puts $argv set filename [lindex $argv 0] set holder 1 load_text_cb # Uncomment the below line if you want the window to not show up until # the datafile is loaded # wm iconify . } pollit