Merge branch 'bw/searching'

This commit is contained in:
Pat Thoyts 2011-10-19 13:35:30 +01:00
commit ae6ec6124b
4 changed files with 210 additions and 19 deletions

View File

@ -299,7 +299,9 @@ proc is_config_true {name} {
global repo_config
if {[catch {set v $repo_config($name)}]} {
return 0
} elseif {$v eq {true} || $v eq {1} || $v eq {yes}} {
}
set v [string tolower $v]
if {$v eq {} || $v eq {true} || $v eq {1} || $v eq {yes} || $v eq {on}} {
return 1
} else {
return 0
@ -310,7 +312,9 @@ proc is_config_false {name} {
global repo_config
if {[catch {set v $repo_config($name)}]} {
return 0
} elseif {$v eq {false} || $v eq {0} || $v eq {no}} {
}
set v [string tolower $v]
if {$v eq {false} || $v eq {0} || $v eq {no} || $v eq {off}} {
return 1
} else {
return 0
@ -1061,6 +1065,10 @@ git-version proc _parse_config {arr_name args} {
} else {
set arr($name) $value
}
} elseif {[regexp {^([^\n]+)$} $line line name]} {
# no value given, but interpreting them as
# boolean will be handled as true
set arr($name) {}
}
}
}
@ -1076,6 +1084,10 @@ git-version proc _parse_config {arr_name args} {
} else {
set arr($name) $value
}
} elseif {[regexp {^([^=]+)$} $line line name]} {
# no value given, but interpreting them as
# boolean will be handled as true
set arr($name) {}
}
}
close $fd_rc

View File

@ -15,7 +15,7 @@ constructor new {i_w i_text args} {
${NS}::frame $w
${NS}::label $w.l -text [mc "Goto Line:"]
entry $w.ent \
tentry $w.ent \
-textvariable ${__this}::linenum \
-background lightgreen \
-validate key \

View File

@ -7,9 +7,16 @@ field w
field ctext
field searchstring {}
field casesensitive 1
field regexpsearch
field default_regexpsearch
field casesensitive
field default_casesensitive
field smartcase
field searchdirn -forwards
field history
field history_index
field smarktop
field smarkbot
@ -18,15 +25,28 @@ constructor new {i_w i_text args} {
set w $i_w
set ctext $i_text
set default_regexpsearch [is_config_true gui.search.regexp]
set smartcase [is_config_true gui.search.smartcase]
if {$smartcase} {
set default_casesensitive 0
} else {
set default_casesensitive 1
}
set history [list]
${NS}::frame $w
${NS}::label $w.l -text [mc Find:]
entry $w.ent -textvariable ${__this}::searchstring -background lightgreen
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.cs -text [mc Case-Sensitive] \
${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
@ -37,6 +57,8 @@ constructor new {i_w i_text args} {
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
@ -45,6 +67,10 @@ constructor new {i_w i_text args} {
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
}
@ -53,6 +79,7 @@ method hide {} {
if {[visible $this]} {
focus $ctext
grid remove $w
_save_search $this
}
}
@ -98,6 +125,9 @@ method _do_search {start {mlenvar {}} {dir {}} {endbound {}}} {
upvar $mlenvar mlen
lappend cmd -count mlen
}
if {$regexpsearch} {
lappend cmd -regexp
}
if {!$casesensitive} {
lappend cmd -nocase
}
@ -105,14 +135,16 @@ method _do_search {start {mlenvar {}} {dir {}} {endbound {}}} {
set dir $searchdirn
}
lappend cmd $dir -- $searchstring
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]]
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
}
@ -125,20 +157,76 @@ method _incrsearch {} {
if {[catch {$ctext index anchor}]} {
$ctext mark set anchor [_get_new_anchor $this]
}
if {$smartcase} {
if {[regexp {[[:upper:]]} $searchstring]} {
set casesensitive 1
}
}
if {$searchstring ne {}} {
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 configure -background lightgreen
$w.ent state !pressed
_set_marks $this 1
} else {
$w.ent configure -background lightpink
#$w.ent configure -background lightpink
$w.ent state pressed
}
}
}
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
}
@ -149,6 +237,7 @@ method find_next {{dir -forwards}} {
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"

View File

@ -23,10 +23,59 @@ proc InitTheme {} {
ttk::style configure Gold.TFrame -background gold -relief flat
# listboxes should have a theme border so embed in ttk::frame
ttk::style layout SListbox.TFrame {
SListbox.Frame.Entry.field -sticky news -border true -children {
SListbox.Frame.padding -sticky news
}
}
SListbox.Frame.Entry.field -sticky news -border true -children {
SListbox.Frame.padding -sticky news
}
}
# Handle either current Tk or older versions of 8.5
if {[catch {set theme [ttk::style theme use]}]} {
set theme $::ttk::currentTheme
}
if {[lsearch -exact {default alt classic clam} $theme] != -1} {
# Simple override of standard ttk::entry to change the field
# packground according to a state flag. We should use 'user1'
# but not all versions of 8.5 support that so make use of 'pressed'
# which is not normally in use for entry widgets.
ttk::style layout Edged.Entry [ttk::style layout TEntry]
ttk::style map Edged.Entry {*}[ttk::style map TEntry]
ttk::style configure Edged.Entry {*}[ttk::style configure TEntry] \
-fieldbackground lightgreen
ttk::style map Edged.Entry -fieldbackground {
{pressed !disabled} lightpink
}
} else {
# For fancier themes, in particular the Windows ones, the field
# element may not support changing the background color. So instead
# override the fill using the default fill element. If we overrode
# the vista theme field element we would loose the themed border
# of the widget.
catch {
ttk::style element create color.fill from default
}
ttk::style layout Edged.Entry {
Edged.Entry.field -sticky nswe -border 0 -children {
Edged.Entry.border -sticky nswe -border 1 -children {
Edged.Entry.padding -sticky nswe -children {
Edged.Entry.color.fill -sticky nswe -children {
Edged.Entry.textarea -sticky nswe
}
}
}
}
}
ttk::style configure Edged.Entry {*}[ttk::style configure TEntry] \
-background lightgreen -padding 0 -borderwidth 0
ttk::style map Edged.Entry {*}[ttk::style map TEntry] \
-background {{pressed !disabled} lightpink}
}
if {[lsearch [bind . <<ThemeChanged>>] InitTheme] == -1} {
bind . <<ThemeChanged>> +[namespace code [list InitTheme]]
}
}
proc gold_frame {w args} {
@ -143,6 +192,47 @@ proc tspinbox {w args} {
}
}
proc tentry {w args} {
global use_ttk
if {$use_ttk} {
InitTheme
ttk::entry $w -style Edged.Entry
} else {
entry $w
}
rename $w _$w
interp alias {} $w {} tentry_widgetproc $w
eval [linsert $args 0 tentry_widgetproc $w configure]
return $w
}
proc tentry_widgetproc {w cmd args} {
global use_ttk
switch -- $cmd {
state {
if {$use_ttk} {
return [uplevel 1 [list _$w $cmd] $args]
} else {
if {[lsearch -exact $args pressed] != -1} {
_$w configure -background lightpink
} else {
_$w configure -background lightgreen
}
}
}
configure {
if {$use_ttk} {
if {[set n [lsearch -exact $args -background]] != -1} {
set args [lreplace $args $n [incr n]]
if {[llength $args] == 0} {return}
}
}
return [uplevel 1 [list _$w $cmd] $args]
}
default { return [uplevel 1 [list _$w $cmd] $args] }
}
}
# Tk 8.6 provides a standard font selection dialog. This uses the native
# dialogs on Windows and MacOSX or a standard Tk dialog on X11.
proc tchoosefont {w title familyvar sizevar} {