Merge branch 'master' of git://repo.or.cz/git-gui

* 'master' of git://repo.or.cz/git-gui: (28 commits)
  git-gui 0.16
  git-gui: handle shell script text filters when loading for blame.
  git-gui: Set both 16x16 and 32x32 icons on X to pacify Xming.
  git-gui: added config gui.gcwarning to disable the gc hint message
  git-gui: set whitespace warnings appropriate to this project
  git-gui: don't warn for detached head when rebasing
  git-gui: make config gui.warndetachedcommit a boolean
  git-gui: add config value gui.diffopts for passing additional diff options
  git-gui: sort the numeric ansi codes
  git-gui: support underline style when parsing diff output
  git-gui: fix spelling error in sshkey.tcl
  git-gui: include the file path in guitools confirmation dialog
  git-gui: span widgets over the full file output area in the blame view
  git-gui: use a tristate to control the case mode in the searchbar
  git-gui: set suitable extended window manager hints.
  git-gui: fix display of path in browser title
  git-gui: enable the smart case sensitive search only if gui.search.smartcase is true
  git-gui: catch invalid or complete regular expressions and treat as no match.
  git-gui: theme the search and line-number entry fields on blame screen
  git-gui: include the number of untracked files to stage when asking the user
  ...
This commit is contained in:
Junio C Hamano 2011-12-13 16:48:24 -08:00
commit 73c6b3575b
17 changed files with 339 additions and 49 deletions

View File

@ -1,3 +1,4 @@
* whitespace=indent-with-non-tab,trailing-space,space-before-tab,tabwidth=4
* encoding=US-ASCII * encoding=US-ASCII
git-gui.sh encoding=UTF-8 git-gui.sh encoding=UTF-8
/po/*.po encoding=UTF-8 /po/*.po encoding=UTF-8

View File

@ -1,7 +1,7 @@
#!/bin/sh #!/bin/sh
GVF=GIT-VERSION-FILE GVF=GIT-VERSION-FILE
DEF_VER=0.13.GITGUI DEF_VER=0.16.GITGUI
LF=' LF='
' '

View File

@ -299,7 +299,9 @@ proc is_config_true {name} {
global repo_config global repo_config
if {[catch {set v $repo_config($name)}]} { if {[catch {set v $repo_config($name)}]} {
return 0 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 return 1
} else { } else {
return 0 return 0
@ -310,7 +312,9 @@ proc is_config_false {name} {
global repo_config global repo_config
if {[catch {set v $repo_config($name)}]} { if {[catch {set v $repo_config($name)}]} {
return 0 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 return 1
} else { } else {
return 0 return 0
@ -460,6 +464,35 @@ proc _which {what args} {
return {} return {}
} }
# Test a file for a hashbang to identify executable scripts on Windows.
proc is_shellscript {filename} {
if {![file exists $filename]} {return 0}
set f [open $filename r]
fconfigure $f -encoding binary
set magic [read $f 2]
close $f
return [expr {$magic eq "#!"}]
}
# Run a command connected via pipes on stdout.
# This is for use with textconv filters and uses sh -c "..." to allow it to
# contain a command with arguments. On windows we must check for shell
# scripts specifically otherwise just call the filter command.
proc open_cmd_pipe {cmd path} {
global env
if {![file executable [shellpath]]} {
set exe [auto_execok [lindex $cmd 0]]
if {[is_shellscript [lindex $exe 0]]} {
set run [linsert [auto_execok sh] end -c "$cmd \"\$0\"" $path]
} else {
set run [concat $exe [lrange $cmd 1 end] $path]
}
} else {
set run [list [shellpath] -c "$cmd \"\$0\"" $path]
}
return [open |$run r]
}
proc _lappend_nice {cmd_var} { proc _lappend_nice {cmd_var} {
global _nice global _nice
upvar $cmd_var cmd upvar $cmd_var cmd
@ -725,7 +758,10 @@ if {[is_Windows]} {
gitlogo put gray26 -to 5 15 11 16 gitlogo put gray26 -to 5 15 11 16
gitlogo redither gitlogo redither
wm iconphoto . -default gitlogo image create photo gitlogo32 -width 32 -height 32
gitlogo32 copy gitlogo -zoom 2 2
wm iconphoto . -default gitlogo gitlogo32
} }
} }
@ -846,6 +882,7 @@ set default_config(gui.fastcopyblame) false
set default_config(gui.copyblamethreshold) 40 set default_config(gui.copyblamethreshold) 40
set default_config(gui.blamehistoryctx) 7 set default_config(gui.blamehistoryctx) 7
set default_config(gui.diffcontext) 5 set default_config(gui.diffcontext) 5
set default_config(gui.diffopts) {}
set default_config(gui.commitmsgwidth) 75 set default_config(gui.commitmsgwidth) 75
set default_config(gui.newbranchtemplate) {} set default_config(gui.newbranchtemplate) {}
set default_config(gui.spellingdictionary) {} set default_config(gui.spellingdictionary) {}
@ -859,6 +896,7 @@ set font_descs {
{fontui font_ui {mc "Main Font"}} {fontui font_ui {mc "Main Font"}}
{fontdiff font_diff {mc "Diff/Console Font"}} {fontdiff font_diff {mc "Diff/Console Font"}}
} }
set default_config(gui.stageuntracked) ask
###################################################################### ######################################################################
## ##
@ -1060,6 +1098,10 @@ git-version proc _parse_config {arr_name args} {
} else { } else {
set arr($name) $value 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) {}
} }
} }
} }
@ -1075,6 +1117,10 @@ git-version proc _parse_config {arr_name args} {
} else { } else {
set arr($name) $value 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 close $fd_rc
@ -2474,6 +2520,7 @@ proc toggle_or_diff {w x y} {
[concat $after [list ui_ready]] [concat $after [list ui_ready]]
} }
} else { } else {
set selected_paths($path) 1
show_diff $path $w $lno show_diff $path $w $lno
} }
} }
@ -3362,6 +3409,7 @@ foreach {n c} {0 black 1 red4 2 green4 3 yellow4 4 blue4 5 magenta4 6 cyan4 7 gr
$ui_diff tag configure clri3$n -background $c $ui_diff tag configure clri3$n -background $c
} }
$ui_diff tag configure clr1 -font font_diffbold $ui_diff tag configure clr1 -font font_diffbold
$ui_diff tag configure clr4 -underline 1
$ui_diff tag conf d_info -foreground blue -font font_diffbold $ui_diff tag conf d_info -foreground blue -font font_diffbold
@ -3878,7 +3926,7 @@ after 1 {
$ui_comm configure -state disabled -background gray $ui_comm configure -state disabled -background gray
} }
} }
if {[is_enabled multicommit]} { if {[is_enabled multicommit] && ![is_config_false gui.gcwarning]} {
after 1000 hint_gc after 1000 hint_gc
} }
if {[is_enabled retcode]} { if {[is_enabled retcode]} {

View File

@ -219,7 +219,8 @@ constructor new {i_commit i_path i_jump} {
eval grid $w_columns $w.file_pane.out.sby -sticky nsew eval grid $w_columns $w.file_pane.out.sby -sticky nsew
grid conf \ grid conf \
$w.file_pane.out.sbx \ $w.file_pane.out.sbx \
-column [expr {[llength $w_columns] - 1}] \ -column 0 \
-columnspan [expr {[llength $w_columns] + 1}] \
-sticky we -sticky we
grid columnconfigure \ grid columnconfigure \
$w.file_pane.out \ $w.file_pane.out \
@ -229,12 +230,14 @@ constructor new {i_commit i_path i_jump} {
set finder [::searchbar::new \ set finder [::searchbar::new \
$w.file_pane.out.ff $w_file \ $w.file_pane.out.ff $w_file \
-column [expr {[llength $w_columns] - 1}] \ -column 0 \
-columnspan [expr {[llength $w_columns] + 1}] \
] ]
set gotoline [::linebar::new \ set gotoline [::linebar::new \
$w.file_pane.out.lf $w_file \ $w.file_pane.out.lf $w_file \
-column [expr {[llength $w_columns] - 1}] \ -column 0 \
-columnspan [expr {[llength $w_columns] + 1}] \
] ]
set w_cviewer $w.file_pane.cm.t set w_cviewer $w.file_pane.cm.t
@ -473,14 +476,7 @@ method _load {jump} {
} }
if {$commit eq {}} { if {$commit eq {}} {
if {$do_textconv ne 0} { if {$do_textconv ne 0} {
# Run textconv with sh -c "..." to allow it to set fd [open_cmd_pipe $textconv $path]
# contain command + arguments. On windows, just
# call the filter command.
if {![file executable [shellpath]]} {
set fd [open |[linsert $textconv end $path] r]
} else {
set fd [open |[list [shellpath] -c "$textconv \"\$0\"" $path] r]
}
} else { } else {
set fd [open $path r] set fd [open $path r]
} }
@ -572,7 +568,11 @@ method _read_file {fd jump} {
foreach i $w_columns {$i conf -state disabled} foreach i $w_columns {$i conf -state disabled}
if {[eof $fd]} { if {[eof $fd]} {
close $fd fconfigure $fd -blocking 1; # enable error reporting on close
if {[catch {close $fd} err]} {
tk_messageBox -icon error -title [mc Error] \
-message $err
}
# If we don't force Tk to update the widgets *right now* # If we don't force Tk to update the widgets *right now*
# none of our jump commands will cause a change in the UI. # none of our jump commands will cause a change in the UI.
@ -1062,7 +1062,7 @@ method _gitkcommit {} {
set radius [get_config gui.blamehistoryctx] set radius [get_config gui.blamehistoryctx]
set cmdline [list --select-commit=$cmit] set cmdline [list --select-commit=$cmit]
if {$radius > 0} { if {$radius > 0} {
set author_time {} set author_time {}
set committer_time {} set committer_time {}
@ -1170,7 +1170,7 @@ method _read_diff_load_commit {fd cparent new_path tline} {
} }
if {[eof $fd]} { if {[eof $fd]} {
close $fd; close $fd
set current_fd {} set current_fd {}
_load_new_commit $this \ _load_new_commit $this \
@ -1201,6 +1201,7 @@ method _open_tooltip {cur_w} {
_hide_tooltip $this _hide_tooltip $this
set tooltip_wm [toplevel $cur_w.tooltip -borderwidth 1] set tooltip_wm [toplevel $cur_w.tooltip -borderwidth 1]
catch {wm attributes $tooltip_wm -type tooltip}
wm overrideredirect $tooltip_wm 1 wm overrideredirect $tooltip_wm 1
wm transient $tooltip_wm [winfo toplevel $cur_w] wm transient $tooltip_wm [winfo toplevel $cur_w]
set tooltip_t $tooltip_wm.label set tooltip_t $tooltip_wm.label

View File

@ -26,8 +26,14 @@ constructor new {commit {path {}}} {
wm withdraw $top wm withdraw $top
wm title $top [append "[appname] ([reponame]): " [mc "File Browser"]] wm title $top [append "[appname] ([reponame]): " [mc "File Browser"]]
if {$path ne {}} {
if {[string index $path end] ne {/}} {
append path /
}
}
set browser_commit $commit set browser_commit $commit
set browser_path $browser_commit:$path set browser_path "$browser_commit:[escape_path $path]"
${NS}::label $w.path \ ${NS}::label $w.path \
-textvariable @browser_path \ -textvariable @browser_path \

View File

@ -497,6 +497,7 @@ method _open_tooltip {} {
if {$tooltip_wm eq {}} { if {$tooltip_wm eq {}} {
set tooltip_wm [toplevel $w_list.tooltip -borderwidth 1] set tooltip_wm [toplevel $w_list.tooltip -borderwidth 1]
catch {wm attributes $tooltip_wm -type tooltip}
wm overrideredirect $tooltip_wm 1 wm overrideredirect $tooltip_wm 1
wm transient $tooltip_wm [winfo toplevel $w_list] wm transient $tooltip_wm [winfo toplevel $w_list]
set tooltip_t $tooltip_wm.label set tooltip_t $tooltip_wm.label

View File

@ -138,6 +138,7 @@ proc make_dialog {t w args} {
upvar $t top $w pfx this this upvar $t top $w pfx this this
global use_ttk global use_ttk
uplevel [linsert $args 0 make_toplevel $t $w] uplevel [linsert $args 0 make_toplevel $t $w]
catch {wm attributes $top -type dialog}
pave_toplevel $pfx pave_toplevel $pfx
} }

View File

@ -263,7 +263,9 @@ proc commit_commitmsg {curHEAD msg_p} {
global is_detached repo_config global is_detached repo_config
global pch_error global pch_error
if {$is_detached && $repo_config(gui.warndetachedcommit)} { if {$is_detached
&& ![file exists [gitdir rebase-merge head-name]]
&& [is_config_true gui.warndetachedcommit]} {
set msg [mc "You are about to commit on a detached head.\ set msg [mc "You are about to commit on a detached head.\
This is a potentially dangerous thing to do because if you switch\ This is a potentially dangerous thing to do because if you switch\
to another branch you will loose your changes and it can be difficult\ to another branch you will loose your changes and it can be difficult\

View File

@ -309,6 +309,7 @@ proc start_show_diff {cont_info {add_opts {}}} {
lappend cmd -p lappend cmd -p
lappend cmd --color lappend cmd --color
set cmd [concat $cmd $repo_config(gui.diffopts)]
if {$repo_config(gui.diffcontext) >= 1} { if {$repo_config(gui.diffcontext) >= 1} {
lappend cmd "-U$repo_config(gui.diffcontext)" lappend cmd "-U$repo_config(gui.diffcontext)"
} }
@ -502,9 +503,9 @@ proc read_diff {fd conflict_size cont_info} {
foreach {posbegin colbegin posend colend} $markup { foreach {posbegin colbegin posend colend} $markup {
set prefix clr set prefix clr
foreach style [split $colbegin ";"] { foreach style [lsort -integer [split $colbegin ";"]] {
if {$style eq "7"} {append prefix i; continue} if {$style eq "7"} {append prefix i; continue}
if {$style < 30 || $style > 47} {continue} if {$style != 4 && ($style < 30 || $style > 47)} {continue}
set a "$mark linestart + $posbegin chars" set a "$mark linestart + $posbegin chars"
set b "$mark linestart + $posend chars" set b "$mark linestart + $posend chars"
catch {$ui_diff tag add $prefix$style $a $b} catch {$ui_diff tag add $prefix$style $a $b}

View File

@ -356,21 +356,33 @@ proc do_add_all {} {
global file_states global file_states
set paths [list] set paths [list]
set unknown_paths [list] set untracked_paths [list]
foreach path [array names file_states] { foreach path [array names file_states] {
switch -glob -- [lindex $file_states($path) 0] { switch -glob -- [lindex $file_states($path) 0] {
U? {continue} U? {continue}
?M - ?M -
?T - ?T -
?D {lappend paths $path} ?D {lappend paths $path}
?O {lappend unknown_paths $path} ?O {lappend untracked_paths $path}
} }
} }
if {[llength $unknown_paths]} { if {[llength $untracked_paths]} {
set reply [ask_popup [mc "There are unknown files do you also want set reply 0
to stage those?"]] switch -- [get_config gui.stageuntracked] {
no {
set reply 0
}
yes {
set reply 1
}
ask -
default {
set reply [ask_popup [mc "Stage %d untracked files?" \
[llength $untracked_paths]]]
}
}
if {$reply} { if {$reply} {
set paths [concat $paths $unknown_paths] set paths [concat $paths $untracked_paths]
} }
} }
add_helper {Adding all changed files} $paths add_helper {Adding all changed files} $paths

View File

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

View File

@ -153,9 +153,12 @@ proc do_options {} {
{i-20..200 gui.copyblamethreshold {mc "Minimum Letters To Blame Copy On"}} {i-20..200 gui.copyblamethreshold {mc "Minimum Letters To Blame Copy On"}}
{i-0..300 gui.blamehistoryctx {mc "Blame History Context Radius (days)"}} {i-0..300 gui.blamehistoryctx {mc "Blame History Context Radius (days)"}}
{i-1..99 gui.diffcontext {mc "Number of Diff Context Lines"}} {i-1..99 gui.diffcontext {mc "Number of Diff Context Lines"}}
{t gui.diffopts {mc "Additional Diff Parameters"}}
{i-0..99 gui.commitmsgwidth {mc "Commit Message Text Width"}} {i-0..99 gui.commitmsgwidth {mc "Commit Message Text Width"}}
{t gui.newbranchtemplate {mc "New Branch Name Template"}} {t gui.newbranchtemplate {mc "New Branch Name Template"}}
{c gui.encoding {mc "Default File Contents Encoding"}} {c gui.encoding {mc "Default File Contents Encoding"}}
{b gui.warndetachedcommit {mc "Warn before committing to a detached head"}}
{s gui.stageuntracked {mc "Staging of untracked files"} {list "yes" "no" "ask"}}
} { } {
set type [lindex $option 0] set type [lindex $option 0]
set name [lindex $option 1] set name [lindex $option 1]
@ -208,6 +211,23 @@ proc do_options {} {
} }
pack $w.$f.$optid -side top -anchor w -fill x pack $w.$f.$optid -side top -anchor w -fill x
} }
s {
set opts [eval [lindex $option 3]]
${NS}::frame $w.$f.$optid
${NS}::label $w.$f.$optid.l -text "$text:"
if {$use_ttk} {
ttk::combobox $w.$f.$optid.v \
-textvariable ${f}_config_new($name) \
-values $opts -state readonly
} else {
eval tk_optionMenu $w.$f.$optid.v \
${f}_config_new($name) \
$opts
}
pack $w.$f.$optid.l -side left -anchor w -fill x
pack $w.$f.$optid.v -side right -anchor e -padx 5
pack $w.$f.$optid -side top -anchor w -fill x
}
} }
} }
} }

View File

@ -7,9 +7,16 @@ field w
field ctext field ctext
field searchstring {} field searchstring {}
field casesensitive 1 field regexpsearch
field default_regexpsearch
field casesensitive
field default_casesensitive
field smartcase
field searchdirn -forwards field searchdirn -forwards
field history
field history_index
field smarktop field smarktop
field smarkbot field smarkbot
@ -18,15 +25,37 @@ constructor new {i_w i_text args} {
set w $i_w set w $i_w
set ctext $i_text 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}::frame $w
${NS}::label $w.l -text [mc Find:] ${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.bn -text [mc Next] -command [cb find_next]
${NS}::button $w.bp -text [mc Prev] -command [cb find_prev] ${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] -variable ${__this}::casesensitive -command [cb _incrsearch]
pack $w.l -side left pack $w.l -side left
pack $w.cs -side right pack $w.cs -side right
pack $w.re -side right
pack $w.bp -side right pack $w.bp -side right
pack $w.bn -side right pack $w.bn -side right
pack $w.ent -side left -expand 1 -fill x pack $w.ent -side left -expand 1 -fill x
@ -37,6 +66,8 @@ constructor new {i_w i_text args} {
trace add variable searchstring write [cb _incrsearch_cb] trace add variable searchstring write [cb _incrsearch_cb]
bind $w.ent <Return> [cb find_next] bind $w.ent <Return> [cb find_next]
bind $w.ent <Shift-Return> [cb find_prev] 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] bind $w <Destroy> [list delete_this $this]
return $this return $this
@ -45,6 +76,10 @@ constructor new {i_w i_text args} {
method show {} { method show {} {
if {![visible $this]} { if {![visible $this]} {
grid $w grid $w
$w.ent delete 0 end
set regexpsearch $default_regexpsearch
set casesensitive $default_casesensitive
set history_index [llength $history]
} }
focus -force $w.ent focus -force $w.ent
} }
@ -53,6 +88,7 @@ method hide {} {
if {[visible $this]} { if {[visible $this]} {
focus $ctext focus $ctext
grid remove $w grid remove $w
_save_search $this
} }
} }
@ -98,6 +134,9 @@ method _do_search {start {mlenvar {}} {dir {}} {endbound {}}} {
upvar $mlenvar mlen upvar $mlenvar mlen
lappend cmd -count mlen lappend cmd -count mlen
} }
if {$regexpsearch} {
lappend cmd -regexp
}
if {!$casesensitive} { if {!$casesensitive} {
lappend cmd -nocase lappend cmd -nocase
} }
@ -105,14 +144,16 @@ method _do_search {start {mlenvar {}} {dir {}} {endbound {}}} {
set dir $searchdirn set dir $searchdirn
} }
lappend cmd $dir -- $searchstring lappend cmd $dir -- $searchstring
if {$endbound ne {}} { if {[catch {
set here [eval $cmd [list $start] [list $endbound]] if {$endbound ne {}} {
} else { set here [eval $cmd [list $start] [list $endbound]]
set here [eval $cmd [list $start]] } else {
if {$here eq {}} { set here [eval $cmd [list $start]]
set here [eval $cmd [_get_wrap_anchor $this $dir]] if {$here eq {}} {
set here [eval $cmd [_get_wrap_anchor $this $dir]]
}
} }
} } err]} { set here {} }
return $here return $here
} }
@ -126,19 +167,76 @@ method _incrsearch {} {
$ctext mark set anchor [_get_new_anchor $this] $ctext mark set anchor [_get_new_anchor $this]
} }
if {$searchstring ne {}} { if {$searchstring ne {}} {
if {$smartcase && [regexp {[[:upper:]]} $searchstring]} {
set casesensitive 1
}
set here [_do_search $this anchor mlen] set here [_do_search $this anchor mlen]
if {$here ne {}} { if {$here ne {}} {
$ctext see $here $ctext see $here
$ctext tag remove sel 1.0 end $ctext tag remove sel 1.0 end
$ctext tag add sel $here "$here + $mlen c" $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 _set_marks $this 1
} else { } else {
$w.ent configure -background lightpink #$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 {} { method find_prev {} {
find_next $this -backwards find_next $this -backwards
} }
@ -149,6 +247,7 @@ method find_next {{dir -forwards}} {
set searchdirn $dir set searchdirn $dir
$ctext mark unset anchor $ctext mark unset anchor
if {$searchstring ne {}} { if {$searchstring ne {}} {
_save_search $this
set start [_get_new_anchor $this] set start [_get_new_anchor $this]
if {$dir eq "-forwards"} { if {$dir eq "-forwards"} {
set start "$start + 1c" set start "$start + 1c"

View File

@ -117,7 +117,7 @@ proc read_sshkey_output {fd w} {
} else { } else {
set finfo [find_ssh_key] set finfo [find_ssh_key]
if {$finfo eq {}} { if {$finfo eq {}} {
set sshkey_title [mc "Generation succeded, but no keys found."] set sshkey_title [mc "Generation succeeded, but no keys found."]
$w.contents insert end $sshkey_output $w.contents insert end $sshkey_output
} else { } else {
set sshkey_title [mc "Your key is in: %s" [lindex $finfo 0]] set sshkey_title [mc "Your key is in: %s" [lindex $finfo 0]]

View File

@ -23,10 +23,59 @@ proc InitTheme {} {
ttk::style configure Gold.TFrame -background gold -relief flat ttk::style configure Gold.TFrame -background gold -relief flat
# listboxes should have a theme border so embed in ttk::frame # listboxes should have a theme border so embed in ttk::frame
ttk::style layout SListbox.TFrame { ttk::style layout SListbox.TFrame {
SListbox.Frame.Entry.field -sticky news -border true -children { SListbox.Frame.Entry.field -sticky news -border true -children {
SListbox.Frame.padding -sticky news 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} { proc gold_frame {w args} {
@ -74,6 +123,7 @@ proc paddedlabel {w args} {
# place a themed frame over the surface. # place a themed frame over the surface.
proc Dialog {w args} { proc Dialog {w args} {
eval [linsert $args 0 toplevel $w -class Dialog] eval [linsert $args 0 toplevel $w -class Dialog]
catch {wm attributes $w -type dialog}
pave_toplevel $w pave_toplevel $w
return $w return $w
} }
@ -143,6 +193,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 # 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. # dialogs on Windows and MacOSX or a standard Tk dialog on X11.
proc tchoosefont {w title familyvar sizevar} { proc tchoosefont {w title familyvar sizevar} {

View File

@ -87,8 +87,14 @@ proc tools_exec {fullname} {
return return
} }
} elseif {[is_config_true "guitool.$fullname.confirm"]} { } elseif {[is_config_true "guitool.$fullname.confirm"]} {
if {[ask_popup [mc "Are you sure you want to run %s?" $fullname]] ne {yes}} { if {[is_config_true "guitool.$fullname.needsfile"]} {
return if {[ask_popup [mc "Are you sure you want to run %1\$s on file \"%2\$s\"?" $fullname $current_diff_path]] ne {yes}} {
return
}
} else {
if {[ask_popup [mc "Are you sure you want to run %s?" $fullname]] ne {yes}} {
return
}
} }
} }

View File

@ -124,6 +124,7 @@ proc do_push_anywhere {} {
set w .push_setup set w .push_setup
toplevel $w toplevel $w
catch {wm attributes $w -type dialog}
wm withdraw $w wm withdraw $w
wm geometry $w "+[winfo rootx .]+[winfo rooty .]" wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
pave_toplevel $w pave_toplevel $w