summaryrefslogtreecommitdiff
path: root/support/dinbrief-gui/dinbrief.vfs/searchText.tcl
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
committerNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
commite0c6872cf40896c7be36b11dcc744620f10adf1d (patch)
tree60335e10d2f4354b0674ec22d7b53f0f8abee672 /support/dinbrief-gui/dinbrief.vfs/searchText.tcl
Initial commit
Diffstat (limited to 'support/dinbrief-gui/dinbrief.vfs/searchText.tcl')
-rw-r--r--support/dinbrief-gui/dinbrief.vfs/searchText.tcl300
1 files changed, 300 insertions, 0 deletions
diff --git a/support/dinbrief-gui/dinbrief.vfs/searchText.tcl b/support/dinbrief-gui/dinbrief.vfs/searchText.tcl
new file mode 100644
index 0000000000..f5c0459414
--- /dev/null
+++ b/support/dinbrief-gui/dinbrief.vfs/searchText.tcl
@@ -0,0 +1,300 @@
+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 <Key> [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 <Button-1> {searchMode %W 0}
+}
+
+bind searchMode <FocusOut> {
+ searchMode %W 0
+}
+
+namespace import -force {::searchText::*}
+