Artifact
afc66d74381bddbbf368223a9f932fbaf572466f:
Attachment "tkchat.patch" to
ticket [654976ffff]
added by
lukekalemyers
2002-12-19 23:24:01.
Also attachment "tkchat.patch" to
ticket [656336ffff]
added by
nobody
2002-12-19 22:22:31.
Index: tkchat.tcl
===================================================================
RCS file: /cvsroot/tcllib/tclapps/apps/tkchat/tkchat.tcl,v
retrieving revision 1.72
diff -r1.72 tkchat.tcl
1441a1442,1443
> $m add command -label "Find" -underline 0 \
> -command "::tkchat::find::dialog .txt {}"
1822a1825,1828
> "^/find" {
> regexp -- {/find\s+(.*)} $msg 1 tkchat::find::find(string)
> tkchat::find::dialog .txt
> }
2773a2780,2947
> }
>
> ## 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(lastString) ""
> }
>
> ## ::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 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.c -text "Close" -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 <Escape> [list $base.btn.c invoke]
> bind $base.f.e <Return> [list ::tkchat::find::on_GUI_change .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]
> "
>
> 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 find(id) \
> [after 500 "tkchat::find::find $w \$tkchat::find::find(string) -case $tkchat::find::find(case) -reg $tkchat::find::find(regexp)"]
> # Return 1 to tell entry to apply changes
> return 1
> }
>
>
> ## ::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
>
> if {![string equal $find(startIndex) {}] && [string equal $str $find(lastString)]} {
> $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
>
> # Test regexp pattern
> # match the empty string?
> # valid?
> 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(lastString) $str
> $w tag configure find -background yellow
> return [expr {[llength [$w tag ranges find]]/2}]
>
