diff options
Diffstat (limited to 'git-gui/git-gui.sh')
| -rwxr-xr-x | git-gui/git-gui.sh | 944 |
1 files changed, 379 insertions, 565 deletions
diff --git a/git-gui/git-gui.sh b/git-gui/git-gui.sh index 8fe7538e72..d3d3aa14a9 100755 --- a/git-gui/git-gui.sh +++ b/git-gui/git-gui.sh @@ -30,9 +30,7 @@ along with this program; if not, see <https://www.gnu.org/licenses/>.}] ## ## Tcl/Tk sanity check -if {[catch {package require Tcl 8.5} err] - || [catch {package require Tk 8.5} err] -} { +if {[catch {package require Tcl 8.6-} err]} { catch {wm withdraw .} tk_messageBox \ -icon error \ @@ -76,100 +74,189 @@ proc is_Cygwin {} { } ###################################################################### +## 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] + } +} + +###################################################################### ## -## PATH lookup +## PATH lookup. Sanitize $PATH, assure exec/open use only that -set _search_path {} -proc _which {what args} { - global env _search_exe _search_path +if {[is_Windows]} { + set _path_sep {;} +} else { + set _path_sep {:} +} - if {$_search_path eq {}} { - if {[is_Windows]} { - 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 ""] - set _search_exe .exe - } else { - set _search_path [split $env(PATH) :] - set _search_exe {} - } +set _path_seen [dict create] +foreach p [split $env(PATH) $_path_sep] { + # Keep only absolute paths, getting rid of ., empty, etc. + if {[file pathtype $p] ne {absolute}} { + continue } + # Keep only the first occurence of any duplicates. + set norm_p [file normalize $p] + dict set _path_seen $norm_p 1 +} +set _search_path [dict keys $_path_seen] +unset _path_seen - if {[is_Windows] && [lsearch -exact $args -script] >= 0} { - set suffix {} - } else { - set suffix $_search_exe - } +set env(PATH) [join $_search_path $_path_sep] + +if {[is_Windows]} { + proc _which {what args} { + global _search_path + + if {[lsearch -exact $args -script] >= 0} { + set suffix {} + } elseif {[string match *.exe [string tolower $what]]} { + # The search string already has the file extension + 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] + foreach p $_search_path { + set p [file join $p $what$suffix] + if {[file exists $p]} { + return [file normalize $p] + } } + return {} } - 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" + 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 + } } - lset command_line $i $fullpath } + return $command_line + } + + # Override `exec` to avoid unsafe PATH lookup + + rename exec real_exec - # handle piped commands, e.g. `exec A | B` - for {incr i} {$i < [llength $command_line]} {incr i} { - if {[lindex $command_line $i] eq "|"} { + 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 } - return $command_line -} -# Override `exec` to avoid unsafe PATH lookup + # Override `open` to avoid unsafe PATH lookup -rename exec real_exec + rename open real_open -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 + 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]" } + set fd [real_open {*}$args] + fconfigure $fd -eofchar {} + return $fd + } + +} else { + # On non-Windows platforms, auto_execok, exec, and open are safe, and will + # use the sanitized search path. But, we need _which for these. + + proc _which {what args} { + return [lindex [auto_execok $what] 0] } - set args [sanitize_command_line $args $i] - uplevel 1 real_exec $args } -# Override `open` to avoid unsafe PATH lookup +# Wrap exec/open to sanitize arguments -rename open real_open +# unsafe arguments begin with redirections or the pipe or background operators +proc is_arg_unsafe {arg} { + regexp {^([<|>&]|2>)} $arg +} -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]" +proc make_arg_safe {arg} { + if {[is_arg_unsafe $arg]} { + set arg [file join . $arg] } - uplevel 1 real_open $args + 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 in the background +# 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_bg {cmd} { + eval exec [make_arglist_safe $cmd] & +} + +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 +} + +# End exec/open wrappers + ###################################################################### ## ## locate our library @@ -270,11 +357,11 @@ unset oguimsg if {[tk windowingsystem] eq "aqua"} { catch { - exec osascript -e [format { + safe_exec [list osascript -e [format { tell application "System Events" set frontmost of processes whose unix id is %d to true end tell - } [pid]] + } [pid]]] } } @@ -286,7 +373,6 @@ set _appname {Git Gui} set _gitdir {} set _gitworktree {} set _isbare {} -set _gitexec {} set _githtmldir {} set _reponame {} set _shellpath {@@SHELL_PATH@@} @@ -304,15 +390,37 @@ if {$_trace >= 0} { # branches). set _last_merged_branch {} -proc shellpath {} { - global _shellpath env - if {[string match @@* $_shellpath]} { - if {[info exists env(SHELL)]} { - return $env(SHELL) - } else { - return /bin/sh - } +# for testing, allow unconfigured _shellpath +if {[string match @@* $_shellpath]} { + if {[info exists env(SHELL)]} { + set _shellpath $env(SHELL) + } else { + set _shellpath /bin/sh } +} + +if {[is_Windows]} { + set _shellpath [safe_exec [list cygpath -m $_shellpath]] +} + +if {![file executable $_shellpath] || \ + !([file pathtype $_shellpath] eq {absolute})} { + set errmsg "The defined shell ('$_shellpath') is not usable, \ + it must be an absolute path to an executable." + puts stderr $errmsg + + catch {wm withdraw .} + tk_messageBox \ + -icon error \ + -type ok \ + -title "git-gui: configuration error" \ + -message $errmsg + exit 1 +} + + +proc shellpath {} { + global _shellpath return $_shellpath } @@ -329,20 +437,6 @@ proc gitdir {args} { return [eval [list file join $_gitdir] $args] } -proc gitexec {args} { - global _gitexec - if {$_gitexec eq {}} { - if {[catch {set _gitexec [git --exec-path]} err]} { - error "Git not installed?\n\n$err" - } - set _gitexec [file normalize $_gitexec] - } - if {$args eq {}} { - return $_gitexec - } - return [eval [list file join $_gitexec] $args] -} - proc githtmldir {args} { global _githtmldir if {$_githtmldir eq {}} { @@ -475,104 +569,23 @@ proc _trace_exec {cmd} { #'" fix poor old emacs font-lock mode -proc _git_cmd {name} { - global _git_cmd_path - - if {[catch {set v $_git_cmd_path($name)}]} { - switch -- $name { - version - - --version - - --exec-path { return [list $::_git $name] } - } - - set p [gitexec git-$name$::_search_exe] - if {[file exists $p]} { - set v [list $p] - } elseif {[is_Windows] && [file exists [gitexec git-$name]]} { - # Try to determine what sort of magic will make - # git-$name go and do its thing, because native - # Tcl on Windows doesn't know it. - # - set p [gitexec git-$name] - set f [open $p r] - set s [gets $f] - close $f - - switch -glob -- [lindex $s 0] { - #!*sh { set i sh } - #!*perl { set i perl } - #!*python { set i python } - default { error "git-$name is not supported: $s" } - } - - upvar #0 _$i interp - if {![info exists interp]} { - set interp [_which $i] - } - if {$interp eq {}} { - error "git-$name requires $i (not in PATH)" - } - set v [concat [list $interp] [lrange $s 1 end] [list $p]] - } else { - # Assume it is builtin to git somehow and we - # aren't actually able to see a file for it. - # - set v [list $::_git $name] - } - set _git_cmd_path($name) $v - } - return $v -} - -# Test a file for a hashbang to identify executable scripts on Windows. -proc is_shellscript {filename} { - if {![file exists $filename]} {return 0} - set f [open $filename r] - fconfigure $f -encoding binary - set magic [read $f 2] - close $f - return [expr {$magic eq "#!"}] -} - -# Run a command connected via pipes on stdout. # This is for use with textconv filters and uses sh -c "..." to allow it to -# contain a command with arguments. On windows we must check for shell -# scripts specifically otherwise just call the filter command. +# contain a command with arguments. We presume this +# to be a shellscript that the configured shell (/bin/sh by default) knows +# how to run. proc open_cmd_pipe {cmd path} { - global env - if {![file executable [shellpath]]} { - set exe [auto_execok [lindex $cmd 0]] - if {[is_shellscript [lindex $exe 0]]} { - set run [linsert [auto_execok sh] end -c "$cmd \"\$0\"" $path] - } else { - set run [concat $exe [lrange $cmd 1 end] $path] - } - } else { - set run [list [shellpath] -c "$cmd \"\$0\"" $path] - } + set run [list [shellpath] -c "$cmd \"\$0\"" $path] + set run [make_arglist_safe $run] return [open |$run r] } -proc _lappend_nice {cmd_var} { - global _nice - upvar $cmd_var cmd - - if {![info exists _nice]} { - set _nice [_which nice] - if {[catch {exec $_nice git version}]} { - set _nice {} - } elseif {[is_Windows] && [file dirname $_nice] ne [file dirname $::_git]} { - set _nice {} - } - } - if {$_nice ne {}} { - lappend cmd $_nice - } +proc git {args} { + git_redir $args {} } -proc git {args} { - set fd [eval [list git_read] $args] - fconfigure $fd -translation binary -encoding utf-8 +proc git_redir {cmd redir} { + set fd [git_read $cmd $redir] + fconfigure $fd -encoding utf-8 set result [string trimright [read $fd] "\n"] close $fd if {$::_trace} { @@ -581,88 +594,45 @@ proc git {args} { return $result } -proc _open_stdout_stderr {cmd} { - _trace_exec $cmd +proc safe_open_command {cmd {redir {}}} { + set cmd [make_arglist_safe $cmd] + _trace_exec [concat $cmd $redir] if {[catch { - set fd [open [concat [list | ] $cmd] r] - } err]} { - if { [lindex $cmd end] eq {2>@1} - && $err eq {can not find channel named "1"} - } { - # Older versions of Tcl 8.4 don't have this 2>@1 IO - # redirect operator. Fallback to |& cat for those. - # The command was not actually started, so its safe - # to try to start it a second time. - # - set fd [open [concat \ - [list | ] \ - [lrange $cmd 0 end-1] \ - [list |& cat] \ - ] r] - } else { - error $err - } + set fd [open [concat [list | ] $cmd $redir] r] + } err]} { + error $err } - fconfigure $fd -eofchar {} return $fd } -proc git_read {args} { - set opt [list] +proc git_read {cmd {redir {}}} { + global _git + set cmdp [concat [list $_git] $cmd] - while {1} { - switch -- [lindex $args 0] { - --nice { - _lappend_nice opt - } - - --stderr { - lappend args 2>@1 - } - - default { - break - } - - } - - set args [lrange $args 1 end] - } - - set cmdp [_git_cmd [lindex $args 0]] - set args [lrange $args 1 end] - - return [_open_stdout_stderr [concat $opt $cmdp $args]] + return [safe_open_command $cmdp $redir] } -proc git_write {args} { - set opt [list] - - while {1} { - switch -- [lindex $args 0] { - --nice { - _lappend_nice opt - } - - default { - break - } - - } +set _nice [list [_which nice]] +if {[catch {safe_exec [list {*}$_nice git version]}]} { + set _nice {} +} - set args [lrange $args 1 end] - } +proc git_read_nice {cmd} { + set cmdp [list {*}$::_nice $::_git {*}$cmd] + return [safe_open_command $cmdp] +} - set cmdp [_git_cmd [lindex $args 0]] - set args [lrange $args 1 end] +proc git_write {cmd} { + global _git + set cmd [make_arglist_safe $cmd] + set cmdp [concat [list $_git] $cmd] - _trace_exec [concat $opt $cmdp $args] - return [open [concat [list | ] $opt $cmdp $args] w] + _trace_exec $cmdp + return [open [concat [list | ] $cmdp] w] } proc githook_read {hook_name args} { - set cmd [concat git hook run --ignore-missing $hook_name -- $args 2>@1] - return [_open_stdout_stderr $cmd] + git_read [concat [list hook run --ignore-missing $hook_name --] $args] [list 2>@1] } proc kill_file_process {fd} { @@ -670,9 +640,9 @@ proc kill_file_process {fd} { catch { if {[is_Windows]} { - exec taskkill /pid $process + safe_exec [list taskkill /pid $process] } else { - exec kill $process + safe_exec [list kill $process] } } } @@ -698,27 +668,8 @@ proc sq {value} { proc load_current_branch {} { global current_branch is_detached - set fd [open [gitdir HEAD] r] - fconfigure $fd -translation binary -encoding utf-8 - if {[gets $fd ref] < 1} { - set ref {} - } - close $fd - - set pfx {ref: refs/heads/} - set len [string length $pfx] - if {[string equal -length $len $pfx $ref]} { - # We're on a branch. It might not exist. But - # HEAD looks good enough to be a branch. - # - set current_branch [string range $ref $len end] - set is_detached 0 - } else { - # Assume this is a detached head. - # - set current_branch HEAD - set is_detached 1 - } + set current_branch [git branch --show-current] + set is_detached [expr [string length $current_branch] == 0] } auto_load tk_optionMenu @@ -868,17 +819,14 @@ proc apply_config {} { font configure ${font}italic -slant italic } - global use_ttk NS - set use_ttk 0 - set NS {} - if {$repo_config(gui.usettk)} { - set use_ttk [package vsatisfies [package provide Tk] 8.5] - if {$use_ttk} { - set NS ttk - bind [winfo class .] <<ThemeChanged>> [list InitTheme] - pave_toplevel . - color::sync_with_theme - } + bind [winfo class .] <<ThemeChanged>> [list InitTheme] + pave_toplevel . + color::sync_with_theme + + global comment_string + set comment_string [get_config core.commentstring] + if {$comment_string eq {}} { + set comment_string [get_config core.commentchar] } } @@ -890,6 +838,8 @@ set default_config(merge.summary) false set default_config(merge.verbosity) 2 set default_config(user.name) {} set default_config(user.email) {} +set default_config(core.commentchar) "#" +set default_config(core.commentstring) {} set default_config(gui.encoding) [encoding system] set default_config(gui.matchtrackingbranch) false @@ -938,6 +888,8 @@ if {$_git eq {}} { ## ## version check +set MIN_GIT_VERSION 2.36 + if {[catch {set _git_version [git --version]} err]} { catch {wm withdraw .} tk_messageBox \ @@ -948,9 +900,10 @@ if {[catch {set _git_version [git --version]} err]} { $err -[appname] requires Git 1.5.0 or later." +[appname] requires Git $MIN_GIT_VERSION or later." exit 1 } + if {![regsub {^git version } $_git_version {} _git_version]} { catch {wm withdraw .} tk_messageBox \ @@ -975,92 +928,28 @@ proc get_trimmed_version {s} { set _real_git_version $_git_version set _git_version [get_trimmed_version $_git_version] -if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} { - catch {wm withdraw .} - if {[tk_messageBox \ - -icon warning \ - -type yesno \ - -default no \ - -title "[appname]: warning" \ - -message [mc "Git version cannot be determined. - -%s claims it is version '%s'. - -%s requires at least Git 1.5.0 or later. - -Assume '%s' is version 1.5.0? -" $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} { - set _git_version 1.5.0 - } else { - exit 1 - } -} -unset _real_git_version - -proc git-version {args} { - global _git_version - - switch [llength $args] { - 0 { - return $_git_version - } - - 2 { - set op [lindex $args 0] - set vr [lindex $args 1] - set cm [package vcompare $_git_version $vr] - return [expr $cm $op 0] - } - - 4 { - set type [lindex $args 0] - set name [lindex $args 1] - set parm [lindex $args 2] - set body [lindex $args 3] - - if {($type ne {proc} && $type ne {method})} { - error "Invalid arguments to git-version" - } - if {[llength $body] < 2 || [lindex $body end-1] ne {default}} { - error "Last arm of $type $name must be default" - } - - foreach {op vr cb} [lrange $body 0 end-2] { - if {[git-version $op $vr]} { - return [uplevel [list $type $name $parm $cb]] - } - } - - return [uplevel [list $type $name $parm [lindex $body end]]] - } +if {[catch {set vcheck [package vcompare $_git_version $MIN_GIT_VERSION]}] || + [expr $vcheck < 0] } { - default { - error "git-version >= x" - } - - } -} - -if {[git-version < 1.5]} { + set msg1 [mc "Insufficient git version, require: "] + set msg2 [mc "git returned:"] + set message "$msg1 $MIN_GIT_VERSION\n$msg2 $_real_git_version" catch {wm withdraw .} tk_messageBox \ -icon error \ -type ok \ -title [mc "git-gui: fatal error"] \ - -message "[appname] requires Git 1.5.0 or later. - -You are using [git-version]: - -[git --version]" + -message $message exit 1 } +unset _real_git_version ###################################################################### ## ## configure our library set idx [file join $oguilib tclIndex] -if {[catch {set fd [open $idx r]} err]} { +if {[catch {set fd [safe_open_file $idx r]} err]} { catch {wm withdraw .} tk_messageBox \ -icon error \ @@ -1098,53 +987,30 @@ unset -nocomplain idx fd ## ## config file parsing -git-version proc _parse_config {arr_name args} { - >= 1.5.3 { - upvar $arr_name arr - array unset arr - set buf {} - catch { - set fd_rc [eval \ - [list git_read config] \ - $args \ - [list --null --list]] - fconfigure $fd_rc -translation binary -encoding utf-8 - set buf [read $fd_rc] - close $fd_rc - } - foreach line [split $buf "\0"] { - if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} { - if {[is_many_config $name]} { - lappend arr($name) $value - } else { - set arr($name) $value - } - } elseif {[regexp {^([^\n]+)$} $line line name]} { - # no value given, but interpreting them as - # boolean will be handled as true - set arr($name) {} - } - } - } - default { - upvar $arr_name arr - array unset arr - catch { - set fd_rc [eval [list git_read config --list] $args] - while {[gets $fd_rc line] >= 0} { - if {[regexp {^([^=]+)=(.*)$} $line line name value]} { - if {[is_many_config $name]} { - lappend arr($name) $value - } else { - set arr($name) $value - } - } elseif {[regexp {^([^=]+)$} $line line name]} { - # no value given, but interpreting them as - # boolean will be handled as true - set arr($name) {} - } +proc _parse_config {arr_name args} { + upvar $arr_name arr + array unset arr + set buf {} + catch { + set fd_rc [git_read \ + [concat config \ + $args \ + --null --list]] + fconfigure $fd_rc -encoding utf-8 + set buf [read $fd_rc] + close $fd_rc + } + foreach line [split $buf "\0"] { + if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} { + if {[is_many_config $name]} { + lappend arr($name) $value + } else { + set arr($name) $value } - close $fd_rc + } elseif {[regexp {^([^\n]+)$} $line line name]} { + # no value given, but interpreting them as + # boolean will be handled as true + set arr($name) {} } } } @@ -1239,12 +1105,18 @@ citool { ## ## execution environment -set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}] - # Suggest our implementation of askpass, if none is set +set argv0dir [file dirname [file normalize $::argv0]] if {![info exists env(SSH_ASKPASS)]} { - set env(SSH_ASKPASS) [gitexec git-gui--askpass] + set env(SSH_ASKPASS) [file join $argv0dir git-gui--askpass] +} +if {![info exists env(GIT_ASKPASS)]} { + set env(GIT_ASKPASS) [file join $argv0dir git-gui--askpass] } +if {![info exists env(GIT_ASK_YESNO)]} { + set env(GIT_ASK_YESNO) [file join $argv0dir git-gui--askyesno] +} +unset argv0dir ###################################################################### ## @@ -1264,9 +1136,23 @@ if {[catch { load_config 1 apply_config choose_repository::pick + if {![file isdirectory $_gitdir]} { + exit 1 + } set picked 1 } +# Use object format as hash algorithm (either "sha1" or "sha256") +set hashalgorithm [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 +} + # we expand the _gitdir when it's just a single dot (i.e. when we're being # run from the .git dir itself) lest the routines to find the worktree # get confused @@ -1283,20 +1169,7 @@ if {![file isdirectory $_gitdir]} { load_config 0 apply_config -# v1.7.0 introduced --show-toplevel to return the canonical work-tree -if {[package vcompare $_git_version 1.7.0] >= 0} { - set _gitworktree [git rev-parse --show-toplevel] -} else { - # try to set work tree from environment, core.worktree or use - # cdup to obtain a relative path to the top of the worktree. If - # run from the top, the ./ prefix ensures normalize expands pwd. - if {[catch { set _gitworktree $env(GIT_WORK_TREE) }]} { - set _gitworktree [get_config core.worktree] - if {$_gitworktree eq ""} { - set _gitworktree [file normalize ./[git rev-parse --show-cdup]] - } - } -} +set _gitworktree [git rev-parse --show-toplevel] if {$_prefix ne {}} { if {$_gitworktree eq {}} { @@ -1357,12 +1230,11 @@ set current_diff_path {} set is_3way_diff 0 set is_submodule_diff 0 set is_conflict_diff 0 -set diff_empty_count 0 set last_revert {} set last_revert_enc {} -set nullid "0000000000000000000000000000000000000000" -set nullid2 "0000000000000000000000000000000000000001" +set nullid [string repeat 0 $hashlength] +set nullid2 "[string repeat 0 [expr $hashlength - 1]]1" ###################################################################### ## @@ -1420,7 +1292,7 @@ proc repository_state {ctvar hdvar mhvar} { set merge_head [gitdir MERGE_HEAD] if {[file exists $merge_head]} { set ct merge - set fd_mh [open $merge_head r] + set fd_mh [safe_open_file $merge_head r] while {[gets $fd_mh line] >= 0} { lappend mh $line } @@ -1439,7 +1311,7 @@ proc PARENT {} { return $p } if {$empty_tree eq {}} { - set empty_tree [git mktree << {}] + set empty_tree [git_redir [list mktree] [list << {}]] } return $empty_tree } @@ -1498,12 +1370,12 @@ proc rescan {after {honor_trustmtime 1}} { } else { set rescan_active 1 ui_status [mc "Refreshing file status..."] - set fd_rf [git_read update-index \ + set fd_rf [git_read [list update-index \ -q \ --unmerged \ --ignore-missing \ --refresh \ - ] + ]] fconfigure $fd_rf -blocking 0 -translation binary fileevent $fd_rf readable \ [list rescan_stage2 $fd_rf $after] @@ -1523,18 +1395,7 @@ proc rescan_stage2 {fd after} { close $fd } - if {[package vcompare $::_git_version 1.6.3] >= 0} { - set ls_others [list --exclude-standard] - } else { - set ls_others [list --exclude-per-directory=.gitignore] - if {[have_info_exclude]} { - lappend ls_others "--exclude-from=[gitdir info exclude]" - } - set user_exclude [get_config core.excludesfile] - if {$user_exclude ne {} && [file readable $user_exclude]} { - lappend ls_others "--exclude-from=[file normalize $user_exclude]" - } - } + set ls_others [list --exclude-standard] set buf_rdi {} set buf_rdf {} @@ -1542,22 +1403,18 @@ proc rescan_stage2 {fd after} { set rescan_active 2 ui_status [mc "Scanning for modified files ..."] - if {[git-version >= "1.7.2"]} { - set fd_di [git_read diff-index --cached --ignore-submodules=dirty -z [PARENT]] - } else { - set fd_di [git_read diff-index --cached -z [PARENT]] - } - set fd_df [git_read diff-files -z] + set fd_di [git_read [list diff-index --cached --ignore-submodules=dirty -z [PARENT]]] + set fd_df [git_read [list diff-files -z]] - fconfigure $fd_di -blocking 0 -translation binary -encoding binary - fconfigure $fd_df -blocking 0 -translation binary -encoding binary + fconfigure $fd_di -blocking 0 -translation binary + fconfigure $fd_df -blocking 0 -translation binary fileevent $fd_di readable [list read_diff_index $fd_di $after] fileevent $fd_df readable [list read_diff_files $fd_df $after] if {[is_config_true gui.displayuntracked]} { - set fd_lo [eval git_read ls-files --others -z $ls_others] - fconfigure $fd_lo -blocking 0 -translation binary -encoding binary + set fd_lo [git_read [concat ls-files --others -z $ls_others]] + fconfigure $fd_lo -blocking 0 -translation binary fileevent $fd_lo readable [list read_ls_others $fd_lo $after] incr rescan_active } @@ -1568,10 +1425,9 @@ proc load_message {file {encoding {}}} { set f [gitdir $file] if {[file isfile $f]} { - if {[catch {set fd [open $f r]}]} { + if {[catch {set fd [safe_open_file $f r]}]} { return 0 } - fconfigure $fd -eofchar {} if {$encoding ne {}} { fconfigure $fd -encoding $encoding } @@ -1592,23 +1448,23 @@ proc run_prepare_commit_msg_hook {} { # it will be .git/MERGE_MSG (merge), .git/SQUASH_MSG (squash), or an # empty file but existent file. - set fd_pcm [open [gitdir PREPARE_COMMIT_MSG] a] + set fd_pcm [safe_open_file [gitdir PREPARE_COMMIT_MSG] a] if {[file isfile [gitdir MERGE_MSG]]} { set pcm_source "merge" - set fd_mm [open [gitdir MERGE_MSG] r] + set fd_mm [safe_open_file [gitdir MERGE_MSG] r] fconfigure $fd_mm -encoding utf-8 puts -nonewline $fd_pcm [read $fd_mm] close $fd_mm } elseif {[file isfile [gitdir SQUASH_MSG]]} { set pcm_source "squash" - set fd_sm [open [gitdir SQUASH_MSG] r] + set fd_sm [safe_open_file [gitdir SQUASH_MSG] r] fconfigure $fd_sm -encoding utf-8 puts -nonewline $fd_pcm [read $fd_sm] close $fd_sm } elseif {[file isfile [get_config commit.template]]} { set pcm_source "template" - set fd_sm [open [get_config commit.template] r] + set fd_sm [safe_open_file [get_config commit.template] r] fconfigure $fd_sm -encoding utf-8 puts -nonewline $fd_pcm [read $fd_sm] close $fd_sm @@ -1628,7 +1484,7 @@ proc run_prepare_commit_msg_hook {} { ui_status [mc "Calling prepare-commit-msg hook..."] set pch_error {} - fconfigure $fd_ph -blocking 0 -translation binary -eofchar {} + fconfigure $fd_ph -blocking 0 -translation binary fileevent $fd_ph readable \ [list prepare_commit_msg_hook_wait $fd_ph] @@ -1674,7 +1530,7 @@ proc read_diff_index {fd after} { set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }] set p [string range $buf_rdi $z1 [expr {$z2 - 1}]] merge_state \ - [encoding convertfrom utf-8 $p] \ + [convertfrom utf-8 $p] \ [lindex $i 4]? \ [list [lindex $i 0] [lindex $i 2]] \ [list] @@ -1707,7 +1563,7 @@ proc read_diff_files {fd after} { set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }] set p [string range $buf_rdf $z1 [expr {$z2 - 1}]] merge_state \ - [encoding convertfrom utf-8 $p] \ + [convertfrom utf-8 $p] \ ?[lindex $i 4] \ [list] \ [list [lindex $i 0] [lindex $i 2]] @@ -1730,7 +1586,7 @@ proc read_ls_others {fd after} { set pck [split $buf_rlo "\0"] set buf_rlo [lindex $pck end] foreach p [lrange $pck 0 end-1] { - set p [encoding convertfrom utf-8 $p] + set p [convertfrom utf-8 $p] if {[string index $p end] eq {/}} { set p [string range $p 0 end-1] } @@ -1815,10 +1671,9 @@ proc short_path {path} { } set next_icon_id 0 -set null_sha1 [string repeat 0 40] proc merge_state {path new_state {head_info {}} {index_info {}}} { - global file_states next_icon_id null_sha1 + global file_states next_icon_id nullid set s0 [string index $new_state 0] set s1 [string index $new_state 1] @@ -1840,7 +1695,7 @@ proc merge_state {path new_state {head_info {}} {index_info {}}} { elseif {$s1 eq {_}} {set s1 _} if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} { - set head_info [list 0 $null_sha1] + set head_info [list 0 $nullid] } elseif {$s0 ne {_} && [string index $state 0] eq {_} && $head_info eq {}} { set head_info $index_info @@ -2198,7 +2053,7 @@ proc do_gitk {revs {is_submodule false}} { unset env(GIT_DIR) unset env(GIT_WORK_TREE) } - eval exec $cmd $revs "--" "--" & + safe_exec_bg [concat $cmd $revs "--" "--"] set env(GIT_DIR) $_gitdir set env(GIT_WORK_TREE) $_gitworktree @@ -2235,7 +2090,7 @@ proc do_git_gui {} { set pwd [pwd] cd $current_diff_path - eval exec $exe gui & + safe_exec_bg [concat $exe gui] set env(GIT_DIR) $_gitdir set env(GIT_WORK_TREE) $_gitworktree @@ -2266,16 +2121,18 @@ proc get_explorer {} { proc do_explore {} { global _gitworktree - set explorer [get_explorer] - eval exec $explorer [list [file nativename $_gitworktree]] & + set cmd [get_explorer] + lappend cmd [file nativename $_gitworktree] + safe_exec_bg $cmd } # Open file relative to the working tree by the default associated app. proc do_file_open {file} { global _gitworktree - set explorer [get_explorer] + set cmd [get_explorer] set full_file_path [file join $_gitworktree $file] - exec $explorer [file nativename $full_file_path] & + lappend cmd [file nativename $full_file_path] + safe_exec_bg $cmd } set is_quitting 0 @@ -2291,7 +2148,7 @@ proc do_quit {{rc {1}}} { global ui_comm is_quitting repo_config commit_type global GITGUI_BCK_exists GITGUI_BCK_i global ui_comm_spell - global ret_code use_ttk + global ret_code if {$is_quitting} return set is_quitting 1 @@ -2309,7 +2166,7 @@ proc do_quit {{rc {1}}} { if {![string match amend* $commit_type] && $msg ne {}} { catch { - set fd [open $save w] + set fd [safe_open_file $save w] fconfigure $fd -encoding utf-8 puts -nonewline $fd $msg close $fd @@ -2349,13 +2206,8 @@ proc do_quit {{rc {1}}} { } set cfg_geometry [list] lappend cfg_geometry [wm geometry .] - if {$use_ttk} { - lappend cfg_geometry [.vpane sashpos 0] - lappend cfg_geometry [.vpane.files sashpos 0] - } else { - lappend cfg_geometry [lindex [.vpane sash coord 0] 0] - lappend cfg_geometry [lindex [.vpane.files sash coord 0] 1] - } + lappend cfg_geometry [.vpane sashpos 0] + lappend cfg_geometry [.vpane.files sashpos 0] if {[catch {set rc_geometry $repo_config(gui.geometry)}]} { set rc_geometry {} } @@ -2753,17 +2605,16 @@ if {![is_bare]} { if {[is_Windows]} { # Use /git-bash.exe if available - set normalized [file normalize $::argv0] - regsub "/mingw../libexec/git-core/git-gui$" \ - $normalized "/git-bash.exe" cmdLine - if {$cmdLine != $normalized && [file exists $cmdLine]} { - set cmdLine [list "Git Bash" $cmdLine &] + set _git_bash [safe_exec [list cygpath -m /git-bash.exe]] + if {[file executable $_git_bash]} { + set _bash_cmdline [list "Git Bash" $_git_bash] } else { - set cmdLine [list "Git Bash" bash --login -l &] + set _bash_cmdline [list "Git Bash" bash --login -l] } .mbar.repository add command \ -label [mc "Git Bash"] \ - -command {eval exec [auto_execok start] $cmdLine} + -command {safe_exec_bg [concat [list [_which cmd] /c start] $_bash_cmdline]} + unset _git_bash } if {[is_Windows] || ![is_bare]} { @@ -3172,7 +3023,7 @@ blame { if {$head eq {}} { load_current_branch } else { - if {[regexp {^[0-9a-f]{1,39}$} $head]} { + if {[regexp [string map "@@ [expr $hashlength - 1]" {^[0-9a-f]{1,@@}$}] $head]} { if {[catch { set head [git rev-parse --verify $head] } err]} { @@ -3238,13 +3089,12 @@ default { # -- Branch Control # -${NS}::frame .branch -if {!$use_ttk} {.branch configure -borderwidth 1 -relief sunken} -${NS}::label .branch.l1 \ +ttk::frame .branch +ttk::label .branch.l1 \ -text [mc "Current Branch:"] \ -anchor w \ -justify left -${NS}::label .branch.cb \ +ttk::label .branch.cb \ -textvariable current_branch \ -anchor w \ -justify left @@ -3254,13 +3104,9 @@ pack .branch -side top -fill x # -- Main Window Layout # -${NS}::panedwindow .vpane -orient horizontal -${NS}::panedwindow .vpane.files -orient vertical -if {$use_ttk} { - .vpane add .vpane.files -} else { - .vpane add .vpane.files -sticky nsew -height 100 -width 200 -} +ttk::panedwindow .vpane -orient horizontal +ttk::panedwindow .vpane.files -orient vertical +.vpane add .vpane.files pack .vpane -anchor n -side top -fill both -expand 1 # -- Working Directory File List @@ -3277,8 +3123,8 @@ ttext $ui_workdir \ -xscrollcommand {.vpane.files.workdir.sx set} \ -yscrollcommand {.vpane.files.workdir.sy set} \ -state disabled -${NS}::scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview] -${NS}::scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview] +ttk::scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview] +ttk::scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview] pack .vpane.files.workdir.title -side top -fill x pack .vpane.files.workdir.sx -side bottom -fill x pack .vpane.files.workdir.sy -side right -fill y @@ -3299,8 +3145,8 @@ ttext $ui_index \ -xscrollcommand {.vpane.files.index.sx set} \ -yscrollcommand {.vpane.files.index.sy set} \ -state disabled -${NS}::scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview] -${NS}::scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview] +ttk::scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview] +ttk::scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview] pack .vpane.files.index.title -side top -fill x pack .vpane.files.index.sx -side bottom -fill x pack .vpane.files.index.sy -side right -fill y @@ -3310,10 +3156,6 @@ pack $ui_index -side left -fill both -expand 1 # .vpane.files add .vpane.files.workdir .vpane.files add .vpane.files.index -if {!$use_ttk} { - .vpane.files paneconfigure .vpane.files.workdir -sticky news - .vpane.files paneconfigure .vpane.files.index -sticky news -} proc set_selection_colors {w has_focus} { foreach tag [list in_diff in_sel] { @@ -3334,78 +3176,63 @@ unset i # -- Diff and Commit Area # -if {$have_tk85} { - ${NS}::panedwindow .vpane.lower -orient vertical - ${NS}::frame .vpane.lower.commarea - ${NS}::frame .vpane.lower.diff -relief sunken -borderwidth 1 -height 500 - .vpane.lower add .vpane.lower.diff - .vpane.lower add .vpane.lower.commarea - .vpane add .vpane.lower - if {$use_ttk} { - .vpane.lower pane .vpane.lower.diff -weight 1 - .vpane.lower pane .vpane.lower.commarea -weight 0 - } else { - .vpane.lower paneconfigure .vpane.lower.diff -stretch always - .vpane.lower paneconfigure .vpane.lower.commarea -stretch never - } -} else { - frame .vpane.lower -height 300 -width 400 - frame .vpane.lower.commarea - frame .vpane.lower.diff -relief sunken -borderwidth 1 - pack .vpane.lower.diff -fill both -expand 1 - pack .vpane.lower.commarea -side bottom -fill x - .vpane add .vpane.lower - .vpane paneconfigure .vpane.lower -sticky nsew -} +ttk::panedwindow .vpane.lower -orient vertical +ttk::frame .vpane.lower.commarea +ttk::frame .vpane.lower.diff -relief sunken -borderwidth 1 -height 500 +.vpane.lower add .vpane.lower.diff +.vpane.lower add .vpane.lower.commarea +.vpane add .vpane.lower +.vpane.lower pane .vpane.lower.diff -weight 1 +.vpane.lower pane .vpane.lower.commarea -weight 0 # -- Commit Area Buttons # -${NS}::frame .vpane.lower.commarea.buttons -${NS}::label .vpane.lower.commarea.buttons.l -text {} \ +ttk::frame .vpane.lower.commarea.buttons +ttk::label .vpane.lower.commarea.buttons.l -text {} \ -anchor w \ -justify left pack .vpane.lower.commarea.buttons.l -side top -fill x pack .vpane.lower.commarea.buttons -side left -fill y -${NS}::button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \ +ttk::button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \ -command ui_do_rescan pack .vpane.lower.commarea.buttons.rescan -side top -fill x lappend disable_on_lock \ {.vpane.lower.commarea.buttons.rescan conf -state} -${NS}::button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \ +ttk::button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \ -command do_add_all pack .vpane.lower.commarea.buttons.incall -side top -fill x lappend disable_on_lock \ {.vpane.lower.commarea.buttons.incall conf -state} if {![is_enabled nocommitmsg]} { - ${NS}::button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \ + ttk::button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \ -command do_signoff pack .vpane.lower.commarea.buttons.signoff -side top -fill x } -${NS}::button .vpane.lower.commarea.buttons.commit -text [commit_btn_caption] \ +ttk::button .vpane.lower.commarea.buttons.commit -text [commit_btn_caption] \ -command do_commit pack .vpane.lower.commarea.buttons.commit -side top -fill x lappend disable_on_lock \ {.vpane.lower.commarea.buttons.commit conf -state} if {![is_enabled nocommit]} { - ${NS}::button .vpane.lower.commarea.buttons.push -text [mc Push] \ + ttk::button .vpane.lower.commarea.buttons.push -text [mc Push] \ -command do_push_anywhere pack .vpane.lower.commarea.buttons.push -side top -fill x } # -- Commit Message Buffer # -${NS}::frame .vpane.lower.commarea.buffer -${NS}::frame .vpane.lower.commarea.buffer.header +ttk::frame .vpane.lower.commarea.buffer +ttk::frame .vpane.lower.commarea.buffer.header set ui_comm .vpane.lower.commarea.buffer.frame.t set ui_coml .vpane.lower.commarea.buffer.header.l if {![is_enabled nocommit]} { - ${NS}::checkbutton .vpane.lower.commarea.buffer.header.amend \ + ttk::checkbutton .vpane.lower.commarea.buffer.header.amend \ -text [mc "Amend Last Commit"] \ -variable commit_type_is_amend \ -command do_select_commit_type @@ -3413,7 +3240,7 @@ if {![is_enabled nocommit]} { [list .vpane.lower.commarea.buffer.header.amend conf -state] } -${NS}::label $ui_coml \ +ttk::label $ui_coml \ -anchor w \ -justify left proc trace_commit_type {varname args} { @@ -3448,10 +3275,10 @@ ttext $ui_comm \ -font font_diff \ -xscrollcommand {.vpane.lower.commarea.buffer.frame.sbx set} \ -yscrollcommand {.vpane.lower.commarea.buffer.frame.sby set} -${NS}::scrollbar .vpane.lower.commarea.buffer.frame.sbx \ +ttk::scrollbar .vpane.lower.commarea.buffer.frame.sbx \ -orient horizontal \ -command [list $ui_comm xview] -${NS}::scrollbar .vpane.lower.commarea.buffer.frame.sby \ +ttk::scrollbar .vpane.lower.commarea.buffer.frame.sby \ -orient vertical \ -command [list $ui_comm yview] @@ -3574,9 +3401,9 @@ ttext $ui_diff \ -yscrollcommand {.vpane.lower.diff.body.sby set} \ -state disabled catch {$ui_diff configure -tabstyle wordprocessor} -${NS}::scrollbar .vpane.lower.diff.body.sbx -orient horizontal \ +ttk::scrollbar .vpane.lower.diff.body.sbx -orient horizontal \ -command [list $ui_diff xview] -${NS}::scrollbar .vpane.lower.diff.body.sby -orient vertical \ +ttk::scrollbar .vpane.lower.diff.body.sby -orient vertical \ -command [list $ui_diff yview] pack .vpane.lower.diff.body.sbx -side bottom -fill x pack .vpane.lower.diff.body.sby -side right -fill y @@ -3594,6 +3421,8 @@ $ui_diff tag configure clr1 -font font_diffbold $ui_diff tag configure clr4 -underline 1 $ui_diff tag conf d_info -foreground blue -font font_diffbold +$ui_diff tag conf d_rescan -foreground blue -underline 1 -font font_diffbold +$ui_diff tag bind d_rescan <Button-1> { clear_diff; rescan ui_ready 0 } $ui_diff tag conf d_cr -elide true $ui_diff tag conf d_@ -font font_diffbold @@ -3875,29 +3704,14 @@ proc on_ttk_pane_mapped {w pane pos} { bind $w <Map> {} after 0 [list after idle [list $w sashpos $pane $pos]] } -proc on_tk_pane_mapped {w pane x y} { - bind $w <Map> {} - after 0 [list after idle [list $w sash place $pane $x $y]] -} proc on_application_mapped {} { - global repo_config use_ttk + global repo_config bind . <Map> {} set gm $repo_config(gui.geometry) - if {$use_ttk} { - bind .vpane <Map> \ - [list on_ttk_pane_mapped %W 0 [lindex $gm 1]] - bind .vpane.files <Map> \ - [list on_ttk_pane_mapped %W 0 [lindex $gm 2]] - } else { - bind .vpane <Map> \ - [list on_tk_pane_mapped %W 0 \ - [lindex $gm 1] \ - [lindex [.vpane sash coord 0] 1]] - bind .vpane.files <Map> \ - [list on_tk_pane_mapped %W 0 \ - [lindex [.vpane.files sash coord 0] 0] \ - [lindex $gm 2]] - } + bind .vpane <Map> \ + [list on_ttk_pane_mapped %W 0 [lindex $gm 1]] + bind .vpane.files <Map> \ + [list on_ttk_pane_mapped %W 0 [lindex $gm 2]] wm geometry . [lindex $gm 0] } if {[info exists repo_config(gui.geometry)]} { @@ -4070,7 +3884,7 @@ if {[winfo exists $ui_comm]} { } } elseif {$m} { catch { - set fd [open [gitdir GITGUI_BCK] w] + set fd [safe_open_file [gitdir GITGUI_BCK] w] fconfigure $fd -encoding utf-8 puts -nonewline $fd $msg close $fd |