Tk Library Source Code

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100

1441a1442,1443 > $m add command -label "Find" -underline 0 \ > -command "::tkchat::findDialog .txt {}" 2773a2776,2871 > } > > ## ::tkchat::findDialog - dialog interface to ::tkchat::find > # ARGS: w - text widget > # str - optional seed string for ::tkchat::findString > ## > proc ::tkchat::findDialog {w {str {}}} { > > # 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::findString \ > -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::case -underline 5 > checkbutton $base.opt.r -text "Use regexp" \ > -variable ::tkchat::regexp -underline 0 > 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.fnd -text "Find" -width 6 -underline 0 -default active > 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-f> [list $base.btn.fnd 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 $base.btn.fnd invoke] > > } > $base.btn.fnd config \ > -command "::tkchat::find [list $w] \$::tkchat::findString \ > -case \$::tkchat::case -reg \$::tkchat::regexp" > $base.btn.c config \ > -command " > [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 > > $base.btn.fnd invoke > > focus $base.f.e > > } > > ## ::tkchat::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 {w str args} { > $w tag remove find 1.0 end > set truth {^(1|yes|true|on)$} > set opts {} > 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 } } > default { return -code error "Unknown option $key" } > } > } > if {![info exists case]} { lappend opts -nocase } > if {[string match {} $str]} return > $w mark set findmark 1.0 > while {[string compare {} [set ix [eval $w search $opts -count numc -- \ > [list $str] findmark end]]]} { > $w tag add find $ix ${ix}+${numc}c > $w mark set findmark ${ix}+1c > } > $w tag configure find -background yellow > # catch {$w see find.first} > return [expr {[llength [$w tag ranges find]]/2}]