path: root/lib/search.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]
	}
}

}