Index: tkchat.tcl
===================================================================
RCS file: /cvsroot/tcllib/tclapps/apps/tkchat/tkchat.tcl,v
retrieving revision 1.72
diff -r1.72 tkchat.tcl
1093a1094
> 	::tkchat::find::on_content_change
1282a1284
> 	::tkchat::find::on_content_change
1290a1293
> 	::tkchat::find::on_content_change
1311a1315
> 	::tkchat::find::on_content_change
1394a1399
> 	::tkchat::find::on_content_change
1441a1447,1448
> 	$m add command -label "Find" -underline 0 \
> 		-command "::tkchat::find::dialog .txt {}"
1822a1830,1833
> 				"^/find" {
> 					regexp -- {/find\s+(.*)} $msg 1 tkchat::find::find(string)
> 					tkchat::find::dialog .txt
> 				}
2773a2785,3057
> }
> 
> ## Code to find and highlight patterns in the chat log window
> namespace eval ::tkchat::find {
> 	variable find
> 	set find(id) ""
> 	set find(break) 0
> 	set find(case) 0
> 	set find(regexp) 0
> 	set find(string) ""
> 	set find(startIndex) ""
> 	set find(last) ""
> }
> 
> # ARGS: tag  -  tag to use when highlighting matches
> #       t    -  text widget
> #       yoff -  ?
> proc ::tkchat::find::next {tag t {wmsg ""} {yoff ""}} {
> 	
> 	# if {[$t tag ranges $tag]==""} { winstderr $wmsg "No matches!"; return }
> 	
> 	if {$yoff==""} {
> 		# get y positon of last line of text
> 		set yoff [winfo height $t]
> 		# Should start at the beginning of that line
> 		set start [$t index @0,$yoff]
> 		# Unless there is a match in the visible area...
> 		if {[set prev [$t tag prevrange search @0,$yoff @0,0]]!=""} {
> 			# start searching just after the end of the last visible match
> 			set start [$t index [lsecond $prev]+1c]
> 		}
> 	} else {
> 		# If position specified, begin at specified position
> 		set start [$t index @0,$yoff] 
> 	}
> 	# Get index of next hit
> 	set idx [$t tag nextrange $tag $start]
> 	# If no matches follow...
> 	if {$idx==""} {
> 		# Try again from beginning of text
> 		set idx [$t tag nextrange $tag 1.0]
> 	}
> 	if {$idx!=""} {
> 		$t mark set idx [lindex $idx 0]
> 		$t see idx
> 	}
> 
> }
> 
> # Move backwards through text, jumping between highlighted matches
> # ARGS: tag  -  tag to use when highlighting matches
> #       t    -  text widget
> #       yoff -  ?
> proc ::tkchat::find::prev {tag t {wmsg ""}} {
> 	
> 	# if {[$t tag ranges $tag]==""} { winstderr $wmsg "No matches!"; return }
> 	
> 	# Get the start index of any matches beginning just previous of the first visible character
> 	set idx [$t tag prevrange $tag [$t index @0,0]]
> 	# If there are no previous matches...
> 	if {$idx==""} {
> 		# Try again from end of text (wrap around)
> 		set idx [$t tag prevrange $tag end]
> 	}
> 	
> 	if {$idx!=""} {
> 		$t mark set idx [lindex $idx 0]
> 		$t see idx
> 	}
> }
> 
> 
> ## ::tkchat::find::dialog - dialog interface to ::tkchat::find::find
> # ARGS:	w	- text widget
> #	str	- optional seed string for the search string
> ##
> proc ::tkchat::find::dialog {w {str {}}} {
> 	
> 	variable find
> 
> 	# The pathname of the dialog toplevel
> 	set base .find
> 	
> 	# Create the dialog only if this procedure has not been called before
> 	# and the dialog does not yet exist.
>     if {![winfo exists $base]} {
> 		toplevel $base
> 		wm withdraw $base
> 		wm transient $base .
> 		wm protocol $base WM_DELETE_WINDOW "wm withdraw $base"
> 		wm title $base "tkchat Find"
> 		
> 		pack [frame $base.f] -fill y -expand 1 -pady 5 -padx 5
> 		label $base.f.l -text "Find text:"
> 		entry $base.f.e \
> 			-textvariable ::tkchat::find::find(string) \
> 			-validate key \
> 			-vcmd { tkchat::find::on_GUI_change .txt } \
> 			-highlightthickness 0
> 		pack $base.f.l -side left
> 		
> 		pack [frame $base.opt] -fill y -expand 1 -padx 5
> 		checkbutton $base.opt.c -text "Case sensitive" \
> 			-variable ::tkchat::find::find(case) -underline 5 \
> 			-command {
> 				tkchat::find::on_GUI_change .txt
> 			}
> 		
> 		checkbutton $base.opt.r -text "Use regexp" \
> 			-variable ::tkchat::find::find(regexp) -underline 0 \
> 			-command {
> 				tkchat::find::on_GUI_change .txt
> 			}
> 
> 		pack $base.f.e $base.opt.c $base.opt.r -side left -fill x -expand 1
> 
> 		pack [frame $base.btn] -fill y -expand 1 -pady 5 -padx 5
> 		button $base.btn.prev -text "< Prev" -width 6 -underline 2
> 		button $base.btn.c -text "Close" -width 6 -underline 0
> 		button $base.btn.next -text "Next >" -width 6 -underline 0
> 		eval pack [winfo children $base.btn] -padx 9 \
> 			-side left
> 		
> 		# Keyboard Shortcuts
> 		bind $base <Alt-s>      [list $base.opt.c invoke]
> 		bind $base <Alt-u>      [list $base.opt.r invoke]
> 		bind $base <Alt-c>      [list $base.btn.c invoke]
> 		bind $base <Alt-Left>   "[list $base.btn.prev invoke]; break"
> 		bind $base <Alt-Right>  "[list $base.btn.next invoke]; break"
> 		bind $base <Alt-p>      "[list $base.btn.prev invoke]; break"
> 		bind $base <Alt-n>      "[list $base.btn.next invoke]; break"
> 		bind $base <Alt-P>      "[list $base.btn.prev invoke]; break"
> 		bind $base <Alt-N>      "[list $base.btn.next invoke]; break"
> 		bind $base <Alt-Up>     "[list $base.btn.prev invoke]; break"
> 		bind $base <Alt-Down>   "[list $base.btn.next invoke]; break"
> 		bind $base <Up>         "[list $base.btn.prev invoke]; break"
> 		bind $base <Down>       "[list $base.btn.next invoke]; break"
> 		bind $base <Escape>     [list $base.btn.c invoke]
> 		bind $base.f.e <Return> [list ::tkchat::find::on_GUI_change .txt]
> 
>     }
> 
> 	# Reorganize bindings on entry so that Alt plus left and right do not move the cursor
> 	bindtags $base.f.e "$base $base.f.e Entry all"
> 
>     $base.btn.prev config \
> 		-command "
>     ::tkchat::find::prev find .txt
>     "
>     $base.btn.c config \
> 		-command "
>     after cancel \$::tkchat::find::find(id)
>     set ::tkchat::find::find(break) 1
> #    [list $w] tag remove find 1.0 end
>     wm withdraw [list $base]
>     "
>     $base.btn.next config \
> 		-command "
>     ::tkchat::find::next find .txt
>     "
> 
>     if {[string compare normal [wm state $base]]} {
> 		wm deiconify $base
>     } else { raise $base }
>     $base.f.e select range 0 end
> 
> 	on_GUI_change .txt
> 
> 	focus $base.f.e
> 		
> }
> 
> ## ::tkchat::find::on_GUI_change - updates highlighting when GUI is changed
> proc ::tkchat::find::on_GUI_change {w} {
> 	variable find
> 	after cancel $find(id)
> 	set find(break) 1
> 	set after_script "
> 		tkchat::find::find $w \$tkchat::find::find(string) \
> 			-case $tkchat::find::find(case) \
> 			-reg $tkchat::find::find(regexp)
> 	"
> 	set find(id) [after 500 $after_script]
> 	# Return 1 to tell entry to apply changes
> 	return 1
> }
> 
> # Update highlighting to reflect any new matches
> proc ::tkchat::find::on_content_change {} {
> 	after idle {
> 		::tkchat::find::find .txt $::tkchat::find::find(string) \
> 			-case $tkchat::find::find(case) \
> 			-reg $tkchat::find::find(regexp)
> 	}
> }
> 
> ## ::tkchat::find::find - searches in text widget $w for $str and highlights it
> ## If $str is empty, it just deletes any highlighting
> # ARGS: w	- text widget
> #	str	- string to search for
> #	-case	TCL_BOOLEAN	whether to be case sensitive	DEFAULT: 0
> #	-regexp	TCL_BOOLEAN	whether to use $str as pattern	DEFAULT: 0
> ##
> proc ::tkchat::find::find {w str args} {
> 
> 	variable find
> 
>     set truth {^(1|yes|true|on)$}
>     set opts  {}
> 	set find(break) 0
> 
> 	# Capture search string and options in a single variable
> 	set current $find(string)$find(case)$find(regexp)
> 
> 	# If pattern or string is empty, or
> 	# if the search string and search options do not match the previous,
> 	# clear highlighting
> 	if {![string equal $find(startIndex) {}] && [string equal $current $find(last)]} {
> 		$w mark set findmark $find(startIndex)
> 		set find(startIndex) {}
> 	} {
> 		$w tag remove find 1.0 end
> 		$w mark set findmark 1.0
> 	}
> 
> 	# If search string or regexp pattern is empty, return now
>     if {[string match {} $str]} return
>     foreach {key val} $args {
> 		switch -glob -- $key {
> 			-c* {
> 				if {[regexp -nocase $truth $val]} {
> 					set case 1
> 				}
> 			}
> 			-r* {
> 				if {[regexp -nocase $truth $val]} {
> 					lappend opts -regexp
> 					
> 					# Cam regexp pattern match the empty string?
> 					catch { regexp $str {} } res
> 
> 					# If the result is an error message
> 					# or the pattern matched the empty string
> 					if { $res != 0 } {
> 						return
> 					}
> 				}
> 			}
> 			default {
> 				return -code error "Unknown option $key"
> 			}
> 		}
> 	}
> 
>     if {![info exists case]} { lappend opts -nocase }
> 
>     while {[string compare {} [set ix [eval $w search $opts -count numc -- \
> 										   {$str} findmark end]]]} {
> 		$w tag add find $ix ${ix}+${numc}c
> 		$w mark set findmark ${ix}+1c
> 		# keep the gui alive during long running searches
> 		update
> 		if {$find(break)} {
> 			set find(startIndex) [$w index findmark]
> 			break
> 		}
>     }
> 	
> 	set find(last) $current
> 	set find(startIndex) [$w index findmark]
>     $w tag configure find -background orange
> 	return [expr {[llength [$w tag ranges find]]/2}]
> 	
