comment { Inkrementelle Suche, nur Vorwärts, kein Ersetzen. Das widget wird bei Betreten des Suchmodus an das Ereignistag searchMode gebunden. Bei Verlassen erhält es die vorigen Ereignistags zurück (zwischengespeichert in bindTags($win)). } namespace eval searchText { # bindtags: array intended to store original binding tags of widgets variable bindTags array set bindTags {} variable searchModeOf array set searchModeOf {} # searchHistory contains history of incremental search variable searchHistory {} variable searchString "" # escapeCharMap intended to translate spec chars to escaped ones variable escapeCharMap [[lambda {} { set result {} lappend result\ \{ \\\{ \} \\\} ( \\( ) \\) \[ \\\[ \] \\\]\ * \\* + \\+ ? \\? \\ \\\\ . \\. \$ \\\$\ " " \\s \t \\s set quotePat \[ append quotePat \u201e \u201c \u201d \u00bb \u00ab \] lappend result \" $quotePat set apostrophePat \[ append apostrophePat \u201a \u2018 \u2019 \u203a \u2039 \] lappend result ' $apostrophePat set dashPat \[ append dashPat \u2013 \u2014 - \] lappend result - $dashPat }]] # asciifiedCharMap intended to translate typgraphical chars to ASCII variable asciifiedCharMap\ [list \t " " \u2013 - \u2014 -\ \u201e \" \u201c \" \u201d \" \u00bb \" \u00ab \"\ \u201a ' \u2018 ' \u2019 ' \u203a ' \u2039 '] } # # ::searchText::getSearchModeOf win # return true if $win is in search mode # proc ::searchText::getSearchModeOf {win} { variable searchModeOf switch [winfo class $win] { Scrolledtext - Scrolledrichtext { getSearchModeOf $win.text } default { expr {[info exists searchModeOf($win)] && $searchModeOf($win)} } } } proc ::searchText::setSearchModeOf {win val} { variable searchModeOf switch [winfo class $win] { Scrolledtext - Scrolledrichtext { setSearchModeOf $win.text $val } default { set searchModeOf($win) $val } } } # # ::searchText::asciifiedSelection win # returns contents of current selection of $win # proc ::searchText::asciifiedSelection {win} { if {[$win tag ranges sel] ne {}} { variable asciifiedCharMap string map $asciifiedCharMap [$win get sel.first sel.last] } } # # ::searchText::searchWinEsc win str index dir # searches $str in $win such that " finds national quotes etc. # proc ::searchText::searchWinEsc {win str {index insert} {dir -forward}} { variable escapeCharMap set str1 [string map $escapeCharMap $str] switch -- $dir { -backward { $win search -regexp -nocase -backward -- $str1 $index 1.0 } default { $win search -regexp -nocase -- $str1 $index end } } } proc ::searchText::toggleSearchMode {win} { searchMode $win [expr {![expr {[getSearchModeOf $win]}]}] } # # ::searchText::searchMode .maintext no # switches searchimg mode for .maintext off # # ::searchText::searchMode .maintext ye # switches searchimg mode for .maintext on # if some text is selected, search it first # proc ::searchText::searchMode {win {mode yes}} { switch [winfo class $win] { Scrolledtext - Scrolledrichtext { return [searchMode $win.text $mode] } } variable bindTags variable searchString variable searchHistory variable searchModeOf if {$mode} { if {[getSearchModeOf $win]} { return } set searchModeOf($win) 1 $win tag configure found -background yellow $win tag raise sel set bindTags($win) [bindtags $win] bindtags $win searchMode grid .searchStringLabel .searchString - - -sticky ne grid configure .searchString -sticky nw .searchStringLabel configure -foreground black if {[$win tag ranges sel] eq {}} { set searchString "" } else { let {from to} [$win tag ranges sel] set searchString [asciifiedSelection $win] searchWinText $win $searchString [$win index sel.first] } set searchHistory {} } else { if {![getSearchModeOf $win]} { return } set searchModeOf($win) 0 bindtags $win $bindTags($win) $win tag remove found 1.0 end grid forget .searchStringLabel .searchString if {$searchString ne ""} { globalSetting lastSearchString $searchString } } } # # ::searchText::markWinOccurrences win str # marks all occurrences of $str in $win with tag found # (currently yellow background) # proc ::searchText::markWinOccurrences {win string} { $win tag remove found 1.0 end if {$string eq ""} { return } set i 1.0 # [set i [$win search -regexp -nocase -- $str1 $i end]] while {[set i [searchWinEsc $win $string $i]] ne {}} { set i1 [$win index $i+[string length $string]chars] $win tag add found $i $i1 set i $i1 } } # # ::searchText::searchWinNextChar win char # appends $char to $searchString, calls searchWinText # (this proc realizes incremental search) # proc ::searchText::searchWinNextChar {win char} { variable searchString set sel [$win tag ranges sel] if {$sel ne {}} { let {from to} $sel } else { set from [$win index insert] } searchWinText $win $searchString$char $from } # # ::searchText::searchWinText win str index # searches $str in $win starting at $index # appends $str, sel.first, sel.last, ranges of tag found to searchHistory # proc ::searchText::searchWinText {win string {mark insert}} { variable searchString variable searchHistory # push $searchString searchHistory if {[$win tag ranges sel] ne {}} { push [$win index sel.first] searchHistory push [$win index sel.last] searchHistory } else { push [$win index insert] searchHistory push [$win index insert] searchHistory } push [$win tag ranges found] searchHistory # set searchString $string $win tag remove sel 1.0 end set index [searchWinEsc $win $searchString $mark] set foundLength [string length $searchString] if {$index ne {}} { set index1 [$win index "$index + $foundLength chars"] $win tag add sel $index $index1 $win mark set insert $index1 $win see insert .searchStringLabel configure -foreground black } else { .searchStringLabel configure -foreground red } markWinOccurrences $win $string } # # ::searchText::searchHistoryBack win # if searchHistory is not empty, # then restore searchString, selection, ranges of tag found # else shorten searchString by last char and search # this proc realizes backward incremental search # proc ::searchText::searchHistoryBack {win} { variable searchHistory variable searchString if {$searchHistory ne {}} { $win tag remove sel 1.0 end $win tag remove found 1.0 end set foundRanges [pop searchHistory] if {$foundRanges ne {}} { eval $win tag add found $foundRanges } $win mark set insert [pop searchHistory] $win tag add sel [pop searchHistory] insert set searchString [pop searchHistory] $win see insert } elseif {$searchString eq {}} { searchMode $win 0 } else { if {[catch {set i0 [$win index sel.first]}]} { set i0 [$win index insert] } set searchString [string range $searchString 0 end-1] searchWinText $win $searchString $i0 $win mark set insert $i0 $win see insert set searchHistory {} } } # debug # upvar \#0 searchText::searchHistory searchHistory # upvar \#0 searchText::searchString searchString # end of debug namespace eval searchText { namespace export * bind searchMode [namespace code [list [lambda {win key sym} { upvar searchString searchString upvar searchHistory searchHistory switch -glob -- $sym Control* - Alt* - *Shift* { } F3 { if {$searchString eq ""} { searchWinText $win [globalSetting lastSearchString] set searchHistory {} } else { searchWinText $win $searchString } } Escape - Left - Right - Up - Down - Home -\ End - Prior - Next - Insert - Delete - F* { searchMode $win 0 } default { switch -regexp -- $key {[[:graph:][:space:]]} { searchWinNextChar $win $key } \b { # searchWinPrevChar $win searchHistoryBack $win } default { echo exit: key $key searchMode $win 0 } } }] %W %A %K]] bind searchMode {searchMode %W 0} } bind searchMode { searchMode %W 0 } namespace import -force {::searchText::*}