path: root/support/dinbrief-gui/dinbrief.vfs/searchText.tcl

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::*}