summaryrefslogtreecommitdiff
path: root/gitk-git/gitk
diff options
context:
space:
mode:
Diffstat (limited to 'gitk-git/gitk')
-rwxr-xr-xgitk-git/gitk2029
1 files changed, 1133 insertions, 896 deletions
diff --git a/gitk-git/gitk b/gitk-git/gitk
index 7a087f123d..c02db0194d 100755
--- a/gitk-git/gitk
+++ b/gitk-git/gitk
@@ -7,7 +7,240 @@ exec wish "$0" -- "$@"
# and distributed under the terms of the GNU General Public Licence,
# either version 2, or (at your option) any later version.
-package require Tk
+if {[catch {package require Tcl 8.6-} err]} {
+ catch {wm withdraw .}
+ tk_messageBox \
+ -icon error \
+ -type ok \
+ -title "gitk: fatal error" \
+ -message $err
+ exit 1
+}
+
+set MIN_GIT_VERSION 2.20
+regexp {^git version ([\d.]*\d)} [exec git version] _ git_version
+if {[package vcompare $git_version $MIN_GIT_VERSION] < 0} {
+ set message "The git executable found is too old.
+The minimum required version is $MIN_GIT_VERSION.0.
+The version of git found is $git_version."
+
+ catch {wm withdraw .}
+ tk_messageBox \
+ -icon error \
+ -type ok \
+ -title "gitk: fatal error" \
+ -message $message
+ exit 1
+}
+
+######################################################################
+## Enable Tcl8 profile in Tcl9, allowing consumption of data that has
+## bytes not conforming to the assumed encoding profile.
+
+if {[package vcompare $::tcl_version 9.0] >= 0} {
+ rename open _strict_open
+ proc open args {
+ set f [_strict_open {*}$args]
+ chan configure $f -profile tcl8
+ return $f
+ }
+ proc convertfrom args {
+ return [encoding convertfrom -profile tcl8 {*}$args]
+ }
+} else {
+ proc convertfrom args {
+ return [encoding convertfrom {*}$args]
+ }
+}
+
+######################################################################
+##
+## Enabling platform-specific code paths
+
+proc is_Windows {} {
+ if {$::tcl_platform(platform) eq {windows}} {
+ return 1
+ }
+ return 0
+}
+
+######################################################################
+##
+## PATH lookup
+
+if {[is_Windows]} {
+ set _search_path {}
+ proc _which {what args} {
+ global env _search_path
+
+ if {$_search_path eq {}} {
+ set gitguidir [file dirname [info script]]
+ regsub -all ";" $gitguidir "\\;" gitguidir
+ set env(PATH) "$gitguidir;$env(PATH)"
+ set _search_path [split $env(PATH) {;}]
+ # Skip empty `PATH` elements
+ set _search_path [lsearch -all -inline -not -exact \
+ $_search_path ""]
+ }
+
+ if {[lsearch -exact $args -script] >= 0} {
+ set suffix {}
+ } else {
+ set suffix .exe
+ }
+
+ foreach p $_search_path {
+ set p [file join $p $what$suffix]
+ if {[file exists $p]} {
+ return [file normalize $p]
+ }
+ }
+ return {}
+ }
+
+ proc sanitize_command_line {command_line from_index} {
+ set i $from_index
+ while {$i < [llength $command_line]} {
+ set cmd [lindex $command_line $i]
+ if {[llength [file split $cmd]] < 2} {
+ set fullpath [_which $cmd]
+ if {$fullpath eq ""} {
+ throw {NOT-FOUND} "$cmd not found in PATH"
+ }
+ lset command_line $i $fullpath
+ }
+
+ # handle piped commands, e.g. `exec A | B`
+ for {incr i} {$i < [llength $command_line]} {incr i} {
+ if {[lindex $command_line $i] eq "|"} {
+ incr i
+ break
+ }
+ }
+ }
+ return $command_line
+ }
+
+ # Override `exec` to avoid unsafe PATH lookup
+
+ rename exec real_exec
+
+ proc exec {args} {
+ # skip options
+ for {set i 0} {$i < [llength $args]} {incr i} {
+ set arg [lindex $args $i]
+ if {$arg eq "--"} {
+ incr i
+ break
+ }
+ if {[string range $arg 0 0] ne "-"} {
+ break
+ }
+ }
+ set args [sanitize_command_line $args $i]
+ uplevel 1 real_exec $args
+ }
+
+ # Override `open` to avoid unsafe PATH lookup
+
+ rename open real_open
+
+ proc open {args} {
+ set arg0 [lindex $args 0]
+ if {[string range $arg0 0 0] eq "|"} {
+ set command_line [string trim [string range $arg0 1 end]]
+ lset args 0 "| [sanitize_command_line $command_line 0]"
+ }
+ uplevel 1 real_open $args
+ }
+}
+
+# End of safe PATH lookup stuff
+
+# Wrap exec/open to sanitize arguments
+
+# unsafe arguments begin with redirections or the pipe or background operators
+proc is_arg_unsafe {arg} {
+ regexp {^([<|>&]|2>)} $arg
+}
+
+proc make_arg_safe {arg} {
+ if {[is_arg_unsafe $arg]} {
+ set arg [file join . $arg]
+ }
+ return $arg
+}
+
+proc make_arglist_safe {arglist} {
+ set res {}
+ foreach arg $arglist {
+ lappend res [make_arg_safe $arg]
+ }
+ return $res
+}
+
+# executes one command
+# no redirections or pipelines are possible
+# cmd is a list that specifies the command and its arguments
+# calls `exec` and returns its value
+proc safe_exec {cmd} {
+ eval exec [make_arglist_safe $cmd]
+}
+
+# executes one command with redirections
+# no pipelines are possible
+# cmd is a list that specifies the command and its arguments
+# redir is a list that specifies redirections (output, background, constant(!) commands)
+# calls `exec` and returns its value
+proc safe_exec_redirect {cmd redir} {
+ eval exec [make_arglist_safe $cmd] $redir
+}
+
+proc safe_open_file {filename flags} {
+ # a file name starting with "|" would attempt to run a process
+ # but such a file name must be treated as a relative path
+ # hide the "|" behind "./"
+ if {[string index $filename 0] eq "|"} {
+ set filename [file join . $filename]
+ }
+ open $filename $flags
+}
+
+# opens a command pipeline for reading
+# cmd is a list that specifies the command and its arguments
+# calls `open` and returns the file id
+proc safe_open_command {cmd} {
+ open |[make_arglist_safe $cmd] r
+}
+
+# opens a command pipeline for reading and writing
+# cmd is a list that specifies the command and its arguments
+# calls `open` and returns the file id
+proc safe_open_command_rw {cmd} {
+ open |[make_arglist_safe $cmd] r+
+}
+
+# opens a command pipeline for reading with redirections
+# cmd is a list that specifies the command and its arguments
+# redir is a list that specifies redirections
+# calls `open` and returns the file id
+proc safe_open_command_redirect {cmd redir} {
+ set cmd [make_arglist_safe $cmd]
+ open |[concat $cmd $redir] r
+}
+
+# opens a pipeline with several commands for reading
+# cmds is a list of lists, each of which specifies a command and its arguments
+# calls `open` and returns the file id
+proc safe_open_pipeline {cmds} {
+ set cmd {}
+ foreach subcmd $cmds {
+ set cmd [concat $cmd | [make_arglist_safe $subcmd]]
+ }
+ open $cmd r
+}
+
+# End exec/open wrappers
proc hasworktree {} {
return [expr {[exec git rev-parse --is-bare-repository] == "false" &&
@@ -134,7 +367,7 @@ proc unmerged_files {files} {
set mlist {}
set nr_unmerged 0
if {[catch {
- set fd [open "| git ls-files -u" r]
+ set fd [safe_open_command {git ls-files -u}]
} err]} {
show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
exit 1
@@ -156,7 +389,7 @@ proc unmerged_files {files} {
proc parseviewargs {n arglist} {
global vdatemode vmergeonly vflags vdflags vrevs vfiltered vorigargs env
global vinlinediff
- global worddiff git_version
+ global worddiff
set vdatemode($n) 0
set vmergeonly($n) 0
@@ -207,14 +440,10 @@ proc parseviewargs {n arglist} {
"--color-words*" - "--word-diff=color" {
# These trigger a word diff in the console interface,
# so help the user by enabling our own support
- if {[package vcompare $git_version "1.7.2"] >= 0} {
- set worddiff [mc "Color words"]
- }
+ set worddiff [mc "Color words"]
}
"--word-diff*" {
- if {[package vcompare $git_version "1.7.2"] >= 0} {
- set worddiff [mc "Markup words"]
- }
+ set worddiff [mc "Markup words"]
}
"--stat=*" - "--numstat" - "--shortstat" - "--summary" -
"--check" - "--exit-code" - "--quiet" - "--topo-order" -
@@ -290,20 +519,21 @@ proc parseviewargs {n arglist} {
proc parseviewrevs {view revs} {
global vposids vnegids
+ global hashlength
if {$revs eq {}} {
set revs HEAD
} elseif {[lsearch -exact $revs --all] >= 0} {
lappend revs HEAD
}
- if {[catch {set ids [eval exec git rev-parse $revs]} err]} {
+ if {[catch {set ids [safe_exec [concat git rev-parse $revs]]} err]} {
# we get stdout followed by stderr in $err
# for an unknown rev, git rev-parse echoes it and then errors out
set errlines [split $err "\n"]
set badrev {}
for {set l 0} {$l < [llength $errlines]} {incr l} {
set line [lindex $errlines $l]
- if {!([string length $line] == 40 && [string is xdigit $line])} {
+ if {!([string length $line] == $hashlength && [string is xdigit $line])} {
if {[string match "fatal:*" $line]} {
if {[string match "fatal: ambiguous argument*" $line]
&& $badrev ne {}} {
@@ -353,16 +583,6 @@ proc parseviewrevs {view revs} {
return $ret
}
-# Escapes a list of filter paths to be passed to git log via stdin. Note that
-# paths must not be quoted.
-proc escape_filter_paths {paths} {
- set escaped [list]
- foreach path $paths {
- lappend escaped [string map {\\ \\\\ "\ " "\\\ "} $path]
- }
- return $escaped
-}
-
# Start off a git log process and arrange to read its output
proc start_rev_list {view} {
global startmsecs commitidx viewcomplete curview
@@ -372,7 +592,6 @@ proc start_rev_list {view} {
global viewactive viewinstances vmergeonly
global mainheadid viewmainheadid viewmainheadid_orig
global vcanopt vflags vrevs vorigargs
- global show_notes
set startmsecs [clock clicks -milliseconds]
set commitidx($view) 0
@@ -384,7 +603,7 @@ proc start_rev_list {view} {
set args $viewargs($view)
if {$viewargscmd($view) ne {}} {
if {[catch {
- set str [exec sh -c $viewargscmd($view)]
+ set str [safe_exec [list sh -c $viewargscmd($view)]]
} err]} {
error_popup "[mc "Error executing --argscmd command:"] $err"
return 0
@@ -422,10 +641,9 @@ proc start_rev_list {view} {
}
if {[catch {
- set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
- --parents --boundary $args --stdin \
- "<<[join [concat $revs "--" \
- [escape_filter_paths $files]] "\\n"]"] r]
+ set fd [safe_open_command_redirect [concat git log --no-color -z --pretty=raw --show-notes \
+ --parents --boundary $args --stdin] \
+ [list "<<[join [concat $revs "--" $files] "\n"]"]]
} err]} {
error_popup "[mc "Error executing git log:"] $err"
return 0
@@ -459,9 +677,9 @@ proc stop_instance {inst} {
set pid [pid $fd]
if {$::tcl_platform(platform) eq {windows}} {
- exec taskkill /pid $pid
+ safe_exec [list taskkill /pid $pid]
} else {
- exec kill $pid
+ safe_exec [list kill $pid]
}
}
catch {close $fd}
@@ -519,7 +737,7 @@ proc updatecommits {} {
global mainheadid viewmainheadid viewmainheadid_orig pending_select
global hasworktree
global varcid vposids vnegids vflags vrevs
- global show_notes
+ global hashlength
set hasworktree [hasworktree]
rereadrefs
@@ -553,7 +771,7 @@ proc updatecommits {} {
# take out positive refs that we asked for before or
# that we have already seen
foreach rev $revs {
- if {[string length $rev] == 40} {
+ if {[string length $rev] == $hashlength} {
if {[lsearch -exact $oldpos $rev] < 0
&& ![info exists varcid($view,$rev)]} {
lappend newrevs $rev
@@ -576,11 +794,9 @@ proc updatecommits {} {
set args $vorigargs($view)
}
if {[catch {
- set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
- --parents --boundary $args --stdin \
- "<<[join [concat $revs "--" \
- [escape_filter_paths \
- $vfilelimit($view)]] "\\n"]"] r]
+ set fd [safe_open_command_redirect [concat git log --no-color -z --pretty=raw --show-notes \
+ --parents --boundary $args --stdin] \
+ [list "<<[join [concat $revs "--" $vfilelimit($view)] "\n"]"]]
} err]} {
error_popup "[mc "Error executing git log:"] $err"
return
@@ -1438,6 +1654,7 @@ proc getcommitlines {fd inst view updating} {
global parents children curview hlview
global idpending ordertok
global varccommits varcid varctok vtokmod vfilelimit vshortids
+ global hashlength
set stuff [read $fd 500000]
# git log doesn't terminate the last commit with a null...
@@ -1520,7 +1737,7 @@ proc getcommitlines {fd inst view updating} {
}
set ok 1
foreach id $ids {
- if {[string length $id] != 40} {
+ if {[string length $id] != $hashlength} {
set ok 0
break
}
@@ -1547,8 +1764,8 @@ proc getcommitlines {fd inst view updating} {
# and if we already know about it, using the rewritten
# parent as a substitute parent for $id's children.
if {![catch {
- set rwid [exec git rev-list --first-parent --max-count=1 \
- $id -- $vfilelimit($view)]
+ set rwid [safe_exec [list git rev-list --first-parent --max-count=1 \
+ $id -- $vfilelimit($view)]]
}]} {
if {$rwid ne {} && [info exists varcid($view,$rwid)]} {
# use $rwid in place of $id
@@ -1668,7 +1885,7 @@ proc do_readcommit {id} {
global tclencoding
# Invoke git-log to handle automatic encoding conversion
- set fd [open [concat | git log --no-color --pretty=raw -1 $id] r]
+ set fd [safe_open_command [concat git log --no-color --pretty=raw -1 $id]]
# Read the results using i18n.logoutputencoding
fconfigure $fd -translation lf -eofchar {}
if {$tclencoding != {}} {
@@ -1766,8 +1983,8 @@ proc getcommit {id} {
return 1
}
-# Expand an abbreviated commit ID to a list of full 40-char IDs that match
-# and are present in the current view.
+# Expand an abbreviated commit ID to a list of full 40-char (or 64-char
+# for SHA256 repo) IDs that match and are present in the current view.
# This is fairly slow...
proc longid {prefix} {
global varcid curview vshortids
@@ -1795,23 +2012,24 @@ proc longid {prefix} {
}
proc readrefs {} {
- global tagids idtags headids idheads tagobjid
+ global tagids idtags headids idheads tagobjid upstreamofref
global otherrefids idotherrefs mainhead mainheadid
global selecthead selectheadid
global hideremotes
global tclencoding
+ global hashlength
- foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
+ foreach v {tagids idtags headids idheads otherrefids idotherrefs upstreamofref} {
unset -nocomplain $v
}
- set refd [open [list | git show-ref -d] r]
+ set refd [safe_open_command [list git show-ref -d]]
if {$tclencoding != {}} {
fconfigure $refd -encoding $tclencoding
}
while {[gets $refd line] >= 0} {
- if {[string index $line 40] ne " "} continue
- set id [string range $line 0 39]
- set ref [string range $line 41 end]
+ if {[string index $line $hashlength] ne " "} continue
+ set id [string range $line 0 [expr {$hashlength - 1}]]
+ set ref [string range $line [expr {$hashlength + 1}] end]
if {![string match "refs/*" $ref]} continue
set name [string range $ref 5 end]
if {[string match "remotes/*" $name]} {
@@ -1835,8 +2053,10 @@ proc readrefs {} {
set tagids($name) $id
lappend idtags($id) $name
} else {
- set otherrefids($name) $id
- lappend idotherrefs($id) $name
+ if [is_other_ref_visible $name] {
+ set otherrefids($name) $id
+ lappend idotherrefs($id) $name
+ }
}
}
catch {close $refd}
@@ -1852,9 +2072,20 @@ proc readrefs {} {
set selectheadid {}
if {$selecthead ne {}} {
catch {
- set selectheadid [exec git rev-parse --verify $selecthead]
+ set selectheadid [safe_exec [list git rev-parse --verify $selecthead]]
+ }
+ }
+ #load the local_branch->upstream mapping
+ # the result of the for-each-ref command produces: local_branch NUL upstream
+ set refd [safe_open_command [list git for-each-ref {--format=%(refname:short)%00%(upstream)} refs/heads/]]
+ while {[gets $refd local_tracking] >= 0} {
+ set line [split $local_tracking \0]
+ if {[lindex $line 1] ne {}} {
+ set upstream_ref [string map {"refs/" ""} [lindex $line 1]]
+ set upstreamofref([lindex $line 0]) $upstream_ref
}
}
+ catch {close $refd}
}
# skip over fake commits
@@ -1895,23 +2126,12 @@ proc removehead {id name} {
}
proc ttk_toplevel {w args} {
- global use_ttk
eval [linsert $args 0 ::toplevel $w]
- if {$use_ttk} {
- place [ttk::frame $w._toplevel_background] -x 0 -y 0 -relwidth 1 -relheight 1
- }
+ place [ttk::frame $w._toplevel_background] -x 0 -y 0 -relwidth 1 -relheight 1
return $w
}
proc make_transient {window origin} {
- global have_tk85
-
- # In MacOS Tk 8.4 transient appears to work by setting
- # overrideredirect, which is utterly useless, since the
- # windows get no border, and are not even kept above
- # the parent.
- if {!$have_tk85 && [tk windowingsystem] eq {aqua}} return
-
wm transient $window $origin
# Windows fails to place transient windows normally, so
@@ -1922,12 +2142,10 @@ proc make_transient {window origin} {
}
proc show_error {w top msg} {
- global NS
- if {![info exists NS]} {set NS ""}
if {[wm state $top] eq "withdrawn"} { wm deiconify $top }
message $w.m -text $msg -justify center -aspect 400
pack $w.m -side top -fill x -padx 20 -pady 20
- ${NS}::button $w.ok -default active -text [mc OK] -command "destroy $top"
+ ttk::button $w.ok -default active -text [mc OK] -command "destroy $top"
pack $w.ok -side bottom -fill x
bind $top <Visibility> "grab $top; focus $top"
bind $top <Key-Return> "destroy $top"
@@ -1949,16 +2167,16 @@ proc error_popup {msg {owner .}} {
}
proc confirm_popup {msg {owner .}} {
- global confirm_ok NS
+ global confirm_ok
set confirm_ok 0
set w .confirm
ttk_toplevel $w
make_transient $w $owner
message $w.m -text $msg -justify center -aspect 400
pack $w.m -side top -fill x -padx 20 -pady 20
- ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
+ ttk::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
pack $w.ok -side left -fill x
- ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
+ ttk::button $w.cancel -text [mc Cancel] -command "destroy $w"
pack $w.cancel -side right -fill x
bind $w <Visibility> "grab $w; focus $w"
bind $w <Key-Return> "set confirm_ok 1; destroy $w"
@@ -1969,9 +2187,11 @@ proc confirm_popup {msg {owner .}} {
return $confirm_ok
}
-proc setoptions {} {
- global use_ttk
+proc haveselectionclipboard {} {
+ return [expr {[tk windowingsystem] eq "x11"}]
+}
+proc setoptions {} {
if {[tk windowingsystem] ne "win32"} {
option add *Panedwindow.showHandle 1 startupFile
option add *Panedwindow.sashRelief raised startupFile
@@ -1995,6 +2215,7 @@ proc setoptions {} {
}
proc setttkstyle {} {
+ global theme
eval font configure TkDefaultFont [fontflags mainfont]
eval font configure TkTextFont [fontflags textfont]
eval font configure TkHeadingFont [fontflags mainfont]
@@ -2004,6 +2225,10 @@ proc setttkstyle {} {
eval font configure TkIconFont [fontflags uifont]
eval font configure TkMenuFont [fontflags uifont]
eval font configure TkSmallCaptionFont [fontflags uifont]
+
+ if {[catch {ttk::style theme use $theme} err]} {
+ set theme [ttk::style theme use]
+ }
}
# Make a menu and submenus.
@@ -2064,23 +2289,86 @@ proc cleardropsel {w} {
$w selection clear
}
proc makedroplist {w varname args} {
- global use_ttk
- if {$use_ttk} {
- set width 0
- foreach label $args {
- set cx [string length $label]
- if {$cx > $width} {set width $cx}
- }
- set gm [ttk::combobox $w -width $width -state readonly\
- -textvariable $varname -values $args \
- -exportselection false]
- bind $gm <<ComboboxSelected>> [list $gm selection clear]
- } else {
- set gm [eval [linsert $args 0 tk_optionMenu $w $varname]]
- }
+ set width 0
+ foreach label $args {
+ set cx [string length $label]
+ if {$cx > $width} {set width $cx}
+ }
+ set gm [ttk::combobox $w -width $width -state readonly\
+ -textvariable $varname -values $args \
+ -exportselection false]
+ bind $gm <<ComboboxSelected>> [list $gm selection clear]
return $gm
}
+proc scrollval {D {koff 0}} {
+ global kscroll scroll_D0
+ return [expr int(-($D / $scroll_D0) * max(1, $kscroll-$koff))]
+}
+
+proc precisescrollval {D {koff 0}} {
+ global kscroll
+ return [expr (-($D / 10.0) * max(1, $kscroll-$koff))]
+}
+
+proc bind_mousewheel {} {
+ global canv cflist ctext
+ bindall <MouseWheel> {allcanvs yview scroll [scrollval %D] units}
+ bindall <Shift-MouseWheel> break
+ bind $ctext <MouseWheel> {$ctext yview scroll [scrollval %D 2] units}
+ bind $ctext <Shift-MouseWheel> {$ctext xview scroll [scrollval %D 2] units}
+ bind $cflist <MouseWheel> {$cflist yview scroll [scrollval %D 2] units}
+ bind $cflist <Shift-MouseWheel> break
+ bind $canv <Shift-MouseWheel> {$canv xview scroll [scrollval %D] units}
+
+ if {[package vcompare $::tcl_version 8.7] >= 0} {
+ bindall <Alt-MouseWheel> {allcanvs yview scroll [scrollval 5*%D] units}
+ bindall <Alt-Shift-MouseWheel> break
+ bind $ctext <Alt-MouseWheel> {$ctext yview scroll [scrollval 5*%D 2] units}
+ bind $ctext <Alt-Shift-MouseWheel> {$ctext xview scroll [scrollval 5*%D 2] units}
+ bind $cflist <Alt-MouseWheel> {$cflist yview scroll [scrollval 5*%D 2] units}
+ bind $cflist <Alt-Shift-MouseWheel> break
+ bind $canv <Alt-Shift-MouseWheel> {$canv xview scroll [scrollval 5*%D] units}
+
+ bindall <TouchpadScroll> {
+ lassign [tk::PreciseScrollDeltas %D] deltaX deltaY
+ allcanvs yview scroll [precisescrollval $deltaY] units
+ }
+ bind $ctext <TouchpadScroll> {
+ lassign [tk::PreciseScrollDeltas %D] deltaX deltaY
+ $ctext yview scroll [precisescrollval $deltaY 2] units
+ $ctext xview scroll [precisescrollval $deltaX 2] units
+ }
+ bind $cflist <TouchpadScroll> {
+ lassign [tk::PreciseScrollDeltas %D] deltaX deltaY
+ $cflist yview scroll [precisescrollval $deltaY 2] units
+ }
+ bind $canv <TouchpadScroll> {
+ lassign [tk::PreciseScrollDeltas %D] deltaX deltaY
+ $canv xview scroll [precisescrollval $deltaX] units
+ allcanvs yview scroll [precisescrollval $deltaY] units
+ }
+ }
+}
+
+proc bind_mousewheel_buttons {} {
+ global canv cflist ctext
+ bindall <ButtonRelease-4> {allcanvs yview scroll [scrollval 1] units}
+ bindall <ButtonRelease-5> {allcanvs yview scroll [scrollval -1] units}
+ bindall <Shift-ButtonRelease-4> break
+ bindall <Shift-ButtonRelease-5> break
+ bind $ctext <ButtonRelease-4> {$ctext yview scroll [scrollval 1 2] units}
+ bind $ctext <ButtonRelease-5> {$ctext yview scroll [scrollval -1 2] units}
+ bind $ctext <Shift-ButtonRelease-4> {$ctext xview scroll [scrollval 1 2] units}
+ bind $ctext <Shift-ButtonRelease-5> {$ctext xview scroll [scrollval -1 2] units}
+ bind $cflist <ButtonRelease-4> {$cflist yview scroll [scrollval 1 2] units}
+ bind $cflist <ButtonRelease-5> {$cflist yview scroll [scrollval -1 2] units}
+ bind $cflist <Shift-ButtonRelease-4> break
+ bind $cflist <Shift-ButtonRelease-5> break
+ bind $canv <Shift-ButtonRelease-4> {$canv xview scroll [scrollval 1] units}
+ bind $canv <Shift-ButtonRelease-5> {$canv xview scroll [scrollval -1] units}
+}
+
proc makewindow {} {
global canv canv2 canv3 linespc charspc ctext cflist cscroll
global tabstop
@@ -2089,19 +2377,17 @@ proc makewindow {} {
global diffcontextstring diffcontext
global ignorespace
global maincursor textcursor curtextcursor
- global rowctxmenu fakerowmenu mergemax wrapcomment
+ global rowctxmenu fakerowmenu mergemax wrapcomment wrapdefault
global highlight_files gdttype
global searchstring sstring
global bgcolor fgcolor bglist fglist diffcolors diffbgcolors selectbgcolor
- global uifgcolor uifgdisabledcolor
global filesepbgcolor filesepfgcolor
global mergecolors foundbgcolor currentsearchhitbgcolor
global headctxmenu progresscanv progressitem progresscoords statusw
global fprogitem fprogcoord lastprogupdate progupdatepending
global rprogitem rprogcoord rownumsel numcommits
- global have_tk85 use_ttk NS
- global git_version
global worddiff
+ global hashlength scroll_D0
# The "mc" arguments here are purely so that xgettext
# sees the following string as needing to be translated
@@ -2112,7 +2398,7 @@ proc makewindow {} {
{mc "Reread re&ferences" command rereadrefs}
{mc "&List references" command showrefs -accelerator F2}
{xx "" separator}
- {mc "Start git &gui" command {exec git gui &}}
+ {mc "Start git &gui" command {safe_exec_redirect [list git gui] [list &]}}
{xx "" separator}
{mc "&Quit" command doquit -accelerator Meta1-Q}
}}
@@ -2153,13 +2439,11 @@ proc makewindow {} {
makemenu .bar $bar
. configure -menu .bar
- if {$use_ttk} {
- # cover the non-themed toplevel with a themed frame.
- place [ttk::frame ._main_background] -x 0 -y 0 -relwidth 1 -relheight 1
- }
+ # cover the non-themed toplevel with a themed frame.
+ place [ttk::frame ._main_background] -x 0 -y 0 -relwidth 1 -relheight 1
# the gui has upper and lower half, parts of a paned window.
- ${NS}::panedwindow .ctop -orient vertical
+ ttk::panedwindow .ctop -orient vertical
# possibly use assumed geometry
if {![info exists geometry(pwsash0)]} {
@@ -2172,12 +2456,9 @@ proc makewindow {} {
}
# the upper half will have a paned window, a scroll bar to the right, and some stuff below
- ${NS}::frame .tf -height $geometry(topheight) -width $geometry(topwidth)
- ${NS}::frame .tf.histframe
- ${NS}::panedwindow .tf.histframe.pwclist -orient horizontal
- if {!$use_ttk} {
- .tf.histframe.pwclist configure -sashpad 0 -handlesize 4
- }
+ ttk::frame .tf -height $geometry(topheight) -width $geometry(topwidth)
+ ttk::frame .tf.histframe
+ ttk::panedwindow .tf.histframe.pwclist -orient horizontal
# create three canvases
set cscroll .tf.histframe.csb
@@ -2185,6 +2466,7 @@ proc makewindow {} {
canvas $canv \
-selectbackground $selectbgcolor \
-background $bgcolor -bd 0 \
+ -xscrollincr $linespc \
-yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
.tf.histframe.pwclist add $canv
set canv2 .tf.histframe.pwclist.canv2
@@ -2197,105 +2479,57 @@ proc makewindow {} {
-selectbackground $selectbgcolor \
-background $bgcolor -bd 0 -yscrollincr $linespc
.tf.histframe.pwclist add $canv3
- if {$use_ttk} {
- bind .tf.histframe.pwclist <Map> {
- bind %W <Map> {}
- .tf.histframe.pwclist sashpos 1 [lindex $::geometry(pwsash1) 0]
- .tf.histframe.pwclist sashpos 0 [lindex $::geometry(pwsash0) 0]
- }
- } else {
- eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
- eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
+ bind .tf.histframe.pwclist <Map> {
+ bind %W <Map> {}
+ .tf.histframe.pwclist sashpos 1 [lindex $::geometry(pwsash1) 0]
+ .tf.histframe.pwclist sashpos 0 [lindex $::geometry(pwsash0) 0]
}
# a scroll bar to rule them
- ${NS}::scrollbar $cscroll -command {allcanvs yview}
- if {!$use_ttk} {$cscroll configure -highlightthickness 0}
+ ttk::scrollbar $cscroll -command {allcanvs yview}
pack $cscroll -side right -fill y
bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
lappend bglist $canv $canv2 $canv3
pack .tf.histframe.pwclist -fill both -expand 1 -side left
# we have two button bars at bottom of top frame. Bar 1
- ${NS}::frame .tf.bar
- ${NS}::frame .tf.lbar -height 15
+ ttk::frame .tf.bar
+ ttk::frame .tf.lbar -height 15
set sha1entry .tf.bar.sha1
set entries $sha1entry
set sha1but .tf.bar.sha1label
- button $sha1but -text "[mc "SHA1 ID:"] " -state disabled -relief flat \
+ ttk::button $sha1but -text "[mc "Commit ID:"] " -state disabled \
-command gotocommit -width 8
- $sha1but conf -disabledforeground [$sha1but cget -foreground]
pack .tf.bar.sha1label -side left
- ${NS}::entry $sha1entry -width 40 -font textfont -textvariable sha1string
+ ttk::entry $sha1entry -width $hashlength -font textfont -textvariable sha1string
trace add variable sha1string write sha1change
pack $sha1entry -side left -pady 2
- set bm_left_data {
- #define left_width 16
- #define left_height 16
- static unsigned char left_bits[] = {
- 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
- 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
- 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
- }
- set bm_right_data {
- #define right_width 16
- #define right_height 16
- static unsigned char right_bits[] = {
- 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
- 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
- 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
- }
- image create bitmap bm-left -data $bm_left_data -foreground $uifgcolor
- image create bitmap bm-left-gray -data $bm_left_data -foreground $uifgdisabledcolor
- image create bitmap bm-right -data $bm_right_data -foreground $uifgcolor
- image create bitmap bm-right-gray -data $bm_right_data -foreground $uifgdisabledcolor
-
- ${NS}::button .tf.bar.leftbut -command goback -state disabled -width 26
- if {$use_ttk} {
- .tf.bar.leftbut configure -image [list bm-left disabled bm-left-gray]
- } else {
- .tf.bar.leftbut configure -image bm-left
- }
+ ttk::button .tf.bar.leftbut -command goback -state disabled
+ .tf.bar.leftbut configure -text \u2190 -width 3
pack .tf.bar.leftbut -side left -fill y
- ${NS}::button .tf.bar.rightbut -command goforw -state disabled -width 26
- if {$use_ttk} {
- .tf.bar.rightbut configure -image [list bm-right disabled bm-right-gray]
- } else {
- .tf.bar.rightbut configure -image bm-right
- }
+ ttk::button .tf.bar.rightbut -command goforw -state disabled
+ .tf.bar.rightbut configure -text \u2192 -width 3
pack .tf.bar.rightbut -side left -fill y
- ${NS}::label .tf.bar.rowlabel -text [mc "Row"]
+ ttk::label .tf.bar.rowlabel -text [mc "Row"]
set rownumsel {}
- ${NS}::label .tf.bar.rownum -width 7 -textvariable rownumsel \
+ ttk::label .tf.bar.rownum -width 7 -textvariable rownumsel \
-relief sunken -anchor e
- ${NS}::label .tf.bar.rowlabel2 -text "/"
- ${NS}::label .tf.bar.numcommits -width 7 -textvariable numcommits \
+ ttk::label .tf.bar.rowlabel2 -text "/"
+ ttk::label .tf.bar.numcommits -width 7 -textvariable numcommits \
-relief sunken -anchor e
pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
-side left
- if {!$use_ttk} {
- foreach w {rownum numcommits} {.tf.bar.$w configure -font textfont}
- }
global selectedline
trace add variable selectedline write selectedline_change
# Status label and progress bar
set statusw .tf.bar.status
- ${NS}::label $statusw -width 15 -relief sunken
+ ttk::label $statusw -width 15 -relief sunken
pack $statusw -side left -padx 5
- if {$use_ttk} {
- set progresscanv [ttk::progressbar .tf.bar.progress]
- } else {
- set h [expr {[font metrics uifont -linespace] + 2}]
- set progresscanv .tf.bar.progress
- canvas $progresscanv -relief sunken -height $h -borderwidth 2
- set progressitem [$progresscanv create rect -1 0 0 $h -fill "#00ff00"]
- set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
- set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
- }
+ set progresscanv [ttk::progressbar .tf.bar.progress]
pack $progresscanv -side right -expand 1 -fill x -padx {0 2}
set progresscoords {0 0}
set fprogcoord 0
@@ -2305,35 +2539,12 @@ proc makewindow {} {
set progupdatepending 0
# build up the bottom bar of upper window
- ${NS}::label .tf.lbar.flabel -text "[mc "Find"] "
-
- set bm_down_data {
- #define down_width 16
- #define down_height 16
- static unsigned char down_bits[] = {
- 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
- 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
- 0x87, 0xe1, 0x8e, 0x71, 0x9c, 0x39, 0xb8, 0x1d,
- 0xf0, 0x0f, 0xe0, 0x07, 0xc0, 0x03, 0x80, 0x01};
- }
- image create bitmap bm-down -data $bm_down_data -foreground $uifgcolor
- ${NS}::button .tf.lbar.fnext -width 26 -command {dofind 1 1}
- .tf.lbar.fnext configure -image bm-down
-
- set bm_up_data {
- #define up_width 16
- #define up_height 16
- static unsigned char up_bits[] = {
- 0x80, 0x01, 0xc0, 0x03, 0xe0, 0x07, 0xf0, 0x0f,
- 0xb8, 0x1d, 0x9c, 0x39, 0x8e, 0x71, 0x87, 0xe1,
- 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
- 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01};
- }
- image create bitmap bm-up -data $bm_up_data -foreground $uifgcolor
- ${NS}::button .tf.lbar.fprev -width 26 -command {dofind -1 1}
- .tf.lbar.fprev configure -image bm-up
-
- ${NS}::label .tf.lbar.flab2 -text " [mc "commit"] "
+ ttk::label .tf.lbar.flabel -text "[mc "Find"] "
+
+ ttk::button .tf.lbar.fnext -command {dofind 1 1} -text \u2193 -width 3
+ ttk::button .tf.lbar.fprev -command {dofind -1 1} -text \u2191 -width 3
+
+ ttk::label .tf.lbar.flab2 -text " [mc "commit"] "
pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
-side left -fill y
@@ -2349,7 +2560,7 @@ proc makewindow {} {
set findstring {}
set fstring .tf.lbar.findstring
lappend entries $fstring
- ${NS}::entry $fstring -width 30 -textvariable findstring
+ ttk::entry $fstring -width 30 -textvariable findstring
trace add variable findstring write find_change
set findtype [mc "Exact"]
set findtypemenu [makedroplist .tf.lbar.findtype \
@@ -2368,47 +2579,43 @@ proc makewindow {} {
pack .tf.bar -in .tf -side bottom -fill x
pack .tf.histframe -fill both -side top -expand 1
.ctop add .tf
- if {!$use_ttk} {
- .ctop paneconfigure .tf -height $geometry(topheight)
- .ctop paneconfigure .tf -width $geometry(topwidth)
- }
# now build up the bottom
- ${NS}::panedwindow .pwbottom -orient horizontal
+ ttk::panedwindow .pwbottom -orient horizontal
# lower left, a text box over search bar, scroll bar to the right
# if we know window height, then that will set the lower text height, otherwise
# we set lower text height which will drive window height
if {[info exists geometry(main)]} {
- ${NS}::frame .bleft -width $geometry(botwidth)
+ ttk::frame .bleft -width $geometry(botwidth)
} else {
- ${NS}::frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
+ ttk::frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
}
- ${NS}::frame .bleft.top
- ${NS}::frame .bleft.mid
- ${NS}::frame .bleft.bottom
+ ttk::frame .bleft.top
+ ttk::frame .bleft.mid
+ ttk::frame .bleft.bottom
# gap between sub-widgets
set wgap [font measure uifont "i"]
- ${NS}::button .bleft.top.search -text [mc "Search"] -command dosearch
+ ttk::button .bleft.top.search -text [mc "Search"] -command dosearch
pack .bleft.top.search -side left -padx 5
set sstring .bleft.top.sstring
set searchstring ""
- ${NS}::entry $sstring -width 20 -textvariable searchstring
+ ttk::entry $sstring -width 20 -textvariable searchstring
lappend entries $sstring
trace add variable searchstring write incrsearch
pack $sstring -side left -expand 1 -fill x
- ${NS}::radiobutton .bleft.mid.diff -text [mc "Diff"] \
+ ttk::radiobutton .bleft.mid.diff -text [mc "Diff"] \
-command changediffdisp -variable diffelide -value {0 0}
- ${NS}::radiobutton .bleft.mid.old -text [mc "Old version"] \
+ ttk::radiobutton .bleft.mid.old -text [mc "Old version"] \
-command changediffdisp -variable diffelide -value {0 1}
- ${NS}::radiobutton .bleft.mid.new -text [mc "New version"] \
+ ttk::radiobutton .bleft.mid.new -text [mc "New version"] \
-command changediffdisp -variable diffelide -value {1 0}
- ${NS}::label .bleft.mid.labeldiffcontext -text " [mc "Lines of context"]: "
+ ttk::label .bleft.mid.labeldiffcontext -text " [mc "Lines of context"]: "
pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left -ipadx $wgap
- spinbox .bleft.mid.diffcontext -width 5 \
+ ttk::spinbox .bleft.mid.diffcontext -width 5 \
-from 0 -increment 1 -to 10000000 \
-validate all -validatecommand "diffcontextvalidate %P" \
-textvariable diffcontextstring
@@ -2416,28 +2623,24 @@ proc makewindow {} {
trace add variable diffcontextstring write diffcontextchange
lappend entries .bleft.mid.diffcontext
pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left -ipadx $wgap
- ${NS}::checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
+ ttk::checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
-command changeignorespace -variable ignorespace
pack .bleft.mid.ignspace -side left -padx 5
set worddiff [mc "Line diff"]
- if {[package vcompare $git_version "1.7.2"] >= 0} {
- makedroplist .bleft.mid.worddiff worddiff [mc "Line diff"] \
- [mc "Markup words"] [mc "Color words"]
- trace add variable worddiff write changeworddiff
- pack .bleft.mid.worddiff -side left -padx 5
- }
+ makedroplist .bleft.mid.worddiff worddiff [mc "Line diff"] \
+ [mc "Markup words"] [mc "Color words"]
+ trace add variable worddiff write changeworddiff
+ pack .bleft.mid.worddiff -side left -padx 5
set ctext .bleft.bottom.ctext
text $ctext -background $bgcolor -foreground $fgcolor \
-state disabled -undo 0 -font textfont \
- -yscrollcommand scrolltext -wrap none \
+ -yscrollcommand scrolltext -wrap $wrapdefault \
-xscrollcommand ".bleft.bottom.sbhorizontal set"
- if {$have_tk85} {
- $ctext conf -tabstyle wordprocessor
- }
- ${NS}::scrollbar .bleft.bottom.sb -command "$ctext yview"
- ${NS}::scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h
+ $ctext conf -tabstyle wordprocessor
+ ttk::scrollbar .bleft.bottom.sb -command "$ctext yview"
+ ttk::scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h
pack .bleft.top -side top -fill x
pack .bleft.mid -side top -fill x
grid $ctext .bleft.bottom.sb -sticky nsew
@@ -2488,16 +2691,13 @@ proc makewindow {} {
$ctext tag lower d0
.pwbottom add .bleft
- if {!$use_ttk} {
- .pwbottom paneconfigure .bleft -width $geometry(botwidth)
- }
# lower right
- ${NS}::frame .bright
- ${NS}::frame .bright.mode
- ${NS}::radiobutton .bright.mode.patch -text [mc "Patch"] \
+ ttk::frame .bright
+ ttk::frame .bright.mode
+ ttk::radiobutton .bright.mode.patch -text [mc "Patch"] \
-command reselectline -variable cmitmode -value "patch"
- ${NS}::radiobutton .bright.mode.tree -text [mc "Tree"] \
+ ttk::radiobutton .bright.mode.tree -text [mc "Tree"] \
-command reselectline -variable cmitmode -value "tree"
grid .bright.mode.patch .bright.mode.tree -sticky ew
pack .bright.mode -side top -fill x
@@ -2513,7 +2713,7 @@ proc makewindow {} {
-spacing1 1 -spacing3 1
lappend bglist $cflist
lappend fglist $cflist
- ${NS}::scrollbar .bright.sb -command "$cflist yview"
+ ttk::scrollbar .bright.sb -command "$cflist yview"
pack .bright.sb -side right -fill y
pack $cflist -side left -fill both -expand 1
$cflist tag configure highlight \
@@ -2548,44 +2748,31 @@ proc makewindow {} {
set ::BM "2"
}
- if {$use_ttk} {
- bind .ctop <Map> {
- bind %W <Map> {}
- %W sashpos 0 $::geometry(topheight)
- }
- bind .pwbottom <Map> {
- bind %W <Map> {}
- %W sashpos 0 $::geometry(botwidth)
- }
- bind .pwbottom <Configure> {resizecdetpanes %W %w}
+ bind .ctop <Map> {
+ bind %W <Map> {}
+ %W sashpos 0 $::geometry(topheight)
}
+ bind .pwbottom <Map> {
+ bind %W <Map> {}
+ %W sashpos 0 $::geometry(botwidth)
+ }
+ bind .pwbottom <Configure> {resizecdetpanes %W %w}
pack .ctop -fill both -expand 1
bindall <1> {selcanvline %W %x %y}
- #bindall <B1-Motion> {selcanvline %W %x %y}
- if {[tk windowingsystem] == "win32"} {
- bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
- bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
+
+ #Mouse / touchpad scrolling
+ if {[tk windowingsystem] == "win32" || [package vcompare $::tcl_version 8.7] >= 0} {
+ set scroll_D0 120
+ bind_mousewheel
+ } elseif {[tk windowingsystem] == "x11"} {
+ set scroll_D0 1
+ bind_mousewheel_buttons
+ } elseif {[tk windowingsystem] == "aqua"} {
+ set scroll_D0 1
+ bind_mousewheel
} else {
- bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
- bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
- bind $ctext <Button> {
- if {"%b" eq 6} {
- $ctext xview scroll -5 units
- } elseif {"%b" eq 7} {
- $ctext xview scroll 5 units
- }
- }
- if {[tk windowingsystem] eq "aqua"} {
- bindall <MouseWheel> {
- set delta [expr {- (%D)}]
- allcanvs yview scroll $delta units
- }
- bindall <Shift-MouseWheel> {
- set delta [expr {- (%D)}]
- $canv xview scroll $delta units
- }
- }
+ puts stderr [mc "Unknown windowing system, cannot bind mouse"]
}
bindall <$::BM> "canvscan mark %W %x %y"
bindall <B$::BM-Motion> "canvscan dragto %W %x %y"
@@ -2597,8 +2784,8 @@ proc makewindow {} {
bind . <Key-Down> "selnextline 1"
bind . <Shift-Key-Up> "dofind -1 0"
bind . <Shift-Key-Down> "dofind 1 0"
- bindkey <Key-Right> "goforw"
- bindkey <Key-Left> "goback"
+ bindkey <<NextChar>> "goforw"
+ bindkey <<PrevChar>> "goback"
bind . <Key-Prior> "selnextpage -1"
bind . <Key-Next> "selnextpage 1"
bind . <$M1B-Home> "allcanvs yview moveto 0.0"
@@ -2725,24 +2912,6 @@ proc makewindow {} {
$diff_menu configure -tearoff 0
}
-# Windows sends all mouse wheel events to the current focused window, not
-# the one where the mouse hovers, so bind those events here and redirect
-# to the correct window
-proc windows_mousewheel_redirector {W X Y D} {
- global canv canv2 canv3
- set w [winfo containing -displayof $W $X $Y]
- if {$w ne ""} {
- set u [expr {$D < 0 ? 5 : -5}]
- if {$w == $canv || $w == $canv2 || $w == $canv3} {
- allcanvs yview scroll $u units
- } else {
- catch {
- $w yview scroll $u units
- }
- }
- }
-}
-
# Update row number label when selectedline changes
proc selectedline_change {n1 n2 op} {
global selectedline rownumsel
@@ -2805,30 +2974,10 @@ proc click {w} {
# Adjust the progress bar for a change in requested extent or canvas size
proc adjustprogress {} {
- global progresscanv progressitem progresscoords
- global fprogitem fprogcoord lastprogupdate progupdatepending
- global rprogitem rprogcoord use_ttk
+ global progresscanv
+ global fprogcoord
- if {$use_ttk} {
- $progresscanv configure -value [expr {int($fprogcoord * 100)}]
- return
- }
-
- set w [expr {[winfo width $progresscanv] - 4}]
- set x0 [expr {$w * [lindex $progresscoords 0]}]
- set x1 [expr {$w * [lindex $progresscoords 1]}]
- set h [winfo height $progresscanv]
- $progresscanv coords $progressitem $x0 0 $x1 $h
- $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
- $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
- set now [clock clicks -milliseconds]
- if {$now >= $lastprogupdate + 100} {
- set progupdatepending 0
- update
- } elseif {!$progupdatepending} {
- set progupdatepending 1
- after [expr {$lastprogupdate + 100 - $now}] doprogupdate
- }
+ $progresscanv configure -value [expr {int($fprogcoord * 100)}]
}
proc doprogupdate {} {
@@ -2887,14 +3036,13 @@ proc savestuff {w} {
upvar #0 viewargscmd current_viewargscmd
upvar #0 viewperm current_viewperm
upvar #0 nextviewnum current_nextviewnum
- upvar #0 use_ttk current_use_ttk
if {$stuffsaved} return
if {![winfo viewable .]} return
set remove_tmp 0
if {[catch {
set try_count 0
- while {[catch {set f [open $config_file_tmp {WRONLY CREAT EXCL}]}]} {
+ while {[catch {set f [safe_open_file $config_file_tmp {WRONLY CREAT EXCL}]}]} {
if {[incr try_count] > 50} {
error "Unable to write config file: $config_file_tmp exists"
}
@@ -2921,13 +3069,8 @@ proc savestuff {w} {
puts $f "set geometry(state) [wm state .]"
puts $f "set geometry(topwidth) [winfo width .tf]"
puts $f "set geometry(topheight) [winfo height .tf]"
- if {$current_use_ttk} {
- puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sashpos 0] 1\""
- puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sashpos 1] 1\""
- } else {
- puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
- puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
- }
+ puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sashpos 0] 1\""
+ puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sashpos 1] 1\""
puts $f "set geometry(botwidth) [winfo width .bleft]"
puts $f "set geometry(botheight) [winfo height .bleft]"
@@ -2973,17 +3116,14 @@ proc savestuff {w} {
}
proc resizeclistpanes {win w} {
- global oldwidth oldsash use_ttk
+ global oldwidth oldsash
if {[info exists oldwidth($win)]} {
if {[info exists oldsash($win)]} {
set s0 [lindex $oldsash($win) 0]
set s1 [lindex $oldsash($win) 1]
- } elseif {$use_ttk} {
+ } else {
set s0 [$win sashpos 0]
set s1 [$win sashpos 1]
- } else {
- set s0 [$win sash coord 0]
- set s1 [$win sash coord 1]
}
if {$w < 60} {
set sash0 [expr {int($w/2 - 2)}]
@@ -3005,29 +3145,20 @@ proc resizeclistpanes {win w} {
}
}
}
- if {$use_ttk} {
- $win sashpos 0 $sash0
- $win sashpos 1 $sash1
- } else {
- $win sash place 0 $sash0 [lindex $s0 1]
- $win sash place 1 $sash1 [lindex $s1 1]
- set sash0 [list $sash0 [lindex $s0 1]]
- set sash1 [list $sash1 [lindex $s1 1]]
- }
+ $win sashpos 0 $sash0
+ $win sashpos 1 $sash1
set oldsash($win) [list $sash0 $sash1]
}
set oldwidth($win) $w
}
proc resizecdetpanes {win w} {
- global oldwidth oldsash use_ttk
+ global oldwidth oldsash
if {[info exists oldwidth($win)]} {
if {[info exists oldsash($win)]} {
set s0 $oldsash($win)
- } elseif {$use_ttk} {
- set s0 [$win sashpos 0]
} else {
- set s0 [$win sash coord 0]
+ set s0 [$win sashpos 0]
}
if {$w < 60} {
set sash0 [expr {int($w*3/4 - 2)}]
@@ -3041,12 +3172,7 @@ proc resizecdetpanes {win w} {
set sash0 [expr {$w - 15}]
}
}
- if {$use_ttk} {
- $win sashpos 0 $sash0
- } else {
- $win sash place 0 $sash0 [lindex $s0 1]
- set sash0 [list $sash0 [lindex $s0 1]]
- }
+ $win sashpos 0 $sash0
set oldsash($win) $sash0
}
set oldwidth($win) $w
@@ -3067,7 +3193,7 @@ proc bindall {event action} {
}
proc about {} {
- global bgcolor NS
+ global bgcolor
set w .about
if {[winfo exists $w]} {
raise $w
@@ -3084,7 +3210,7 @@ Copyright \u00a9 2005-2016 Paul Mackerras
Use and redistribute under the terms of the GNU General Public License"] \
-justify center -aspect 400 -border 2 -bg $bgcolor -relief groove
pack $w.m -side top -fill x -padx 2 -pady 2
- ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
+ ttk::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
pack $w.ok -side bottom
bind $w <Visibility> "focus $w.ok"
bind $w <Key-Escape> "destroy $w"
@@ -3093,7 +3219,7 @@ Use and redistribute under the terms of the GNU General Public License"] \
}
proc keys {} {
- global bgcolor NS
+ global bgcolor
set w .keys
if {[winfo exists $w]} {
raise $w
@@ -3151,7 +3277,7 @@ proc keys {} {
" \
-justify left -bg $bgcolor -border 2 -relief groove
pack $w.m -side top -fill both -padx 2 -pady 2
- ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
+ ttk::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
bind $w <Key-Escape> [list destroy $w]
pack $w.ok -side bottom
bind $w <Visibility> "focus $w.ok"
@@ -3610,7 +3736,7 @@ proc gitknewtmpdir {} {
set tmpdir $gitdir
}
set gitktmpformat [file join $tmpdir ".gitk-tmp.XXXXXX"]
- if {[catch {set gitktmpdir [exec mktemp -d $gitktmpformat]}]} {
+ if {[catch {set gitktmpdir [safe_exec [list mktemp -d $gitktmpformat]]}]} {
set gitktmpdir [file join $gitdir [format ".gitk-tmp.%s" [pid]]]
}
if {[catch {file mkdir $gitktmpdir} err]} {
@@ -3632,7 +3758,7 @@ proc gitknewtmpdir {} {
proc save_file_from_commit {filename output what} {
global nullfile
- if {[catch {exec git show $filename -- > $output} err]} {
+ if {[catch {safe_exec_redirect [list git show $filename --] [list > $output]} err]} {
if {[string match "fatal: bad revision *" $err]} {
return $nullfile
}
@@ -3697,7 +3823,7 @@ proc external_diff {} {
if {$difffromfile ne {} && $difftofile ne {}} {
set cmd [list [shellsplit $extdifftool] $difffromfile $difftofile]
- if {[catch {set fl [open |$cmd r]} err]} {
+ if {[catch {set fl [safe_open_command $cmd]} err]} {
file delete -force $diffdir
error_popup "$extdifftool: [mc "command failed:"] $err"
} else {
@@ -3801,7 +3927,7 @@ proc external_blame_diff {} {
# Find the SHA1 ID of the blob for file $fname in the index
# at stage 0 or 2
proc index_sha1 {fname} {
- set f [open [list | git ls-files -s $fname] r]
+ set f [safe_open_command [list git ls-files -s $fname]]
while {[gets $f line] >= 0} {
set info [lindex [split $line "\t"] 0]
set stage [lindex $info 2]
@@ -3861,7 +3987,7 @@ proc external_blame {parent_idx {line {}}} {
# being given an absolute path...
set f [make_relative $f]
lappend cmdline $base_commit $f
- if {[catch {eval exec $cmdline &} err]} {
+ if {[catch {safe_exec_redirect $cmdline [list &]} err]} {
error_popup "[mc "git gui blame: command failed:"] $err"
}
}
@@ -3889,7 +4015,7 @@ proc show_line_source {} {
# must be a merge in progress...
if {[catch {
# get the last line from .git/MERGE_HEAD
- set f [open [file join $gitdir MERGE_HEAD] r]
+ set f [safe_open_file [file join $gitdir MERGE_HEAD] r]
set id [lindex [split [read $f] "\n"] end-1]
close $f
} err]} {
@@ -3912,19 +4038,17 @@ proc show_line_source {} {
}
set line [lindex $h 1]
}
- set blameargs {}
- if {$from_index ne {}} {
- lappend blameargs | git cat-file blob $from_index
- }
- lappend blameargs | git blame -p -L$line,+1
+ set blamefile [file join $cdup $flist_menu_file]
if {$from_index ne {}} {
- lappend blameargs --contents -
+ set blameargs [list \
+ [list git cat-file blob $from_index] \
+ [list git blame -p -L$line,+1 --contents - -- $blamefile]]
} else {
- lappend blameargs $id
+ set blameargs [list \
+ [list git blame -p -L$line,+1 $id -- $blamefile]]
}
- lappend blameargs -- [file join $cdup $flist_menu_file]
if {[catch {
- set f [open $blameargs r]
+ set f [safe_open_pipeline $blameargs]
} err]} {
error_popup [mc "Couldn't start git blame: %s" $err]
return
@@ -3949,6 +4073,7 @@ proc stopblaming {} {
proc read_line_source {fd inst} {
global blamestuff curview commfd blameinst nullid nullid2
+ global hashlength
while {[gets $fd line] >= 0} {
lappend blamestuff($inst) $line
@@ -3969,7 +4094,7 @@ proc read_line_source {fd inst} {
set line [split [lindex $blamestuff($inst) 0] " "]
set id [lindex $line 0]
set lnum [lindex $line 1]
- if {[string length $id] == 40 && [string is xdigit $id] &&
+ if {[string length $id] == $hashlength && [string is xdigit $id] &&
[string is digit -strict $lnum]} {
# look for "filename" line
foreach l $blamestuff($inst) {
@@ -4297,16 +4422,16 @@ proc editview {} {
proc vieweditor {top n title} {
global newviewname newviewopts viewfiles bgcolor
- global known_view_options NS
+ global known_view_options
ttk_toplevel $top
wm title $top [concat $title [mc "-- criteria for selecting revisions"]]
make_transient $top .
# View name
- ${NS}::frame $top.nfr
- ${NS}::label $top.nl -text [mc "View Name"]
- ${NS}::entry $top.name -width 20 -textvariable newviewname($n)
+ ttk::frame $top.nfr
+ ttk::label $top.nl -text [mc "View Name"]
+ ttk::entry $top.name -width 20 -textvariable newviewname($n)
pack $top.nfr -in $top -fill x -pady 5 -padx 3
pack $top.nl -in $top.nfr -side left -padx {0 5}
pack $top.name -in $top.nfr -side left -padx {0 25}
@@ -4325,13 +4450,13 @@ proc vieweditor {top n title} {
if {$flags eq "+" || $flags eq "*"} {
set cframe $top.fr$cnt
incr cnt
- ${NS}::frame $cframe
+ ttk::frame $cframe
pack $cframe -in $top -fill x -pady 3 -padx 3
set cexpand [expr {$flags eq "*"}]
} elseif {$flags eq ".." || $flags eq "*."} {
set cframe $top.fr$cnt
incr cnt
- ${NS}::frame $cframe
+ ttk::frame $cframe
pack $cframe -in $top -fill x -pady 3 -padx [list 15 3]
set cexpand [expr {$flags eq "*."}]
} else {
@@ -4339,31 +4464,31 @@ proc vieweditor {top n title} {
}
if {$type eq "l"} {
- ${NS}::label $cframe.l_$id -text $title
+ ttk::label $cframe.l_$id -text $title
pack $cframe.l_$id -in $cframe -side left -pady [list 3 0] -anchor w
} elseif {$type eq "b"} {
- ${NS}::checkbutton $cframe.c_$id -text $title -variable newviewopts($n,$id)
+ ttk::checkbutton $cframe.c_$id -text $title -variable newviewopts($n,$id)
pack $cframe.c_$id -in $cframe -side left \
-padx [list $lxpad 0] -expand $cexpand -anchor w
} elseif {[regexp {^r(\d+)$} $type type sz]} {
regexp {^(.*_)} $id uselessvar button_id
- ${NS}::radiobutton $cframe.c_$id -text $title -variable newviewopts($n,$button_id) -value $sz
+ ttk::radiobutton $cframe.c_$id -text $title -variable newviewopts($n,$button_id) -value $sz
pack $cframe.c_$id -in $cframe -side left \
-padx [list $lxpad 0] -expand $cexpand -anchor w
} elseif {[regexp {^t(\d+)$} $type type sz]} {
- ${NS}::label $cframe.l_$id -text $title
- ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
+ ttk::label $cframe.l_$id -text $title
+ ttk::entry $cframe.e_$id -width $sz -background $bgcolor \
-textvariable newviewopts($n,$id)
pack $cframe.l_$id -in $cframe -side left -padx [list $lxpad 0]
pack $cframe.e_$id -in $cframe -side left -expand 1 -fill x
} elseif {[regexp {^t(\d+)=$} $type type sz]} {
- ${NS}::label $cframe.l_$id -text $title
- ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
+ ttk::label $cframe.l_$id -text $title
+ ttk::entry $cframe.e_$id -width $sz -background $bgcolor \
-textvariable newviewopts($n,$id)
pack $cframe.l_$id -in $cframe -side top -pady [list 3 0] -anchor w
pack $cframe.e_$id -in $cframe -side top -fill x
} elseif {$type eq "path"} {
- ${NS}::label $top.l -text $title
+ ttk::label $top.l -text $title
pack $top.l -in $top -side top -pady [list 3 0] -anchor w -padx 3
text $top.t -width 40 -height 5 -background $bgcolor
if {[info exists viewfiles($n)]} {
@@ -4378,10 +4503,10 @@ proc vieweditor {top n title} {
}
}
- ${NS}::frame $top.buts
- ${NS}::button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
- ${NS}::button $top.buts.apply -text [mc "Apply (F5)"] -command [list newviewok $top $n 1]
- ${NS}::button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
+ ttk::frame $top.buts
+ ttk::button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
+ ttk::button $top.buts.apply -text [mc "Apply (F5)"] -command [list newviewok $top $n 1]
+ ttk::button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
bind $top <Control-Return> [list newviewok $top $n]
bind $top <F5> [list newviewok $top $n 1]
bind $top <Escape> [list destroy $top]
@@ -4488,7 +4613,7 @@ proc addviewmenu {n} {
.bar.view add radiobutton -label $viewname($n) \
-command [list showview $n] -variable selectedview -value $n
#$viewhlmenu add radiobutton -label $viewname($n) \
- # -command [list addvhighlight $n] -variable selectedhlview
+ # -command [list addvhighlight $n] -variable selectedhlview
}
proc showview {n} {
@@ -4849,8 +4974,8 @@ proc do_file_hl {serial} {
# must be "containing:", i.e. we're searching commit info
return
}
- set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
- set filehighlight [open $cmd r+]
+ set cmd [concat git diff-tree -r -s --stdin $gdtargs]
+ set filehighlight [safe_open_command_rw $cmd]
fconfigure $filehighlight -blocking 0
filerun $filehighlight readfhighlight
set fhl_list {}
@@ -5113,11 +5238,13 @@ proc askrelhighlight {row id} {
# Graph layout functions
proc shortids {ids} {
+ global hashlength
+
set res {}
foreach id $ids {
if {[llength $id] > 1} {
lappend res [shortids $id]
- } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
+ } elseif {[regexp [string map "@@ $hashlength" {^[0-9a-f]{@@}$}] $id]} {
lappend res [string range $id 0 7]
} else {
lappend res $id
@@ -5279,8 +5406,8 @@ proc get_viewmainhead {view} {
global viewmainheadid vfilelimit viewinstances mainheadid
catch {
- set rfd [open [concat | git rev-list -1 $mainheadid \
- -- $vfilelimit($view)] r]
+ set rfd [safe_open_command [concat git rev-list -1 $mainheadid \
+ -- $vfilelimit($view)]]
set j [reg_instance $rfd]
lappend viewinstances($view) $j
fconfigure $rfd -blocking 0
@@ -5292,13 +5419,14 @@ proc get_viewmainhead {view} {
# git rev-list should give us just 1 line to use as viewmainheadid($view)
proc getviewhead {fd inst view} {
global viewmainheadid commfd curview viewinstances showlocalchanges
+ global hashlength
set id {}
if {[gets $fd line] < 0} {
if {![eof $fd]} {
return 1
}
- } elseif {[string length $line] == 40 && [string is xdigit $line]} {
+ } elseif {[string length $line] == $hashlength && [string is xdigit $line]} {
set id $line
}
set viewmainheadid($view) $id
@@ -5340,19 +5468,15 @@ proc dohidelocalchanges {} {
# spawn off a process to do git diff-index --cached HEAD
proc dodiffindex {} {
global lserial showlocalchanges vfilelimit curview
- global hasworktree git_version
+ global hasworktree
if {!$showlocalchanges || !$hasworktree} return
incr lserial
- if {[package vcompare $git_version "1.7.2"] >= 0} {
- set cmd "|git diff-index --cached --ignore-submodules=dirty HEAD"
- } else {
- set cmd "|git diff-index --cached HEAD"
- }
+ set cmd "git diff-index --cached --ignore-submodules=dirty HEAD"
if {$vfilelimit($curview) ne {}} {
set cmd [concat $cmd -- $vfilelimit($curview)]
}
- set fd [open $cmd r]
+ set fd [safe_open_command $cmd]
fconfigure $fd -blocking 0
set i [reg_instance $fd]
filerun $fd [list readdiffindex $fd $lserial $i]
@@ -5377,11 +5501,11 @@ proc readdiffindex {fd serial inst} {
}
# now see if there are any local changes not checked in to the index
- set cmd "|git diff-files"
+ set cmd "git diff-files"
if {$vfilelimit($curview) ne {}} {
set cmd [concat $cmd -- $vfilelimit($curview)]
}
- set fd [open $cmd r]
+ set fd [safe_open_command $cmd]
fconfigure $fd -blocking 0
set i [reg_instance $fd]
filerun $fd [list readdifffiles $fd $serial $i]
@@ -6576,13 +6700,7 @@ proc bindline {t id} {
}
proc graph_pane_width {} {
- global use_ttk
-
- if {$use_ttk} {
- set g [.tf.histframe.pwclist sashpos 0]
- } else {
- set g [.tf.histframe.pwclist sash coord 0]
- }
+ set g [.tf.histframe.pwclist sashpos 0]
return [lindex $g 0]
}
@@ -6995,7 +7113,7 @@ proc findselectline {l} {
# mark the bits of a headline or author that match a find string
proc markmatches {canv l str tag matches font row} {
- global selectedline
+ global selectedline foundbgcolor
set bbox [$canv bbox $tag]
set x0 [lindex $bbox 0]
@@ -7009,7 +7127,7 @@ proc markmatches {canv l str tag matches font row} {
set xlen [font measure $font [string range $str 0 [expr {$end}]]]
set t [$canv create rect [expr {$x0+$xoff}] $y0 \
[expr {$x0+$xlen+2}] $y1 \
- -outline {} -tags [list match$l matches] -fill yellow]
+ -outline {} -tags [list match$l matches] -fill $foundbgcolor]
$canv lower $t
if {$row == $selectedline} {
$canv raise $t secsel
@@ -7062,10 +7180,11 @@ proc commit_descriptor {p} {
# Also look for URLs of the form "http[s]://..." and make them web links.
proc appendwithlinks {text tags} {
global ctext linknum curview
+ global hashlength
set start [$ctext index "end - 1c"]
$ctext insert end $text $tags
- set links [regexp -indices -all -inline {(?:\m|-g)[0-9a-f]{6,40}\M} $text]
+ set links [regexp -indices -all -inline [string map "@@ $hashlength" {(?:\m|-g)[0-9a-f]{6,@@}\M}] $text]
foreach l $links {
set s [lindex $l 0]
set e [lindex $l 1]
@@ -7093,13 +7212,14 @@ proc appendwithlinks {text tags} {
proc setlink {id lk} {
global curview ctext pendinglinks
global linkfgcolor
+ global hashlength
if {[string range $id 0 1] eq "-g"} {
set id [string range $id 2 end]
}
set known 0
- if {[string length $id] < 40} {
+ if {[string length $id] < $hashlength} {
set matches [longid $id]
if {[llength $matches] > 0} {
if {[llength $matches] > 1} return
@@ -7170,8 +7290,8 @@ proc browseweb {url} {
global web_browser
if {$web_browser eq {}} return
- # Use eval here in case $web_browser is a command plus some arguments
- if {[catch {eval exec $web_browser [list $url] &} err]} {
+ # Use concat here in case $web_browser is a command plus some arguments
+ if {[catch {safe_exec_redirect [concat $web_browser [list $url]] [list &]} err]} {
error_popup "[mc "Error starting web browser:"] $err"
}
}
@@ -7344,7 +7464,7 @@ proc selectline {l isnew {desired_loc {}} {switch_to_patch 0}} {
global mergemax numcommits pending_select
global cmitmode showneartags allcommits
global targetrow targetid lastscrollrows
- global autoselect autosellen jump_to_here
+ global autocopy autoselect autosellen jump_to_here
global vinlinediff
unset -nocomplain pending_select
@@ -7410,9 +7530,13 @@ proc selectline {l isnew {desired_loc {}} {switch_to_patch 0}} {
$sha1entry delete 0 end
$sha1entry insert 0 $id
- if {$autoselect} {
+ if {$autoselect && [haveselectionclipboard]} {
$sha1entry selection range 0 $autosellen
}
+ if {$autocopy} {
+ clipboard clear
+ clipboard append [string range $id 0 [expr $autosellen - 1]]
+ }
rhighlight_sel $id
$ctext conf -state normal
@@ -7673,19 +7797,19 @@ proc gettree {id} {
if {![info exists treefilelist($id)]} {
if {![info exists treepending]} {
if {$id eq $nullid} {
- set cmd [list | git ls-files]
+ set cmd [list git ls-files]
} elseif {$id eq $nullid2} {
- set cmd [list | git ls-files --stage -t]
+ set cmd [list git ls-files --stage -t]
} else {
- set cmd [list | git ls-tree -r $id]
+ set cmd [list git ls-tree -r $id]
}
- if {[catch {set gtf [open $cmd r]}]} {
+ if {[catch {set gtf [safe_open_command $cmd]}]} {
return
}
set treepending $id
set treefilelist($id) {}
set treeidlist($id) {}
- fconfigure $gtf -blocking 0 -encoding binary
+ fconfigure $gtf -blocking 0 -translation binary
filerun $gtf [list gettreeline $gtf $id]
}
} else {
@@ -7712,7 +7836,7 @@ proc gettreeline {gtf id} {
if {[string index $fname 0] eq "\""} {
set fname [lindex $fname 0]
}
- set fname [encoding convertfrom $fname]
+ set fname [convertfrom utf-8 $fname]
lappend treefilelist($id) $fname
}
if {![eof $gtf]} {
@@ -7743,13 +7867,13 @@ proc showfile {f} {
return
}
if {$diffids eq $nullid} {
- if {[catch {set bf [open $f r]} err]} {
+ if {[catch {set bf [safe_open_file $f r]} err]} {
puts "oops, can't read $f: $err"
return
}
} else {
set blob [lindex $treeidlist($diffids) $i]
- if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
+ if {[catch {set bf [safe_open_command [concat git cat-file blob $blob]]} err]} {
puts "oops, error reading blob $blob: $err"
return
}
@@ -7892,14 +8016,14 @@ proc addtocflist {ids} {
}
proc diffcmd {ids flags} {
- global log_showroot nullid nullid2 git_version
+ global log_showroot nullid nullid2
set i [lsearch -exact $ids $nullid]
set j [lsearch -exact $ids $nullid2]
if {$i >= 0} {
if {[llength $ids] > 1 && $j < 0} {
# comparing working directory with some specific revision
- set cmd [concat | git diff-index $flags]
+ set cmd [concat git diff-index $flags]
if {$i == 0} {
lappend cmd -R [lindex $ids 1]
} else {
@@ -7907,16 +8031,14 @@ proc diffcmd {ids flags} {
}
} else {
# comparing working directory with index
- set cmd [concat | git diff-files $flags]
+ set cmd [concat git diff-files $flags]
if {$j == 1} {
lappend cmd -R
}
}
} elseif {$j >= 0} {
- if {[package vcompare $git_version "1.7.2"] >= 0} {
- set flags "$flags --ignore-submodules=dirty"
- }
- set cmd [concat | git diff-index --cached $flags]
+ set flags "$flags --ignore-submodules=dirty"
+ set cmd [concat git diff-index --cached $flags]
if {[llength $ids] > 1} {
# comparing index with specific revision
if {$j == 0} {
@@ -7932,7 +8054,7 @@ proc diffcmd {ids flags} {
if {$log_showroot} {
lappend flags --root
}
- set cmd [concat | git diff-tree -r $flags $ids]
+ set cmd [concat git diff-tree -r $flags $ids]
}
return $cmd
}
@@ -7944,11 +8066,11 @@ proc gettreediffs {ids} {
if {$limitdiffs && $vfilelimit($curview) ne {}} {
set cmd [concat $cmd -- $vfilelimit($curview)]
}
- if {[catch {set gdtf [open $cmd r]}]} return
+ if {[catch {set gdtf [safe_open_command $cmd]}]} return
set treepending $ids
set treediff {}
- fconfigure $gdtf -blocking 0 -encoding binary
+ fconfigure $gdtf -blocking 0 -translation binary
filerun $gdtf [list gettreediffline $gdtf $ids]
}
@@ -7974,7 +8096,7 @@ proc gettreediffline {gdtf ids} {
if {[string index $file 0] eq "\""} {
set file [lindex $file 0]
}
- set file [encoding convertfrom $file]
+ set file [convertfrom utf-8 $file]
if {$file ne [lindex $treediff end]} {
lappend treediff $file
lappend sublist $file
@@ -8044,17 +8166,8 @@ proc getblobdiffs {ids} {
global ignorespace
global worddiff
global limitdiffs vfilelimit curview
- global git_version
- set textconv {}
- if {[package vcompare $git_version "1.6.1"] >= 0} {
- set textconv "--textconv"
- }
- set submodule {}
- if {[package vcompare $git_version "1.6.6"] >= 0} {
- set submodule "--submodule"
- }
- set cmd [diffcmd $ids "-p $textconv $submodule -C --cc --no-commit-id -U$diffcontext"]
+ set cmd [diffcmd $ids "-p --textconv --submodule -C --cc --no-commit-id -U$diffcontext"]
if {$ignorespace} {
append cmd " -w"
}
@@ -8064,11 +8177,11 @@ proc getblobdiffs {ids} {
if {$limitdiffs && $vfilelimit($curview) ne {}} {
set cmd [concat $cmd -- $vfilelimit($curview)]
}
- if {[catch {set bdf [open $cmd r]} err]} {
+ if {[catch {set bdf [safe_open_command $cmd]} err]} {
error_popup [mc "Error getting diffs: %s" $err]
return
}
- fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
+ fconfigure $bdf -blocking 0 -translation binary
set blobdifffd($ids) $bdf
initblobdiffvars
filerun $bdf [list getblobdiffline $bdf $diffids]
@@ -8119,7 +8232,7 @@ proc makediffhdr {fname ids} {
global ctext curdiffstart treediffs diffencoding
global ctext_file_names jump_to_here targetline diffline
- set fname [encoding convertfrom $fname]
+ set fname [convertfrom utf-8 $fname]
set diffencoding [get_path_encoding $fname]
set i [lsearch -exact $treediffs($ids) $fname]
if {$i >= 0} {
@@ -8181,7 +8294,7 @@ proc parseblobdiffline {ids line} {
if {![string compare -length 5 "diff " $line]} {
if {![regexp {^diff (--cc|--git) } $line m type]} {
- set line [encoding convertfrom $line]
+ set line [convertfrom utf-8 $line]
$ctext insert end "$line\n" hunksep
continue
}
@@ -8230,7 +8343,7 @@ proc parseblobdiffline {ids line} {
makediffhdr $fname $ids
} elseif {![string compare -length 16 "* Unmerged path " $line]} {
- set fname [encoding convertfrom [string range $line 16 end]]
+ set fname [convertfrom utf-8 [string range $line 16 end]]
$ctext insert end "\n"
set curdiffstart [$ctext index "end - 1c"]
lappend ctext_file_names $fname
@@ -8243,7 +8356,7 @@ proc parseblobdiffline {ids line} {
} elseif {![string compare -length 2 "@@" $line]} {
regexp {^@@+} $line ats
- set line [encoding convertfrom $diffencoding $line]
+ set line [convertfrom $diffencoding $line]
$ctext insert end "$line\n" hunksep
if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
set diffline $nl
@@ -8272,10 +8385,10 @@ proc parseblobdiffline {ids line} {
$ctext insert end "$line\n" filesep
}
} elseif {$currdiffsubmod != "" && ![string compare -length 3 " >" $line]} {
- set line [encoding convertfrom $diffencoding $line]
+ set line [convertfrom $diffencoding $line]
$ctext insert end "$line\n" dresult
} elseif {$currdiffsubmod != "" && ![string compare -length 3 " <" $line]} {
- set line [encoding convertfrom $diffencoding $line]
+ set line [convertfrom $diffencoding $line]
$ctext insert end "$line\n" d0
} elseif {$diffinhdr} {
if {![string compare -length 12 "rename from " $line]} {
@@ -8283,7 +8396,7 @@ proc parseblobdiffline {ids line} {
if {[string index $fname 0] eq "\""} {
set fname [lindex $fname 0]
}
- set fname [encoding convertfrom $fname]
+ set fname [convertfrom utf-8 $fname]
set i [lsearch -exact $treediffs($ids) $fname]
if {$i >= 0} {
setinlist difffilestart $i $curdiffstart
@@ -8302,11 +8415,12 @@ proc parseblobdiffline {ids line} {
set diffinhdr 0
return
}
+ set line [convertfrom utf-8 $line]
$ctext insert end "$line\n" filesep
} else {
set line [string map {\x1A ^Z} \
- [encoding convertfrom $diffencoding $line]]
+ [convertfrom $diffencoding $line]]
# parse the prefix - one ' ', '-' or '+' for each parent
set prefix [string range $line 0 [expr {$diffnparents - 1}]]
set tag [expr {$diffnparents > 1? "m": "d"}]
@@ -8458,19 +8572,17 @@ proc clear_ctext {{first 1.0}} {
}
proc settabs {{firstab {}}} {
- global firsttabstop tabstop ctext have_tk85
+ global firsttabstop tabstop ctext
- if {$firstab ne {} && $have_tk85} {
+ if {$firstab ne {}} {
set firsttabstop $firstab
}
set w [font measure textfont "0"]
if {$firsttabstop != 0} {
$ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
[expr {($firsttabstop + 2 * $tabstop) * $w}]]
- } elseif {$have_tk85 || $tabstop != 8} {
- $ctext conf -tabs [expr {$tabstop * $w}]
} else {
- $ctext conf -tabs {}
+ $ctext conf -tabs [expr {$tabstop * $w}]
}
}
@@ -8739,13 +8851,16 @@ proc incrfont {inc} {
proc clearsha1 {} {
global sha1entry sha1string
- if {[string length $sha1string] == 40} {
+ global hashlength
+
+ if {[string length $sha1string] == $hashlength} {
$sha1entry delete 0 end
}
}
proc sha1change {n1 n2 op} {
global sha1string currentid sha1but
+
if {$sha1string == {}
|| ([info exists currentid] && $sha1string == $currentid)} {
set state disabled
@@ -8754,14 +8869,15 @@ proc sha1change {n1 n2 op} {
}
if {[$sha1but cget -state] == $state} return
if {$state == "normal"} {
- $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
+ $sha1but conf -state normal -text "[mc "Goto:"] "
} else {
- $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
+ $sha1but conf -state disabled -text "[mc "Commit ID:"] "
}
}
proc gotocommit {} {
global sha1string tagids headids curview varcid
+ global hashlength
if {$sha1string == {}
|| ([info exists currentid] && $sha1string == $currentid)} return
@@ -8771,17 +8887,17 @@ proc gotocommit {} {
set id $headids($sha1string)
} else {
set id [string tolower $sha1string]
- if {[regexp {^[0-9a-f]{4,39}$} $id]} {
+ if {[regexp {^[0-9a-f]{4,63}$} $id]} {
set matches [longid $id]
if {$matches ne {}} {
if {[llength $matches] > 1} {
- error_popup [mc "Short SHA1 id %s is ambiguous" $id]
+ error_popup [mc "Short commit ID %s is ambiguous" $id]
return
}
set id [lindex $matches 0]
}
} else {
- if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
+ if {[catch {set id [safe_exec [list git rev-parse --verify $sha1string]]}]} {
error_popup [mc "Revision %s is not known" $sha1string]
return
}
@@ -8792,7 +8908,7 @@ proc gotocommit {} {
return
}
if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
- set msg [mc "SHA1 id %s is not known" $sha1string]
+ set msg [mc "Commit ID %s is not known" $sha1string]
} else {
set msg [mc "Revision %s is not in the current view" $sha1string]
}
@@ -9087,10 +9203,8 @@ proc getpatchid {id} {
if {![info exists patchids($id)]} {
set cmd [diffcmd [list $id] {-p --root}]
- # trim off the initial "|"
- set cmd [lrange $cmd 1 end]
if {[catch {
- set x [eval exec $cmd | git patch-id]
+ set x [safe_exec_redirect $cmd [list | git patch-id]]
set patchids($id) [lindex $x 0]
}]} {
set patchids($id) "error"
@@ -9186,14 +9300,14 @@ proc diffcommits {a b} {
set fna [file join $tmpdir "commit-[string range $a 0 7]"]
set fnb [file join $tmpdir "commit-[string range $b 0 7]"]
if {[catch {
- exec git diff-tree -p --pretty $a >$fna
- exec git diff-tree -p --pretty $b >$fnb
+ safe_exec_redirect [list git diff-tree -p --pretty $a] [list >$fna]
+ safe_exec_redirect [list git diff-tree -p --pretty $b] [list >$fnb]
} err]} {
error_popup [mc "Error writing commit to file: %s" $err]
return
}
if {[catch {
- set fd [open "| diff -U$diffcontext $fna $fnb" r]
+ set fd [safe_open_command "diff -U$diffcontext $fna $fnb"]
} err]} {
error_popup [mc "Error diffing commits: %s" $err]
return
@@ -9259,7 +9373,8 @@ proc doseldiff {oldid newid} {
}
proc mkpatch {} {
- global rowmenuid currentid commitinfo patchtop patchnum NS
+ global rowmenuid currentid commitinfo patchtop patchnum
+ global hashlength
if {![info exists currentid]} return
set oldid $currentid
@@ -9271,36 +9386,36 @@ proc mkpatch {} {
catch {destroy $top}
ttk_toplevel $top
make_transient $top .
- ${NS}::label $top.title -text [mc "Generate patch"]
+ ttk::label $top.title -text [mc "Generate patch"]
grid $top.title - -pady 10
- ${NS}::label $top.from -text [mc "From:"]
- ${NS}::entry $top.fromsha1 -width 40
+ ttk::label $top.from -text [mc "From:"]
+ ttk::entry $top.fromsha1 -width $hashlength
$top.fromsha1 insert 0 $oldid
$top.fromsha1 conf -state readonly
grid $top.from $top.fromsha1 -sticky w
- ${NS}::entry $top.fromhead -width 60
+ ttk::entry $top.fromhead -width 60
$top.fromhead insert 0 $oldhead
$top.fromhead conf -state readonly
grid x $top.fromhead -sticky w
- ${NS}::label $top.to -text [mc "To:"]
- ${NS}::entry $top.tosha1 -width 40
+ ttk::label $top.to -text [mc "To:"]
+ ttk::entry $top.tosha1 -width $hashlength
$top.tosha1 insert 0 $newid
$top.tosha1 conf -state readonly
grid $top.to $top.tosha1 -sticky w
- ${NS}::entry $top.tohead -width 60
+ ttk::entry $top.tohead -width 60
$top.tohead insert 0 $newhead
$top.tohead conf -state readonly
grid x $top.tohead -sticky w
- ${NS}::button $top.rev -text [mc "Reverse"] -command mkpatchrev
+ ttk::button $top.rev -text [mc "Reverse"] -command mkpatchrev
grid $top.rev x -pady 10 -padx 5
- ${NS}::label $top.flab -text [mc "Output file:"]
- ${NS}::entry $top.fname -width 60
+ ttk::label $top.flab -text [mc "Output file:"]
+ ttk::entry $top.fname -width 60
$top.fname insert 0 [file normalize "patch$patchnum.patch"]
incr patchnum
grid $top.flab $top.fname -sticky w
- ${NS}::frame $top.buts
- ${NS}::button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
- ${NS}::button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
+ ttk::frame $top.buts
+ ttk::button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
+ ttk::button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
bind $top <Key-Return> mkpatchgo
bind $top <Key-Escape> mkpatchcan
grid $top.buts.gen $top.buts.can
@@ -9333,10 +9448,7 @@ proc mkpatchgo {} {
set newid [$patchtop.tosha1 get]
set fname [$patchtop.fname get]
set cmd [diffcmd [list $oldid $newid] -p]
- # trim off the initial "|"
- set cmd [lrange $cmd 1 end]
- lappend cmd >$fname &
- if {[catch {eval exec $cmd} err]} {
+ if {[catch {safe_exec_redirect $cmd [list >$fname &]} err]} {
error_popup "[mc "Error creating patch:"] $err" $patchtop
}
catch {destroy $patchtop}
@@ -9351,35 +9463,36 @@ proc mkpatchcan {} {
}
proc mktag {} {
- global rowmenuid mktagtop commitinfo NS
+ global rowmenuid mktagtop commitinfo
+ global hashlength
set top .maketag
set mktagtop $top
catch {destroy $top}
ttk_toplevel $top
make_transient $top .
- ${NS}::label $top.title -text [mc "Create tag"]
+ ttk::label $top.title -text [mc "Create tag"]
grid $top.title - -pady 10
- ${NS}::label $top.id -text [mc "ID:"]
- ${NS}::entry $top.sha1 -width 40
+ ttk::label $top.id -text [mc "ID:"]
+ ttk::entry $top.sha1 -width $hashlength
$top.sha1 insert 0 $rowmenuid
$top.sha1 conf -state readonly
grid $top.id $top.sha1 -sticky w
- ${NS}::entry $top.head -width 60
+ ttk::entry $top.head -width 60
$top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
$top.head conf -state readonly
grid x $top.head -sticky w
- ${NS}::label $top.tlab -text [mc "Tag name:"]
- ${NS}::entry $top.tag -width 60
+ ttk::label $top.tlab -text [mc "Tag name:"]
+ ttk::entry $top.tag -width 60
grid $top.tlab $top.tag -sticky w
- ${NS}::label $top.op -text [mc "Tag message is optional"]
+ ttk::label $top.op -text [mc "Tag message is optional"]
grid $top.op -columnspan 2 -sticky we
- ${NS}::label $top.mlab -text [mc "Tag message:"]
- ${NS}::entry $top.msg -width 60
+ ttk::label $top.mlab -text [mc "Tag message:"]
+ ttk::entry $top.msg -width 60
grid $top.mlab $top.msg -sticky w
- ${NS}::frame $top.buts
- ${NS}::button $top.buts.gen -text [mc "Create"] -command mktaggo
- ${NS}::button $top.buts.can -text [mc "Cancel"] -command mktagcan
+ ttk::frame $top.buts
+ ttk::button $top.buts.gen -text [mc "Create"] -command mktaggo
+ ttk::button $top.buts.can -text [mc "Cancel"] -command mktagcan
bind $top <Key-Return> mktaggo
bind $top <Key-Escape> mktagcan
grid $top.buts.gen $top.buts.can
@@ -9405,9 +9518,9 @@ proc domktag {} {
}
if {[catch {
if {$msg != {}} {
- exec git tag -a -m $msg $tag $id
+ safe_exec [list git tag -a -m $msg $tag $id]
} else {
- exec git tag $tag $id
+ safe_exec [list git tag $tag $id]
}
} err]} {
error_popup "[mc "Error creating tag:"] $err" $mktagtop
@@ -9469,47 +9582,49 @@ proc mktaggo {} {
proc copyreference {} {
global rowmenuid autosellen
+ global hashlength
set format "%h (\"%s\", %ad)"
set cmd [list git show -s --pretty=format:$format --date=short]
- if {$autosellen < 40} {
+ if {$autosellen < $hashlength} {
lappend cmd --abbrev=$autosellen
}
- set reference [eval exec $cmd $rowmenuid]
+ set reference [safe_exec [concat $cmd $rowmenuid]]
clipboard clear
clipboard append $reference
}
proc writecommit {} {
- global rowmenuid wrcomtop commitinfo wrcomcmd NS
+ global rowmenuid wrcomtop commitinfo wrcomcmd
+ global hashlength
set top .writecommit
set wrcomtop $top
catch {destroy $top}
ttk_toplevel $top
make_transient $top .
- ${NS}::label $top.title -text [mc "Write commit to file"]
+ ttk::label $top.title -text [mc "Write commit to file"]
grid $top.title - -pady 10
- ${NS}::label $top.id -text [mc "ID:"]
- ${NS}::entry $top.sha1 -width 40
+ ttk::label $top.id -text [mc "ID:"]
+ ttk::entry $top.sha1 -width $hashlength
$top.sha1 insert 0 $rowmenuid
$top.sha1 conf -state readonly
grid $top.id $top.sha1 -sticky w
- ${NS}::entry $top.head -width 60
+ ttk::entry $top.head -width 60
$top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
$top.head conf -state readonly
grid x $top.head -sticky w
- ${NS}::label $top.clab -text [mc "Command:"]
- ${NS}::entry $top.cmd -width 60 -textvariable wrcomcmd
+ ttk::label $top.clab -text [mc "Command:"]
+ ttk::entry $top.cmd -width 60 -textvariable wrcomcmd
grid $top.clab $top.cmd -sticky w -pady 10
- ${NS}::label $top.flab -text [mc "Output file:"]
- ${NS}::entry $top.fname -width 60
+ ttk::label $top.flab -text [mc "Output file:"]
+ ttk::entry $top.fname -width 60
$top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
grid $top.flab $top.fname -sticky w
- ${NS}::frame $top.buts
- ${NS}::button $top.buts.gen -text [mc "Write"] -command wrcomgo
- ${NS}::button $top.buts.can -text [mc "Cancel"] -command wrcomcan
+ ttk::frame $top.buts
+ ttk::button $top.buts.gen -text [mc "Write"] -command wrcomgo
+ ttk::button $top.buts.can -text [mc "Cancel"] -command wrcomcan
bind $top <Key-Return> wrcomgo
bind $top <Key-Escape> wrcomcan
grid $top.buts.gen $top.buts.can
@@ -9525,7 +9640,7 @@ proc wrcomgo {} {
set id [$wrcomtop.sha1 get]
set cmd "echo $id | [$wrcomtop.cmd get]"
set fname [$wrcomtop.fname get]
- if {[catch {exec sh -c $cmd >$fname &} err]} {
+ if {[catch {safe_exec_redirect [list sh -c $cmd] [list >$fname &]} err]} {
error_popup "[mc "Error writing commit:"] $err" $wrcomtop
}
catch {destroy $wrcomtop}
@@ -9540,7 +9655,7 @@ proc wrcomcan {} {
}
proc mkbranch {} {
- global NS rowmenuid
+ global rowmenuid
set top .branchdialog
@@ -9555,7 +9670,6 @@ proc mkbranch {} {
}
proc mvbranch {} {
- global NS
global headmenuid headmenuhead
set top .branchdialog
@@ -9571,31 +9685,32 @@ proc mvbranch {} {
}
proc branchdia {top valvar uivar} {
- global NS commitinfo
+ global commitinfo
+ global hashlength
upvar $valvar val $uivar ui
catch {destroy $top}
ttk_toplevel $top
make_transient $top .
- ${NS}::label $top.title -text $ui(title)
+ ttk::label $top.title -text $ui(title)
grid $top.title - -pady 10
- ${NS}::label $top.id -text [mc "ID:"]
- ${NS}::entry $top.sha1 -width 40
+ ttk::label $top.id -text [mc "ID:"]
+ ttk::entry $top.sha1 -width $hashlength
$top.sha1 insert 0 $val(id)
$top.sha1 conf -state readonly
grid $top.id $top.sha1 -sticky w
- ${NS}::entry $top.head -width 60
+ ttk::entry $top.head -width 60
$top.head insert 0 [lindex $commitinfo($val(id)) 0]
$top.head conf -state readonly
grid x $top.head -sticky ew
grid columnconfigure $top 1 -weight 1
- ${NS}::label $top.nlab -text [mc "Name:"]
- ${NS}::entry $top.name -width 40
+ ttk::label $top.nlab -text [mc "Name:"]
+ ttk::entry $top.name -width $hashlength
$top.name insert 0 $val(name)
grid $top.nlab $top.name -sticky w
- ${NS}::frame $top.buts
- ${NS}::button $top.buts.go -text $ui(accept) -command $val(command)
- ${NS}::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
+ ttk::frame $top.buts
+ ttk::button $top.buts.go -text $ui(accept) -command $val(command)
+ ttk::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
bind $top <Key-Return> $val(command)
bind $top <Key-Escape> "catch {destroy $top}"
grid $top.buts.go $top.buts.can
@@ -9629,7 +9744,7 @@ proc mkbrgo {top} {
nowbusy newbranch
update
if {[catch {
- eval exec git branch $cmdargs
+ safe_exec [concat git branch $cmdargs]
} err]} {
notbusy newbranch
error_popup $err
@@ -9670,7 +9785,7 @@ proc mvbrgo {top prevname} {
nowbusy renamebranch
update
if {[catch {
- eval exec git branch $cmdargs
+ safe_exec [concat git branch $cmdargs]
} err]} {
notbusy renamebranch
error_popup $err
@@ -9711,7 +9826,7 @@ proc exec_citool {tool_args {baseid {}}} {
}
}
- eval exec git citool $tool_args &
+ safe_exec_redirect [concat git citool $tool_args] [list &]
array unset env GIT_AUTHOR_*
array set env $save_env
@@ -9734,7 +9849,7 @@ proc cherrypick {} {
update
# Unfortunately git-cherry-pick writes stuff to stderr even when
# no error occurs, and exec takes that as an indication of error...
- if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
+ if {[catch {safe_exec [list sh -c "git cherry-pick -r $rowmenuid 2>&1"]} err]} {
notbusy cherrypick
if {[regexp -line \
{Entry '(.*)' (would be overwritten by merge|not uptodate)} \
@@ -9796,7 +9911,7 @@ proc revert {} {
nowbusy revert [mc "Reverting"]
update
- if [catch {exec git revert --no-edit $rowmenuid} err] {
+ if [catch {safe_exec [list git revert --no-edit $rowmenuid]} err] {
notbusy revert
if [regexp {files would be overwritten by merge:(\n(( |\t)+[^\n]+\n)+)}\
$err match files] {
@@ -9842,38 +9957,38 @@ proc revert {} {
}
proc resethead {} {
- global mainhead rowmenuid confirm_ok resettype NS
+ global mainhead rowmenuid confirm_ok resettype
set confirm_ok 0
set w ".confirmreset"
ttk_toplevel $w
make_transient $w .
wm title $w [mc "Confirm reset"]
- ${NS}::label $w.m -text \
+ ttk::label $w.m -text \
[mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]]
pack $w.m -side top -fill x -padx 20 -pady 20
- ${NS}::labelframe $w.f -text [mc "Reset type:"]
+ ttk::labelframe $w.f -text [mc "Reset type:"]
set resettype mixed
- ${NS}::radiobutton $w.f.soft -value soft -variable resettype \
+ ttk::radiobutton $w.f.soft -value soft -variable resettype \
-text [mc "Soft: Leave working tree and index untouched"]
grid $w.f.soft -sticky w
- ${NS}::radiobutton $w.f.mixed -value mixed -variable resettype \
+ ttk::radiobutton $w.f.mixed -value mixed -variable resettype \
-text [mc "Mixed: Leave working tree untouched, reset index"]
grid $w.f.mixed -sticky w
- ${NS}::radiobutton $w.f.hard -value hard -variable resettype \
+ ttk::radiobutton $w.f.hard -value hard -variable resettype \
-text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
grid $w.f.hard -sticky w
pack $w.f -side top -fill x -padx 4
- ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
+ ttk::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
pack $w.ok -side left -fill x -padx 20 -pady 20
- ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
+ ttk::button $w.cancel -text [mc Cancel] -command "destroy $w"
bind $w <Key-Escape> [list destroy $w]
pack $w.cancel -side right -fill x -padx 20 -pady 20
bind $w <Visibility> "grab $w; focus $w"
tkwait window $w
if {!$confirm_ok} return
- if {[catch {set fd [open \
- [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
+ if {[catch {set fd [safe_open_command_redirect \
+ [list git reset --$resettype $rowmenuid] [list 2>@1]]} err]} {
error_popup $err
} else {
dohidelocalchanges
@@ -9944,7 +10059,7 @@ proc cobranch {} {
# check the tree is clean first??
set newhead $headmenuhead
- set command [list | git checkout]
+ set command [list git checkout]
if {[string match "remotes/*" $newhead]} {
set remote $newhead
set newhead [string range $newhead [expr [string last / $newhead] + 1] end]
@@ -9958,12 +10073,11 @@ proc cobranch {} {
} else {
lappend command $newhead
}
- lappend command 2>@1
nowbusy checkout [mc "Checking out"]
update
dohidelocalchanges
if {[catch {
- set fd [open $command r]
+ set fd [safe_open_command_redirect $command [list 2>@1]]
} err]} {
notbusy checkout
error_popup $err
@@ -10029,7 +10143,7 @@ proc rmbranch {} {
}
nowbusy rmbranch
update
- if {[catch {exec git branch -D $head} err]} {
+ if {[catch {safe_exec [list git branch -D $head]} err]} {
notbusy rmbranch
error_popup $err
return
@@ -10044,7 +10158,7 @@ proc rmbranch {} {
# Display a list of tags and heads
proc showrefs {} {
- global showrefstop bgcolor fgcolor selectbgcolor NS
+ global showrefstop bgcolor fgcolor selectbgcolor
global bglist fglist reflistfilter reflist maincursor
set top .showrefs
@@ -10060,26 +10174,29 @@ proc showrefs {} {
text $top.list -background $bgcolor -foreground $fgcolor \
-selectbackground $selectbgcolor -font mainfont \
-xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
- -width 30 -height 20 -cursor $maincursor \
+ -width 60 -height 20 -cursor $maincursor \
-spacing1 1 -spacing3 1 -state disabled
$top.list tag configure highlight -background $selectbgcolor
if {![lsearch -exact $bglist $top.list]} {
lappend bglist $top.list
lappend fglist $top.list
}
- ${NS}::scrollbar $top.ysb -command "$top.list yview" -orient vertical
- ${NS}::scrollbar $top.xsb -command "$top.list xview" -orient horizontal
+ ttk::scrollbar $top.ysb -command "$top.list yview" -orient vertical
+ ttk::scrollbar $top.xsb -command "$top.list xview" -orient horizontal
grid $top.list $top.ysb -sticky nsew
grid $top.xsb x -sticky ew
- ${NS}::frame $top.f
- ${NS}::label $top.f.l -text "[mc "Filter"]: "
- ${NS}::entry $top.f.e -width 20 -textvariable reflistfilter
+ ttk::frame $top.f
+ ttk::label $top.f.l -text "[mc "Filter"]: "
+ ttk::entry $top.f.e -width 20 -textvariable reflistfilter
set reflistfilter "*"
trace add variable reflistfilter write reflistfilter_change
pack $top.f.e -side right -fill x -expand 1
pack $top.f.l -side left
grid $top.f - -sticky ew -pady 2
- ${NS}::button $top.close -command [list destroy $top] -text [mc "Close"]
+ ttk::checkbutton $top.sort -text [mc "Sort refs by type"] \
+ -variable sortrefsbytype -command {refill_reflist}
+ grid $top.sort - -sticky w -pady 2
+ ttk::button $top.close -command [list destroy $top] -text [mc "Close"]
bind $top <Key-Escape> [list destroy $top]
grid $top.close -
grid columnconfigure $top 0 -weight 1
@@ -10122,43 +10239,73 @@ proc reflistfilter_change {n1 n2 op} {
}
proc refill_reflist {} {
- global reflist reflistfilter showrefstop headids tagids otherrefids
- global curview
+ global reflist reflistfilter showrefstop headids tagids otherrefids sortrefsbytype
+ global curview upstreamofref
if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
- set refs {}
+ set localrefs {}
+ set remoterefs {}
+ set trackedremoterefs {}
+ set tagrefs {}
+ set otherrefs {}
+
foreach n [array names headids] {
- if {[string match $reflistfilter $n]} {
+ if {![string match "remotes/*" $n] && [string match $reflistfilter $n]} {
if {[commitinview $headids($n) $curview]} {
- if {[string match "remotes/*" $n]} {
- lappend refs [list $n R]
- } else {
- lappend refs [list $n H]
+ lappend localrefs [list $n H]
+ if {[info exists upstreamofref($n)] && \
+ [info exists headids($upstreamofref($n))] && \
+ [commitinview $headids($upstreamofref($n)) $curview]} {
+ lappend trackedremoterefs [list $upstreamofref($n) R]
+ }
+ } else {
+ interestedin $headids($n) {run refill_reflist}
+ }
+ }
+ }
+ set trackedremoterefs [lsort -index 0 -unique $trackedremoterefs]
+ set localrefs [lsort -index 0 $localrefs]
+
+ foreach n [array names headids] {
+ if {[string match "remotes/*" $n] && [string match $reflistfilter $n]} {
+ if {[commitinview $headids($n) $curview]} {
+ if {[lsearch -exact $trackedremoterefs [list $n R]] < 0} {
+ lappend remoterefs [list $n R]
}
} else {
interestedin $headids($n) {run refill_reflist}
}
}
}
+ set remoterefs [lsort -index 0 $remoterefs]
+
foreach n [array names tagids] {
if {[string match $reflistfilter $n]} {
if {[commitinview $tagids($n) $curview]} {
- lappend refs [list $n T]
+ lappend tagrefs [list $n T]
} else {
interestedin $tagids($n) {run refill_reflist}
}
}
}
+ set tagrefs [lsort -index 0 $tagrefs]
+
foreach n [array names otherrefids] {
if {[string match $reflistfilter $n]} {
if {[commitinview $otherrefids($n) $curview]} {
- lappend refs [list $n o]
+ lappend otherrefs [list "$n" o]
} else {
interestedin $otherrefids($n) {run refill_reflist}
}
}
}
- set refs [lsort -index 0 $refs]
+ set otherrefs [lsort -index 0 $otherrefs]
+
+ set refs [concat $localrefs $trackedremoterefs $remoterefs $tagrefs $otherrefs]
+ if {!$sortrefsbytype} {
+ set refs [lsort -index 0 $refs]
+ }
+
if {$refs eq $reflist} return
# Update the contents of $showrefstop.list according to the
@@ -10220,7 +10367,7 @@ proc getallcommits {} {
set cachedarcs 0
set allccache [file join $gitdir "gitk.cache"]
if {![catch {
- set f [open $allccache r]
+ set f [safe_open_file $allccache r]
set allcwait 1
getcache $f
}]} return
@@ -10229,7 +10376,7 @@ proc getallcommits {} {
if {$allcwait} {
return
}
- set cmd [list | git rev-list --parents]
+ set cmd [list git rev-list --parents]
set allcupdate [expr {$seeds ne {}}]
if {!$allcupdate} {
set ids "--all"
@@ -10257,10 +10404,11 @@ proc getallcommits {} {
if {$ids ne {}} {
if {$ids eq "--all"} {
set cmd [concat $cmd "--all"]
+ set fd [safe_open_command $cmd]
} else {
- set cmd [concat $cmd --stdin "<<[join $ids "\\n"]"]
+ set cmd [concat $cmd --stdin]
+ set fd [safe_open_command_redirect $cmd [list "<<[join $ids "\n"]"]]
}
- set fd [open $cmd r]
fconfigure $fd -blocking 0
incr allcommits
nowbusy allcommits
@@ -10650,7 +10798,7 @@ proc savecache {} {
set cachearc 0
set cachedarcs $nextarc
catch {
- set f [open $allccache w]
+ set f [safe_open_file $allccache w]
puts $f [list 1 $cachedarcs]
run writecache $f
}
@@ -11353,7 +11501,7 @@ proc add_tag_ctext {tag} {
if {![info exists cached_tagcontent($tag)]} {
catch {
- set cached_tagcontent($tag) [exec git cat-file -p $tag]
+ set cached_tagcontent($tag) [safe_exec [list git cat-file -p $tag]]
}
}
$ctext insert end "[mc "Tag"]: $tag\n" bold
@@ -11416,82 +11564,15 @@ proc doquit {} {
}
proc mkfontdisp {font top which} {
- global fontattr fontpref $font NS use_ttk
+ global fontattr fontpref $font
set fontpref($font) [set $font]
- ${NS}::button $top.${font}but -text $which \
+ ttk::button $top.${font}but -text $which \
-command [list choosefont $font $which]
- ${NS}::label $top.$font -relief flat -font $font \
- -text $fontattr($font,family) -justify left
+ ttk::label $top.$font -font $font \
+ -text $fontattr($font,family)
grid x $top.${font}but $top.$font -sticky w
-}
-
-proc choosefont {font which} {
- global fontparam fontlist fonttop fontattr
- global prefstop NS
-
- set fontparam(which) $which
- set fontparam(font) $font
- set fontparam(family) [font actual $font -family]
- set fontparam(size) $fontattr($font,size)
- set fontparam(weight) $fontattr($font,weight)
- set fontparam(slant) $fontattr($font,slant)
- set top .gitkfont
- set fonttop $top
- if {![winfo exists $top]} {
- font create sample
- eval font config sample [font actual $font]
- ttk_toplevel $top
- make_transient $top $prefstop
- wm title $top [mc "Gitk font chooser"]
- ${NS}::label $top.l -textvariable fontparam(which)
- pack $top.l -side top
- set fontlist [lsort [font families]]
- ${NS}::frame $top.f
- listbox $top.f.fam -listvariable fontlist \
- -yscrollcommand [list $top.f.sb set]
- bind $top.f.fam <<ListboxSelect>> selfontfam
- ${NS}::scrollbar $top.f.sb -command [list $top.f.fam yview]
- pack $top.f.sb -side right -fill y
- pack $top.f.fam -side left -fill both -expand 1
- pack $top.f -side top -fill both -expand 1
- ${NS}::frame $top.g
- spinbox $top.g.size -from 4 -to 40 -width 4 \
- -textvariable fontparam(size) \
- -validatecommand {string is integer -strict %s}
- checkbutton $top.g.bold -padx 5 \
- -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
- -variable fontparam(weight) -onvalue bold -offvalue normal
- checkbutton $top.g.ital -padx 5 \
- -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
- -variable fontparam(slant) -onvalue italic -offvalue roman
- pack $top.g.size $top.g.bold $top.g.ital -side left
- pack $top.g -side top
- canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
- -background white
- $top.c create text 100 25 -anchor center -text $which -font sample \
- -fill black -tags text
- bind $top.c <Configure> [list centertext $top.c]
- pack $top.c -side top -fill x
- ${NS}::frame $top.buts
- ${NS}::button $top.buts.ok -text [mc "OK"] -command fontok -default active
- ${NS}::button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
- bind $top <Key-Return> fontok
- bind $top <Key-Escape> fontcan
- grid $top.buts.ok $top.buts.can
- grid columnconfigure $top.buts 0 -weight 1 -uniform a
- grid columnconfigure $top.buts 1 -weight 1 -uniform a
- pack $top.buts -side bottom -fill x
- trace add variable fontparam write chg_fontparam
- } else {
- raise $top
- $top.c itemconf text -text $which
- }
- set i [lsearch -exact $fontlist $fontparam(family)]
- if {$i >= 0} {
- $top.f.fam selection set $i
- $top.f.fam see $i
- }
+ grid configure $top.$font -sticky ew
}
proc centertext {w} {
@@ -11526,26 +11607,21 @@ proc fontcan {} {
}
}
-if {[package vsatisfies [package provide Tk] 8.6]} {
- # In Tk 8.6 we have a native font chooser dialog. Overwrite the above
- # function to make use of it.
- proc choosefont {font which} {
- tk fontchooser configure -title $which -font $font \
- -command [list on_choosefont $font $which]
- tk fontchooser show
- }
- proc on_choosefont {font which newfont} {
- global fontparam
- puts stderr "$font $newfont"
- array set f [font actual $newfont]
- set fontparam(which) $which
- set fontparam(font) $font
- set fontparam(family) $f(-family)
- set fontparam(size) $f(-size)
- set fontparam(weight) $f(-weight)
- set fontparam(slant) $f(-slant)
- fontok
- }
+proc choosefont {font which} {
+ tk fontchooser configure -title $which -font $font \
+ -command [list on_choosefont $font $which]
+ tk fontchooser show
+}
+proc on_choosefont {font which newfont} {
+ global fontparam
+ array set f [font actual $newfont]
+ set fontparam(which) $which
+ set fontparam(font) $font
+ set fontparam(family) $f(-family)
+ set fontparam(size) $f(-size)
+ set fontparam(weight) $f(-weight)
+ set fontparam(slant) $f(-slant)
+ fontok
}
proc selfontfam {} {
@@ -11565,167 +11641,221 @@ proc chg_fontparam {v sub op} {
# Create a property sheet tab page
proc create_prefs_page {w} {
- global NS
- set parent [join [lrange [split $w .] 0 end-1] .]
- if {[winfo class $parent] eq "TNotebook"} {
- ${NS}::frame $w
- } else {
- ${NS}::labelframe $w
- }
+ ttk::frame $w
}
proc prefspage_general {notebook} {
- global NS maxwidth maxgraphpct showneartags showlocalchanges
- global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
- global hideremotes want_ttk have_ttk maxrefs web_browser
+ global {*}$::config_variables
+ global hashlength
set page [create_prefs_page $notebook.general]
- ${NS}::label $page.ldisp -text [mc "Commit list display options"]
+ ttk::label $page.ldisp -text [mc "Commit list display options"] -font mainfontbold
grid $page.ldisp - -sticky w -pady 10
- ${NS}::label $page.spacer -text " "
- ${NS}::label $page.maxwidthl -text [mc "Maximum graph width (lines)"]
- spinbox $page.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
+
+ ttk::label $page.spacer -text " "
+ ttk::label $page.maxwidthl -text [mc "Maximum graph width (lines)"]
+ ttk::spinbox $page.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
grid $page.spacer $page.maxwidthl $page.maxwidth -sticky w
#xgettext:no-tcl-format
- ${NS}::label $page.maxpctl -text [mc "Maximum graph width (% of pane)"]
- spinbox $page.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
+ ttk::label $page.maxpctl -text [mc "Maximum graph width (% of pane)"]
+ ttk::spinbox $page.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
grid x $page.maxpctl $page.maxpct -sticky w
- ${NS}::checkbutton $page.showlocal -text [mc "Show local changes"] \
+
+ ttk::checkbutton $page.showlocal -text [mc "Show local changes"] \
-variable showlocalchanges
grid x $page.showlocal -sticky w
- ${NS}::checkbutton $page.autoselect -text [mc "Auto-select SHA1 (length)"] \
- -variable autoselect
- spinbox $page.autosellen -from 1 -to 40 -width 4 -textvariable autosellen
- grid x $page.autoselect $page.autosellen -sticky w
- ${NS}::checkbutton $page.hideremotes -text [mc "Hide remote refs"] \
+
+ ttk::checkbutton $page.hideremotes -text [mc "Hide remote refs"] \
-variable hideremotes
grid x $page.hideremotes -sticky w
- ${NS}::label $page.ddisp -text [mc "Diff display options"]
+ ttk::entry $page.refstohide -textvariable refstohide
+ ttk::label $page.refstohidel -text [mc "Refs to hide (space-separated globs)"]
+ grid x $page.refstohidel $page.refstohide -sticky ew
+ grid configure $page.refstohide -padx {0 5}
+
+ ttk::checkbutton $page.autocopy -text [mc "Copy commit ID to clipboard"] \
+ -variable autocopy
+ grid x $page.autocopy -sticky w
+
+ if {[haveselectionclipboard]} {
+ ttk::checkbutton $page.autoselect -text [mc "Copy commit ID to X11 selection"] \
+ -variable autoselect
+ grid x $page.autoselect -sticky w
+ }
+
+ ttk::spinbox $page.autosellen -from 1 -to $hashlength -width 4 -textvariable autosellen
+ ttk::label $page.autosellenl -text [mc "Length of commit ID to copy"]
+ grid x $page.autosellenl $page.autosellen -sticky w
+
+ ttk::label $page.kscroll1 -text [mc "Wheel scrolling multiplier"]
+ ttk::spinbox $page.kscroll -from 1 -to 20 -width 4 -textvariable kscroll
+ grid x $page.kscroll1 $page.kscroll -sticky w
+
+ ttk::label $page.ddisp -text [mc "Diff display options"] -font mainfontbold
grid $page.ddisp - -sticky w -pady 10
- ${NS}::label $page.tabstopl -text [mc "Tab spacing"]
- spinbox $page.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
+
+ ttk::label $page.tabstopl -text [mc "Tab spacing"]
+ ttk::spinbox $page.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
grid x $page.tabstopl $page.tabstop -sticky w
- ${NS}::checkbutton $page.ntag -text [mc "Display nearby tags/heads"] \
+
+ ttk::label $page.wrapcommentl -text [mc "Wrap comment text"]
+ makedroplist $page.wrapcomment wrapcomment none char word
+ grid x $page.wrapcommentl $page.wrapcomment -sticky w
+
+ ttk::label $page.wrapdefaultl -text [mc "Wrap other text"]
+ makedroplist $page.wrapdefault wrapdefault none char word
+ grid x $page.wrapdefaultl $page.wrapdefault -sticky w
+
+ ttk::checkbutton $page.ntag -text [mc "Display nearby tags/heads"] \
-variable showneartags
grid x $page.ntag -sticky w
- ${NS}::label $page.maxrefsl -text [mc "Maximum # tags/heads to show"]
- spinbox $page.maxrefs -from 1 -to 1000 -width 4 -textvariable maxrefs
+
+ ttk::label $page.maxrefsl -text [mc "Maximum # tags/heads to show"]
+ ttk::spinbox $page.maxrefs -from 1 -to 1000 -width 4 -textvariable maxrefs
grid x $page.maxrefsl $page.maxrefs -sticky w
- ${NS}::checkbutton $page.ldiff -text [mc "Limit diffs to listed paths"] \
+
+ ttk::checkbutton $page.ldiff -text [mc "Limit diffs to listed paths"] \
-variable limitdiffs
grid x $page.ldiff -sticky w
- ${NS}::checkbutton $page.lattr -text [mc "Support per-file encodings"] \
+
+ ttk::checkbutton $page.lattr -text [mc "Support per-file encodings"] \
-variable perfile_attrs
grid x $page.lattr -sticky w
- ${NS}::entry $page.extdifft -textvariable extdifftool
- ${NS}::frame $page.extdifff
- ${NS}::label $page.extdifff.l -text [mc "External diff tool" ]
- ${NS}::button $page.extdifff.b -text [mc "Choose..."] -command choose_extdiff
- pack $page.extdifff.l $page.extdifff.b -side left
- pack configure $page.extdifff.l -padx 10
+ ttk::entry $page.extdifft -textvariable extdifftool
+ ttk::frame $page.extdifff
+ ttk::label $page.extdifff.l -text [mc "External diff tool" ]
+ ttk::button $page.extdifff.b -text [mc "Choose..."] -command choose_extdiff
+ pack $page.extdifff.l -side left
+ pack $page.extdifff.b -side right -padx {0 5}
grid x $page.extdifff $page.extdifft -sticky ew
+ grid configure $page.extdifft -padx {0 5}
+
+ ttk::entry $page.webbrowser -textvariable web_browser
+ ttk::label $page.webbrowserl -text [mc "Web browser" ]
+ grid x $page.webbrowserl $page.webbrowser -sticky ew
+ grid configure $page.webbrowser -padx {0 5}
+
+ grid columnconfigure $page 2 -weight 1
- ${NS}::entry $page.webbrowser -textvariable web_browser
- ${NS}::frame $page.webbrowserf
- ${NS}::label $page.webbrowserf.l -text [mc "Web browser" ]
- pack $page.webbrowserf.l -side left
- pack configure $page.webbrowserf.l -padx 10
- grid x $page.webbrowserf $page.webbrowser -sticky ew
-
- ${NS}::label $page.lgen -text [mc "General options"]
- grid $page.lgen - -sticky w -pady 10
- ${NS}::checkbutton $page.want_ttk -variable want_ttk \
- -text [mc "Use themed widgets"]
- if {$have_ttk} {
- ${NS}::label $page.ttk_note -text [mc "(change requires restart)"]
- } else {
- ${NS}::label $page.ttk_note -text [mc "(currently unavailable)"]
- }
- grid x $page.want_ttk $page.ttk_note -sticky w
return $page
}
proc prefspage_colors {notebook} {
- global NS uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
+ global bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
global diffbgcolors
+ global themeloader
set page [create_prefs_page $notebook.colors]
- ${NS}::label $page.cdisp -text [mc "Colors: press to choose"]
+ ttk::label $page.themesel -font mainfontbold \
+ -text [mc "Themes - change requires restart"]
+ grid $page.themesel - -sticky w -pady 10
+
+ ttk::label $page.themelabel -text [mc "Theme to use after restart"]
+ makedroplist $page.theme theme {*}[lsort [ttk::style theme names]]
+ grid x $page.themelabel $page.theme -sticky w
+
+ ttk::entry $page.tloadvar -textvariable themeloader
+ ttk::frame $page.tloadframe
+ ttk::label $page.tloadframe.l -text [mc "Theme definition file"]
+ ttk::button $page.tloadframe.b -text [mc "Choose..."] \
+ -command [list choose_themeloader $page]
+ pack $page.tloadframe.l -side left
+ pack $page.tloadframe.b -side right -padx {0 5}
+ pack configure $page.tloadframe.l -padx 0
+ grid x $page.tloadframe $page.tloadvar -sticky ew
+ grid configure $page.tloadvar -padx {0 5}
+
+ ttk::label $page.themelabel2 -text \
+ [mc "The theme definition file may affect all themes."]
+ ttk::button $page.themebut2 -text [mc "Apply theme"] \
+ -command [list updatetheme $page]
+ grid x $page.themebut2 $page.themelabel2 -sticky w
+
+ ttk::label $page.cdisp -text [mc "Colors: press to choose"] -font mainfontbold
grid $page.cdisp - -sticky w -pady 10
- label $page.ui -padx 40 -relief sunk -background $uicolor
- ${NS}::button $page.uibut -text [mc "Interface"] \
- -command [list choosecolor uicolor {} $page.ui [mc "interface"] setui]
- grid x $page.uibut $page.ui -sticky w
label $page.bg -padx 40 -relief sunk -background $bgcolor
- ${NS}::button $page.bgbut -text [mc "Background"] \
- -command [list choosecolor bgcolor {} $page.bg [mc "background"] setbg]
+ ttk::button $page.bgbut -text [mc "Background"] \
+ -command [list choosecolor bgcolor {} $page [mc "background"]]
grid x $page.bgbut $page.bg -sticky w
+
label $page.fg -padx 40 -relief sunk -background $fgcolor
- ${NS}::button $page.fgbut -text [mc "Foreground"] \
- -command [list choosecolor fgcolor {} $page.fg [mc "foreground"] setfg]
+ ttk::button $page.fgbut -text [mc "Foreground"] \
+ -command [list choosecolor fgcolor {} $page [mc "foreground"]]
grid x $page.fgbut $page.fg -sticky w
+
label $page.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
- ${NS}::button $page.diffoldbut -text [mc "Diff: old lines"] \
- -command [list choosecolor diffcolors 0 $page.diffold [mc "diff old lines"] \
- [list $ctext tag conf d0 -foreground]]
+ ttk::button $page.diffoldbut -text [mc "Diff: old lines"] \
+ -command [list choosecolor diffcolors 0 $page [mc "diff old lines"]]
grid x $page.diffoldbut $page.diffold -sticky w
+
label $page.diffoldbg -padx 40 -relief sunk -background [lindex $diffbgcolors 0]
- ${NS}::button $page.diffoldbgbut -text [mc "Diff: old lines bg"] \
- -command [list choosecolor diffbgcolors 0 $page.diffoldbg \
- [mc "diff old lines bg"] \
- [list $ctext tag conf d0 -background]]
+ ttk::button $page.diffoldbgbut -text [mc "Diff: old lines bg"] \
+ -command [list choosecolor diffbgcolors 0 $page [mc "diff old lines bg"]]
grid x $page.diffoldbgbut $page.diffoldbg -sticky w
+
label $page.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
- ${NS}::button $page.diffnewbut -text [mc "Diff: new lines"] \
- -command [list choosecolor diffcolors 1 $page.diffnew [mc "diff new lines"] \
- [list $ctext tag conf dresult -foreground]]
+ ttk::button $page.diffnewbut -text [mc "Diff: new lines"] \
+ -command [list choosecolor diffcolors 1 $page [mc "diff new lines"]]
grid x $page.diffnewbut $page.diffnew -sticky w
+
label $page.diffnewbg -padx 40 -relief sunk -background [lindex $diffbgcolors 1]
- ${NS}::button $page.diffnewbgbut -text [mc "Diff: new lines bg"] \
- -command [list choosecolor diffbgcolors 1 $page.diffnewbg \
- [mc "diff new lines bg"] \
- [list $ctext tag conf dresult -background]]
+ ttk::button $page.diffnewbgbut -text [mc "Diff: new lines bg"] \
+ -command [list choosecolor diffbgcolors 1 $page [mc "diff new lines bg"]]
grid x $page.diffnewbgbut $page.diffnewbg -sticky w
+
label $page.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
- ${NS}::button $page.hunksepbut -text [mc "Diff: hunk header"] \
- -command [list choosecolor diffcolors 2 $page.hunksep \
- [mc "diff hunk header"] \
- [list $ctext tag conf hunksep -foreground]]
+ ttk::button $page.hunksepbut -text [mc "Diff: hunk header"] \
+ -command [list choosecolor diffcolors 2 $page [mc "diff hunk header"]]
grid x $page.hunksepbut $page.hunksep -sticky w
+
label $page.markbgsep -padx 40 -relief sunk -background $markbgcolor
- ${NS}::button $page.markbgbut -text [mc "Marked line bg"] \
- -command [list choosecolor markbgcolor {} $page.markbgsep \
- [mc "marked line background"] \
- [list $ctext tag conf omark -background]]
+ ttk::button $page.markbgbut -text [mc "Marked line bg"] \
+ -command [list choosecolor markbgcolor {} $page [mc "marked line background"]]
grid x $page.markbgbut $page.markbgsep -sticky w
+
label $page.selbgsep -padx 40 -relief sunk -background $selectbgcolor
- ${NS}::button $page.selbgbut -text [mc "Select bg"] \
- -command [list choosecolor selectbgcolor {} $page.selbgsep [mc "background"] setselbg]
+ ttk::button $page.selbgbut -text [mc "Select bg"] \
+ -command [list choosecolor selectbgcolor {} $page [mc "background"]]
grid x $page.selbgbut $page.selbgsep -sticky w
+
+ grid columnconfigure $page 2 -weight 1
+
return $page
}
+proc prefspage_set_colorswatches {page} {
+ global bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
+ global diffbgcolors
+
+ $page.bg configure -background $bgcolor
+ $page.fg configure -background $fgcolor
+ $page.diffold configure -background [lindex $diffcolors 0]
+ $page.diffoldbg configure -background [lindex $diffbgcolors 0]
+ $page.diffnew configure -background [lindex $diffcolors 1]
+ $page.diffnewbg configure -background [lindex $diffbgcolors 1]
+ $page.hunksep configure -background [lindex $diffcolors 2]
+ $page.markbgsep configure -background $markbgcolor
+ $page.selbgsep configure -background $selectbgcolor
+}
+
proc prefspage_fonts {notebook} {
- global NS
set page [create_prefs_page $notebook.fonts]
- ${NS}::label $page.cfont -text [mc "Fonts: press to choose"]
+ ttk::label $page.cfont -text [mc "Fonts: press to choose"] -font mainfontbold
grid $page.cfont - -sticky w -pady 10
mkfontdisp mainfont $page [mc "Main font"]
mkfontdisp textfont $page [mc "Diff display font"]
mkfontdisp uifont $page [mc "User interface font"]
+ grid columnconfigure $page 2 -weight 1
return $page
}
proc doprefs {} {
- global maxwidth maxgraphpct use_ttk NS
- global oldprefs prefstop showneartags showlocalchanges
- global uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
- global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
- global hideremotes want_ttk have_ttk
+ global oldprefs prefstop
+ global {*}$::config_variables
set top .gitkprefs
set prefstop $top
@@ -11733,57 +11863,43 @@ proc doprefs {} {
raise $top
return
}
- foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
- limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
+ foreach v $::config_variables {
set oldprefs($v) [set $v]
}
ttk_toplevel $top
wm title $top [mc "Gitk preferences"]
make_transient $top .
- if {[set use_notebook [expr {$use_ttk && [info command ::ttk::notebook] ne ""}]]} {
- set notebook [ttk::notebook $top.notebook]
- } else {
- set notebook [${NS}::frame $top.notebook -borderwidth 0 -relief flat]
- }
+ set notebook [ttk::notebook $top.notebook]
lappend pages [prefspage_general $notebook] [mc "General"]
lappend pages [prefspage_colors $notebook] [mc "Colors"]
lappend pages [prefspage_fonts $notebook] [mc "Fonts"]
set col 0
foreach {page title} $pages {
- if {$use_notebook} {
- $notebook add $page -text $title
- } else {
- set btn [${NS}::button $notebook.b_[string map {. X} $page] \
- -text $title -command [list raise $page]]
- $page configure -text $title
- grid $btn -row 0 -column [incr col] -sticky w
- grid $page -row 1 -column 0 -sticky news -columnspan 100
- }
+ $notebook add $page -text $title
}
- if {!$use_notebook} {
- grid columnconfigure $notebook 0 -weight 1
- grid rowconfigure $notebook 1 -weight 1
- raise [lindex $pages 0]
- }
+ grid columnconfigure $notebook 0 -weight 1
+ grid rowconfigure $notebook 1 -weight 1
+ raise [lindex $pages 0]
- grid $notebook -sticky news -padx 2 -pady 2
+ grid $notebook -sticky news -padx 3 -pady 3
grid rowconfigure $top 0 -weight 1
grid columnconfigure $top 0 -weight 1
- ${NS}::frame $top.buts
- ${NS}::button $top.buts.ok -text [mc "OK"] -command prefsok -default active
- ${NS}::button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
+ ttk::frame $top.buts
+ ttk::button $top.buts.ok -text [mc "OK"] -command prefsok -default active
+ ttk::button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
bind $top <Key-Return> prefsok
bind $top <Key-Escape> prefscan
- grid $top.buts.ok $top.buts.can
- grid columnconfigure $top.buts 0 -weight 1 -uniform a
- grid columnconfigure $top.buts 1 -weight 1 -uniform a
- grid $top.buts - - -pady 10 -sticky ew
- grid columnconfigure $top 2 -weight 1
+ grid $top.buts.ok $top.buts.can -padx 20
+ grid $top.buts -sticky w -pady 10
bind $top <Visibility> [list focus $top.buts.ok]
+
+ # let geometry manager determine run, set minimum size
+ update idletasks
+ wm minsize $top [winfo reqwidth $top] [winfo reqheight $top]
}
proc choose_extdiff {} {
@@ -11795,15 +11911,60 @@ proc choose_extdiff {} {
}
}
-proc choosecolor {v vi w x cmd} {
+proc run_themeloader {f} {
+ if {![info exists ::_themefiles_seen]} {
+ set ::_themefiles_seen [dict create]
+ }
+
+ set fn [file normalize $f]
+ if {![dict exists $::_themefiles_seen $fn]} {
+ if {[catch {source $fn} err]} {
+ error_popup "could not interpret: $fn\n$err"
+ dict set ::_themefiles_seen $fn 0
+ } else {
+ dict set ::_themefiles_seen $fn 1
+ }
+ }
+ return [dict get $::_themefiles_seen $fn]
+}
+
+proc updatetheme {prefspage {dotheme 1}} {
+ global theme
+ global themeloader
+ if {$themeloader ne {}} {
+ if {![run_themeloader $themeloader]} {
+ set themeloader {}
+ return
+ } else {
+ $prefspage.theme configure -values \
+ [lsort [ttk::style theme names]]
+ }
+ }
+ if {$dotheme} {
+ ttk::style theme use $theme
+ set_gui_colors
+ prefspage_set_colorswatches $prefspage
+ }
+}
+
+proc choose_themeloader {prefspage} {
+ global themeloader
+ set tfile [tk_getOpenFile -title [mc "Gitk: select theme definition"] -multiple false]
+ if {$tfile ne {}} {
+ set themeloader $tfile
+ updatetheme $prefspage 0
+ }
+}
+
+proc choosecolor {v vi prefspage x} {
global $v
set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
-title [mc "Gitk: choose color for %s" $x]]
if {$c eq {}} return
- $w conf -background $c
lset $v $vi $c
- eval $cmd $c
+ set_gui_colors
+ prefspage_set_colorswatches $prefspage
}
proc setselbg {c} {
@@ -11818,21 +11979,6 @@ proc setselbg {c} {
allcanvs itemconf secsel -fill $c
}
-# This sets the background color and the color scheme for the whole UI.
-# For some reason, tk_setPalette chooses a nasty dark red for selectColor
-# if we don't specify one ourselves, which makes the checkbuttons and
-# radiobuttons look bad. This chooses white for selectColor if the
-# background color is light, or black if it is dark.
-proc setui {c} {
- if {[tk windowingsystem] eq "win32"} { return }
- set bg [winfo rgb . $c]
- set selc black
- if {[lindex $bg 0] + 1.5 * [lindex $bg 1] + 0.5 * [lindex $bg 2] > 100000} {
- set selc white
- }
- tk_setPalette background $c selectColor $selc
-}
-
proc setbg {c} {
global bglist
@@ -11856,25 +12002,39 @@ proc setfg {c} {
$canv itemconf markid -outline $c
}
+proc set_gui_colors {} {
+ global bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
+ global diffbgcolors
+
+ setbg $bgcolor
+ setfg $fgcolor
+ $ctext tag conf d0 -foreground [lindex $diffcolors 0]
+ $ctext tag conf d0 -background [lindex $diffbgcolors 0]
+ $ctext tag conf dresult -foreground [lindex $diffcolors 1]
+ $ctext tag conf dresult -background [lindex $diffbgcolors 1]
+ $ctext tag conf hunksep -foreground [lindex $diffcolors 2]
+ $ctext tag conf omark -background $markbgcolor
+ setselbg $selectbgcolor
+}
+
proc prefscan {} {
global oldprefs prefstop
+ global {*}$::config_variables
- foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
- limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
- global $v
+ foreach v $::config_variables {
set $v $oldprefs($v)
}
catch {destroy $prefstop}
unset prefstop
fontcan
+ setttkstyle
+ set_gui_colors
}
proc prefsok {} {
- global maxwidth maxgraphpct
- global oldprefs prefstop showneartags showlocalchanges
- global fontpref mainfont textfont uifont
- global limitdiffs treediffs perfile_attrs
- global hideremotes
+ global oldprefs prefstop fontpref treediffs
+ global {*}$::config_variables
+ global ctext
catch {destroy $prefstop}
unset prefstop
@@ -11920,9 +12080,15 @@ proc prefsok {} {
$limitdiffs != $oldprefs(limitdiffs)} {
reselectline
}
- if {$hideremotes != $oldprefs(hideremotes)} {
+ if {$hideremotes != $oldprefs(hideremotes) || $refstohide != $oldprefs(refstohide)} {
rereadrefs
}
+ if {$wrapcomment != $oldprefs(wrapcomment)} {
+ $ctext tag conf comment -wrap $wrapcomment
+ }
+ if {$wrapdefault != $oldprefs(wrapdefault)} {
+ $ctext configure -wrap $wrapdefault
+ }
}
proc formatdate {d} {
@@ -12239,7 +12405,7 @@ proc gitattr {path attr default} {
set r $path_attr_cache($attr,$path)
} else {
set r "unspecified"
- if {![catch {set line [exec git check-attr $attr -- $path]}]} {
+ if {![catch {set line [safe_exec [list git check-attr $attr -- $path]]}]} {
regexp "(.*): $attr: (.*)" $line m f r
}
set path_attr_cache($attr,$path) $r
@@ -12266,11 +12432,11 @@ proc cache_gitattr {attr pathlist} {
while {$newlist ne {}} {
set head [lrange $newlist 0 [expr {$lim - 1}]]
set newlist [lrange $newlist $lim end]
- if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
+ if {![catch {set rlist [safe_exec [concat git check-attr $attr -- $head]]}]} {
foreach row [split $rlist "\n"] {
if {[regexp "(.*): $attr: (.*)" $row m path value]} {
if {[string index $path 0] eq "\""} {
- set path [encoding convertfrom [lindex $path 0]]
+ set path [convertfrom utf-8 [lindex $path 0]]
}
set path_attr_cache($attr,$path) $value
}
@@ -12291,6 +12457,23 @@ proc get_path_encoding {path} {
return $tcl_enc
}
+proc is_other_ref_visible {ref} {
+ global refstohide
+
+ if {$refstohide eq {}} {
+ return 1
+ }
+
+ foreach pat [split $refstohide " "] {
+ if {$pat eq {}} continue
+ if {[string match $pat $ref]} {
+ return 0
+ }
+ }
+
+ return 1
+}
+
## For msgcat loading, first locate the installation location.
if { [info exists ::env(GITK_MSGSDIR)] } {
## Msgsdir was manually set in the environment.
@@ -12300,7 +12483,6 @@ if { [info exists ::env(GITK_MSGSDIR)] } {
set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
set gitk_libdir [file join $gitk_prefix share gitk lib]
set gitk_msgsdir [file join $gitk_libdir msgs]
- unset gitk_prefix
}
## Internationalization (i18n) through msgcat and gettext. See
@@ -12310,20 +12492,15 @@ namespace import ::msgcat::mc
## And eventually load the actual message catalog
::msgcat::mcload $gitk_msgsdir
-# First check that Tcl/Tk is recent enough
-if {[catch {package require Tk 8.4} err]} {
- show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
- Gitk requires at least Tcl/Tk 8.4."]
- exit 1
-}
-
# on OSX bring the current Wish process window to front
if {[tk windowingsystem] eq "aqua"} {
- exec osascript -e [format {
- tell application "System Events"
- set frontmost of processes whose unix id is %d to true
- end tell
- } [pid] ]
+ catch {
+ safe_exec [list osascript -e [format {
+ tell application "System Events"
+ set frontmost of processes whose unix id is %d to true
+ end tell
+ } [pid] ]]
+ }
}
# Unset GIT_TRACE var if set
@@ -12362,6 +12539,17 @@ catch {
}
}
+# Use object format as hash algorightm (either "sha1" or "sha256")
+set hashalgorithm [exec git rev-parse --show-object-format]
+if {$hashalgorithm eq "sha1"} {
+ set hashlength 40
+} elseif {$hashalgorithm eq "sha256"} {
+ set hashlength 64
+} else {
+ puts stderr "Unknown hash algorithm: $hashalgorithm"
+ exit 1
+}
+
set log_showroot true
catch {
set log_showroot [exec git config --bool --get log.showroot]
@@ -12392,18 +12580,22 @@ set downarrowlen 5
set mingaplen 100
set cmitmode "patch"
set wrapcomment "none"
+set wrapdefault "none"
set showneartags 1
set hideremotes 0
+set refstohide ""
+set sortrefsbytype 1
set maxrefs 20
set visiblerefs {"master"}
set maxlinelen 200
set showlocalchanges 1
set limitdiffs 1
+set kscroll 3
set datetimeformat "%Y-%m-%d %H:%M:%S"
+set autocopy 0
set autoselect 1
-set autosellen 40
+set autosellen $hashlength
set perfile_attrs 0
-set want_ttk 1
if {[tk windowingsystem] eq "aqua"} {
set extdifftool "opendiff"
@@ -12413,17 +12605,11 @@ if {[tk windowingsystem] eq "aqua"} {
set colors {"#00ff00" red blue magenta darkgrey brown orange}
if {[tk windowingsystem] eq "win32"} {
- set uicolor SystemButtonFace
- set uifgcolor SystemButtonText
- set uifgdisabledcolor SystemDisabledText
set bgcolor SystemWindow
set fgcolor SystemWindowText
set selectbgcolor SystemHighlight
set web_browser "cmd /c start"
} else {
- set uicolor grey85
- set uifgcolor black
- set uifgdisabledcolor "#999"
set bgcolor white
set fgcolor black
set selectbgcolor gray85
@@ -12463,8 +12649,14 @@ set circleoutlinecolor $fgcolor
set foundbgcolor yellow
set currentsearchhitbgcolor orange
+set theme [ttk::style theme use]
+set themeloader {}
+set uicolor {}
+set uifgcolor {}
+set uifgdisabledcolor {}
+
# button for popping up context menus
-if {[tk windowingsystem] eq "aqua"} {
+if {[tk windowingsystem] eq "aqua" && [package vcompare $::tcl_version 8.7] < 0} {
set ctxbut <Button-2>
} else {
set ctxbut <Button-3>
@@ -12479,14 +12671,14 @@ catch {
set config_file_tmp [file join $env(XDG_CONFIG_HOME) git gitk-tmp]
} else {
# default XDG_CONFIG_HOME
- set config_file "~/.config/git/gitk"
- set config_file_tmp "~/.config/git/gitk-tmp"
+ set config_file "$env(HOME)/.config/git/gitk"
+ set config_file_tmp "$env(HOME)/.config/git/gitk-tmp"
}
if {![file exists $config_file]} {
# for backward compatibility use the old config file if it exists
- if {[file exists "~/.gitk"]} {
- set config_file "~/.gitk"
- set config_file_tmp "~/.gitk-tmp"
+ if {[file exists "$env(HOME)/.gitk"]} {
+ set config_file "$env(HOME)/.gitk"
+ set config_file_tmp "$env(HOME)/.gitk-tmp"
} elseif {![file exists [file dirname $config_file]]} {
file mkdir [file dirname $config_file]
}
@@ -12496,18 +12688,69 @@ catch {
config_check_tmp_exists 50
set config_variables {
- mainfont textfont uifont tabstop findmergefiles maxgraphpct maxwidth
- cmitmode wrapcomment autoselect autosellen showneartags maxrefs visiblerefs
- hideremotes showlocalchanges datetimeformat limitdiffs uicolor want_ttk
- bgcolor fgcolor uifgcolor uifgdisabledcolor colors diffcolors mergecolors
- markbgcolor diffcontext selectbgcolor foundbgcolor currentsearchhitbgcolor
- extdifftool perfile_attrs headbgcolor headfgcolor headoutlinecolor
- remotebgcolor tagbgcolor tagfgcolor tagoutlinecolor reflinecolor
- filesepbgcolor filesepfgcolor linehoverbgcolor linehoverfgcolor
- linehoveroutlinecolor mainheadcirclecolor workingfilescirclecolor
- indexcirclecolor circlecolors linkfgcolor circleoutlinecolor diffbgcolors
+ autocopy
+ autoselect
+ autosellen
+ bgcolor
+ circlecolors
+ circleoutlinecolor
+ cmitmode
+ colors
+ currentsearchhitbgcolor
+ datetimeformat
+ diffbgcolors
+ diffcolors
+ diffcontext
+ extdifftool
+ fgcolor
+ filesepbgcolor
+ filesepfgcolor
+ findmergefiles
+ foundbgcolor
+ headbgcolor
+ headfgcolor
+ headoutlinecolor
+ hideremotes
+ indexcirclecolor
+ kscroll
+ limitdiffs
+ linehoverbgcolor
+ linehoverfgcolor
+ linehoveroutlinecolor
+ linkfgcolor
+ mainfont
+ mainheadcirclecolor
+ markbgcolor
+ maxgraphpct
+ maxrefs
+ maxwidth
+ mergecolors
+ perfile_attrs
+ reflinecolor
+ refstohide
+ remotebgcolor
+ selectbgcolor
+ showlocalchanges
+ showneartags
+ sortrefsbytype
+ tabstop
+ tagbgcolor
+ tagfgcolor
+ tagoutlinecolor
+ textfont
+ theme
+ themeloader
+ uicolor
+ uifgcolor
+ uifgdisabledcolor
+ uifont
+ visiblerefs
web_browser
+ workingfilescirclecolor
+ wrapcomment
+ wrapdefault
}
+
foreach var $config_variables {
config_init_trace $var
trace add variable $var write config_variable_change_cb
@@ -12524,8 +12767,6 @@ eval font create textfontbold [fontflags textfont 1]
parsefont uifont $uifont
eval font create uifont [fontflags uifont]
-setui $uicolor
-
setoptions
# check that we can find a .git directory somewhere...
@@ -12568,7 +12809,7 @@ if {$selecthead eq "HEAD"} {
if {$i >= [llength $argv] && $revtreeargs ne {}} {
# no -- on command line, but some arguments (other than --argscmd)
if {[catch {
- set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
+ set f [safe_exec [concat git rev-parse --no-revs --no-flags $revtreeargs]]
set cmdline_files [split $f "\n"]
set n [llength $cmdline_files]
set revtreeargs [lrange $revtreeargs 0 end-$n]
@@ -12598,22 +12839,11 @@ set nullid "0000000000000000000000000000000000000000"
set nullid2 "0000000000000000000000000000000000000001"
set nullfile "/dev/null"
-set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
-if {![info exists have_ttk]} {
- set have_ttk [llength [info commands ::ttk::style]]
-}
-set use_ttk [expr {$have_ttk && $want_ttk}]
-set NS [expr {$use_ttk ? "ttk" : ""}]
-
-if {$use_ttk} {
- setttkstyle
-}
-
-regexp {^git version ([\d.]*\d)} [exec git version] _ git_version
-
-set show_notes {}
-if {[package vcompare $git_version "1.6.6.2"] >= 0} {
- set show_notes "--show-notes"
+if {[file exists $themeloader]} {
+ if {![run_themeloader $themeloader]} {
+ puts stderr "Could not interpret themeloader: $themeloader"
+ exit 1
+ }
}
set appname "gitk"
@@ -12663,31 +12893,35 @@ if {[expr {[exec git rev-parse --is-inside-work-tree] == "true"}]} {
set worktree [gitworktree]
setcoords
makewindow
-catch {
- image create photo gitlogo -width 16 -height 16
+if {$::tcl_platform(platform) eq {windows} && [file exists $gitk_prefix/etc/git.ico]} {
+ wm iconbitmap . -default $gitk_prefix/etc/git.ico
+} else {
+ catch {
+ image create photo gitlogo -width 16 -height 16
- image create photo gitlogominus -width 4 -height 2
- gitlogominus put #C00000 -to 0 0 4 2
- gitlogo copy gitlogominus -to 1 5
- gitlogo copy gitlogominus -to 6 5
- gitlogo copy gitlogominus -to 11 5
- image delete gitlogominus
+ image create photo gitlogominus -width 4 -height 2
+ gitlogominus put #C00000 -to 0 0 4 2
+ gitlogo copy gitlogominus -to 1 5
+ gitlogo copy gitlogominus -to 6 5
+ gitlogo copy gitlogominus -to 11 5
+ image delete gitlogominus
- image create photo gitlogoplus -width 4 -height 4
- gitlogoplus put #008000 -to 1 0 3 4
- gitlogoplus put #008000 -to 0 1 4 3
- gitlogo copy gitlogoplus -to 1 9
- gitlogo copy gitlogoplus -to 6 9
- gitlogo copy gitlogoplus -to 11 9
- image delete gitlogoplus
+ image create photo gitlogoplus -width 4 -height 4
+ gitlogoplus put #008000 -to 1 0 3 4
+ gitlogoplus put #008000 -to 0 1 4 3
+ gitlogo copy gitlogoplus -to 1 9
+ gitlogo copy gitlogoplus -to 6 9
+ gitlogo copy gitlogoplus -to 11 9
+ image delete gitlogoplus
- image create photo gitlogo32 -width 32 -height 32
- gitlogo32 copy gitlogo -zoom 2 2
+ image create photo gitlogo32 -width 32 -height 32
+ gitlogo32 copy gitlogo -zoom 2 2
- wm iconphoto . -default gitlogo gitlogo32
+ wm iconphoto . -default gitlogo gitlogo32
+ }
}
# wait for the window to become visible
-tkwait visibility .
+if {![winfo viewable .]} {tkwait visibility .}
set_window_title
update
readrefs
@@ -12727,6 +12961,9 @@ if {[tk windowingsystem] eq "win32"} {
focus -force .
}
+setttkstyle
+set_gui_colors
+
getcommits {}
# Local variables:
generated by cgit v1.2.3 (git 2.46.0) at 2025-10-30 01:37:51 +0000