git-subtree-dir: third_party/git git-subtree-split: cb715685942260375e1eb8153b0768a376e4ece7
		
			
				
	
	
		
			300 lines
		
	
	
	
		
			6.6 KiB
		
	
	
	
		
			Tcl
		
	
	
	
	
	
			
		
		
	
	
			300 lines
		
	
	
	
		
			6.6 KiB
		
	
	
	
		
			Tcl
		
	
	
	
	
	
| # incremental search panel
 | |
| # based on code from gitk, Copyright (C) Paul Mackerras
 | |
| 
 | |
| class searchbar {
 | |
| 
 | |
| field w
 | |
| field ctext
 | |
| 
 | |
| field searchstring   {}
 | |
| field regexpsearch
 | |
| field default_regexpsearch
 | |
| field casesensitive
 | |
| field default_casesensitive
 | |
| field smartcase
 | |
| field searchdirn     -forwards
 | |
| 
 | |
| field history
 | |
| field history_index
 | |
| 
 | |
| field smarktop
 | |
| field smarkbot
 | |
| 
 | |
| constructor new {i_w i_text args} {
 | |
| 	global use_ttk NS
 | |
| 	set w      $i_w
 | |
| 	set ctext  $i_text
 | |
| 
 | |
| 	set default_regexpsearch [is_config_true gui.search.regexp]
 | |
| 	switch -- [get_config gui.search.case] {
 | |
| 	no {
 | |
| 		set default_casesensitive 0
 | |
| 		set smartcase 0
 | |
| 	}
 | |
| 	smart {
 | |
| 		set default_casesensitive 0
 | |
| 		set smartcase 1
 | |
| 	}
 | |
| 	yes -
 | |
| 	default {
 | |
| 		set default_casesensitive 1
 | |
| 		set smartcase 0
 | |
| 	}
 | |
| 	}
 | |
| 
 | |
| 	set history [list]
 | |
| 
 | |
| 	${NS}::frame  $w
 | |
| 	${NS}::label  $w.l       -text [mc Find:]
 | |
| 	tentry  $w.ent -textvariable ${__this}::searchstring -background lightgreen
 | |
| 	${NS}::button $w.bn      -text [mc Next] -command [cb find_next]
 | |
| 	${NS}::button $w.bp      -text [mc Prev] -command [cb find_prev]
 | |
| 	${NS}::checkbutton $w.re -text [mc RegExp] \
 | |
| 		-variable ${__this}::regexpsearch -command [cb _incrsearch]
 | |
| 	${NS}::checkbutton $w.cs -text [mc Case] \
 | |
| 		-variable ${__this}::casesensitive -command [cb _incrsearch]
 | |
| 	pack   $w.l   -side left
 | |
| 	pack   $w.cs  -side right
 | |
| 	pack   $w.re  -side right
 | |
| 	pack   $w.bp  -side right
 | |
| 	pack   $w.bn  -side right
 | |
| 	pack   $w.ent -side left -expand 1 -fill x
 | |
| 
 | |
| 	eval grid conf $w -sticky we $args
 | |
| 	grid remove $w
 | |
| 
 | |
| 	trace add variable searchstring write [cb _incrsearch_cb]
 | |
| 	bind $w.ent <Return> [cb find_next]
 | |
| 	bind $w.ent <Shift-Return> [cb find_prev]
 | |
| 	bind $w.ent <Key-Up>   [cb _prev_search]
 | |
| 	bind $w.ent <Key-Down> [cb _next_search]
 | |
| 	
 | |
| 	bind $w <Destroy> [list delete_this $this]
 | |
| 	return $this
 | |
| }
 | |
| 
 | |
| method show {} {
 | |
| 	if {![visible $this]} {
 | |
| 		grid $w
 | |
| 		$w.ent delete 0 end
 | |
| 		set regexpsearch  $default_regexpsearch
 | |
| 		set casesensitive $default_casesensitive
 | |
| 		set history_index [llength $history]
 | |
| 	}
 | |
| 	focus -force $w.ent
 | |
| }
 | |
| 
 | |
| method hide {} {
 | |
| 	if {[visible $this]} {
 | |
| 		focus $ctext
 | |
| 		grid remove $w
 | |
| 		_save_search $this
 | |
| 	}
 | |
| }
 | |
| 
 | |
| method visible {} {
 | |
| 	return [winfo ismapped $w]
 | |
| }
 | |
| 
 | |
| method editor {} {
 | |
| 	return $w.ent
 | |
| }
 | |
| 
 | |
| method _get_new_anchor {} {
 | |
| 	# use start of selection if it is visible,
 | |
| 	# or the bounds of the visible area
 | |
| 	set top    [$ctext index @0,0]
 | |
| 	set bottom [$ctext index @0,[winfo height $ctext]]
 | |
| 	set sel    [$ctext tag ranges sel]
 | |
| 	if {$sel ne {}} {
 | |
| 		set spos [lindex $sel 0]
 | |
| 		if {[lindex $spos 0] >= [lindex $top 0] &&
 | |
| 		    [lindex $spos 0] <= [lindex $bottom 0]} {
 | |
| 			return $spos
 | |
| 		}
 | |
| 	}
 | |
| 	if {$searchdirn eq "-forwards"} {
 | |
| 		return $top
 | |
| 	} else {
 | |
| 		return $bottom
 | |
| 	}
 | |
| }
 | |
| 
 | |
| method _get_wrap_anchor {dir} {
 | |
| 	if {$dir eq "-forwards"} {
 | |
| 		return 1.0
 | |
| 	} else {
 | |
| 		return end
 | |
| 	}
 | |
| }
 | |
| 
 | |
| method _do_search {start {mlenvar {}} {dir {}} {endbound {}}} {
 | |
| 	set cmd [list $ctext search]
 | |
| 	if {$mlenvar ne {}} {
 | |
| 		upvar $mlenvar mlen
 | |
| 		lappend cmd -count mlen
 | |
| 	}
 | |
| 	if {$regexpsearch} {
 | |
| 		lappend cmd -regexp
 | |
| 	}
 | |
| 	if {!$casesensitive} {
 | |
| 		lappend cmd -nocase
 | |
| 	}
 | |
| 	if {$dir eq {}} {
 | |
| 		set dir $searchdirn
 | |
| 	}
 | |
| 	lappend cmd $dir -- $searchstring
 | |
| 	if {[catch {
 | |
| 		if {$endbound ne {}} {
 | |
| 			set here [eval $cmd [list $start] [list $endbound]]
 | |
| 		} else {
 | |
| 			set here [eval $cmd [list $start]]
 | |
| 			if {$here eq {}} {
 | |
| 				set here [eval $cmd [_get_wrap_anchor $this $dir]]
 | |
| 			}
 | |
| 		}
 | |
| 	} err]} { set here {} }
 | |
| 	return $here
 | |
| }
 | |
| 
 | |
| method _incrsearch_cb {name ix op} {
 | |
| 	after idle [cb _incrsearch]
 | |
| }
 | |
| 
 | |
| method _incrsearch {} {
 | |
| 	$ctext tag remove found 1.0 end
 | |
| 	if {[catch {$ctext index anchor}]} {
 | |
| 		$ctext mark set anchor [_get_new_anchor $this]
 | |
| 	}
 | |
| 	if {$searchstring ne {}} {
 | |
| 		if {$smartcase && [regexp {[[:upper:]]} $searchstring]} {
 | |
| 			set casesensitive 1
 | |
| 		}
 | |
| 		set here [_do_search $this anchor mlen]
 | |
| 		if {$here ne {}} {
 | |
| 			$ctext see $here
 | |
| 			$ctext tag remove sel 1.0 end
 | |
| 			$ctext tag add sel $here "$here + $mlen c"
 | |
| 			#$w.ent configure -background lightgreen
 | |
| 			$w.ent state !pressed
 | |
| 			_set_marks $this 1
 | |
| 		} else {
 | |
| 			#$w.ent configure -background lightpink
 | |
| 			$w.ent state pressed
 | |
| 		}
 | |
| 	} elseif {$smartcase} {
 | |
| 		# clearing the field resets the smart case detection
 | |
| 		set casesensitive 0
 | |
| 	}
 | |
| }
 | |
| 
 | |
| method _save_search {} {
 | |
| 	if {$searchstring eq {}} {
 | |
| 		return
 | |
| 	}
 | |
| 	if {[llength $history] > 0} {
 | |
| 		foreach {s_regexp s_case s_expr} [lindex $history end] break
 | |
| 	} else {
 | |
| 		set s_regexp $regexpsearch
 | |
| 		set s_case   $casesensitive
 | |
| 		set s_expr   ""
 | |
| 	}
 | |
| 	if {$searchstring eq $s_expr} {
 | |
| 		# update modes
 | |
| 		set history [lreplace $history end end \
 | |
| 				[list $regexpsearch $casesensitive $searchstring]]
 | |
| 	} else {
 | |
| 		lappend history [list $regexpsearch $casesensitive $searchstring]
 | |
| 	}
 | |
| 	set history_index [llength $history]
 | |
| }
 | |
| 
 | |
| method _prev_search {} {
 | |
| 	if {$history_index > 0} {
 | |
| 		incr history_index -1
 | |
| 		foreach {s_regexp s_case s_expr} [lindex $history $history_index] break
 | |
| 		$w.ent delete 0 end
 | |
| 		$w.ent insert 0 $s_expr
 | |
| 		set regexpsearch $s_regexp
 | |
| 		set casesensitive $s_case
 | |
| 	}
 | |
| }
 | |
| 
 | |
| method _next_search {} {
 | |
| 	if {$history_index < [llength $history]} {
 | |
| 		incr history_index
 | |
| 	}
 | |
| 	if {$history_index < [llength $history]} {
 | |
| 		foreach {s_regexp s_case s_expr} [lindex $history $history_index] break
 | |
| 	} else {
 | |
| 		set s_regexp $default_regexpsearch
 | |
| 		set s_case   $default_casesensitive
 | |
| 		set s_expr   ""
 | |
| 	}
 | |
| 	$w.ent delete 0 end
 | |
| 	$w.ent insert 0 $s_expr
 | |
| 	set regexpsearch $s_regexp
 | |
| 	set casesensitive $s_case
 | |
| }
 | |
| 
 | |
| method find_prev {} {
 | |
| 	find_next $this -backwards
 | |
| }
 | |
| 
 | |
| method find_next {{dir -forwards}} {
 | |
| 	focus $w.ent
 | |
| 	$w.ent icursor end
 | |
| 	set searchdirn $dir
 | |
| 	$ctext mark unset anchor
 | |
| 	if {$searchstring ne {}} {
 | |
| 		_save_search $this
 | |
| 		set start [_get_new_anchor $this]
 | |
| 		if {$dir eq "-forwards"} {
 | |
| 			set start "$start + 1c"
 | |
| 		}
 | |
| 		set match [_do_search $this $start mlen]
 | |
| 		$ctext tag remove sel 1.0 end
 | |
| 		if {$match ne {}} {
 | |
| 			$ctext see $match
 | |
| 			$ctext tag add sel $match "$match + $mlen c"
 | |
| 		}
 | |
| 	}
 | |
| }
 | |
| 
 | |
| method _mark_range {first last} {
 | |
| 	set mend $first.0
 | |
| 	while {1} {
 | |
| 		set match [_do_search $this $mend mlen -forwards $last.end]
 | |
| 		if {$match eq {}} break
 | |
| 		set mend "$match + $mlen c"
 | |
| 		$ctext tag add found $match $mend
 | |
| 	}
 | |
| }
 | |
| 
 | |
| method _set_marks {doall} {
 | |
| 	set topline [lindex [split [$ctext index @0,0] .] 0]
 | |
| 	set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
 | |
| 	if {$doall || $botline < $smarktop || $topline > $smarkbot} {
 | |
| 		# no overlap with previous
 | |
| 		_mark_range $this $topline $botline
 | |
| 		set smarktop $topline
 | |
| 		set smarkbot $botline
 | |
| 	} else {
 | |
| 		if {$topline < $smarktop} {
 | |
| 			_mark_range $this $topline [expr {$smarktop-1}]
 | |
| 			set smarktop $topline
 | |
| 		}
 | |
| 		if {$botline > $smarkbot} {
 | |
| 			_mark_range $this [expr {$smarkbot+1}] $botline
 | |
| 			set smarkbot $botline
 | |
| 		}
 | |
| 	}
 | |
| }
 | |
| 
 | |
| method scrolled {} {
 | |
| 	if {$searchstring ne {}} {
 | |
| 		after idle [cb _set_marks 0]
 | |
| 	}
 | |
| }
 | |
| 
 | |
| }
 |