git-gui: Let the user continue even if we cannot understand git version

[git.git] / git-gui.sh

diff --git a/git-gui.sh b/git-gui.sh
index 7e6952c2bc0d31e8028f80573b846af90be9dc6f..2127557f9d595020765dbf318051375be8c7e390 100755 (executable)
--- a/git-gui.sh
+++ b/git-gui.sh
@@ -367,16 +367,25 @@ proc _which {what} {
        return {}
 }
 
+proc _lappend_nice {cmd_var} {
+       global _nice
+       upvar $cmd_var cmd
+
+       if {![info exists _nice]} {
+               set _nice [_which nice]
+       }
+       if {$_nice ne {}} {
+               lappend cmd $_nice
+       }
+}
+
 proc git {args} {
        set opt [list exec]
 
        while {1} {
                switch -- [lindex $args 0] {
                --nice {
-                       global _nice
-                       if {$_nice ne {}} {
-                               lappend opt $_nice
-                       }
+                       _lappend_nice opt
                }
 
                default {
@@ -394,16 +403,37 @@ proc git {args} {
        return [eval $opt $cmdp $args]
 }
 
+proc _open_stdout_stderr {cmd} {
+       if {[catch {
+                       set fd [open $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 \
+                               [lrange $cmd 0 end-1] \
+                               [list |& cat] \
+                               ] r]
+               } else {
+                       error $err
+               }
+       }
+       fconfigure $fd -eofchar {}
+       return $fd
+}
+
 proc git_read {args} {
        set opt [list |]
 
        while {1} {
                switch -- [lindex $args 0] {
                --nice {
-                       global _nice
-                       if {$_nice ne {}} {
-                               lappend opt $_nice
-                       }
+                       _lappend_nice opt
                }
 
                --stderr {
@@ -422,28 +452,7 @@ proc git_read {args} {
        set cmdp [_git_cmd [lindex $args 0]]
        set args [lrange $args 1 end]
 
-       if {[catch {
-                       set fd [open [concat $opt $cmdp $args] r]
-               } err]} {
-               if {   [lindex $args 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 \
-                               $opt \
-                               $cmdp \
-                               [lrange $args 0 end-1] \
-                               [list |& cat] \
-                               ] r]
-               } else {
-                       error $err
-               }
-       }
-       return $fd
+       return [_open_stdout_stderr [concat $opt $cmdp $args]]
 }
 
 proc git_write {args} {
@@ -452,10 +461,7 @@ proc git_write {args} {
        while {1} {
                switch -- [lindex $args 0] {
                --nice {
-                       global _nice
-                       if {$_nice ne {}} {
-                               lappend opt $_nice
-                       }
+                       _lappend_nice opt
                }
 
                default {
@@ -473,6 +479,11 @@ proc git_write {args} {
        return [open [concat $opt $cmdp $args] w]
 }
 
+proc sq {value} {
+       regsub -all ' $value "'\\''" value
+       return "'$value'"
+}
+
 proc load_current_branch {} {
        global current_branch is_detached
 
@@ -517,7 +528,6 @@ if {$_git eq {}} {
        error_popup "Cannot find git in PATH."
        exit 1
 }
-set _nice [_which nice]
 
 ######################################################################
 ##
@@ -537,8 +547,34 @@ if {![regsub {^git version } $_git_version {} _git_version]} {
        error_popup "Cannot parse Git version string:\n\n$_git_version"
        exit 1
 }
+
+set _real_git_version $_git_version
+regsub -- {-dirty$} $_git_version {} _git_version
 regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
 regsub {\.rc[0-9]+$} $_git_version {} _git_version
+regsub {\.GIT$} $_git_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 "Git version cannot be determined.
+
+$_git claims it is version '$_real_git_version'.
+
+[appname] requires at least Git 1.5.0 or later.
+
+Assume '$_real_git_version' is version 1.5.0?
+"] eq {yes}} {
+               set _git_version 1.5.0
+       } else {
+               exit 1
+       }
+}
+unset _real_git_version
 
 proc git-version {args} {
        global _git_version
@@ -820,6 +856,7 @@ proc load_message {file} {
                if {[catch {set fd [open $f r]}]} {
                        return 0
                }
+               fconfigure $fd -eofchar {}
                set content [string trim [read $fd]]
                close $fd
                regsub -all -line {[ \r\t]+$} $content {} content
@@ -2547,12 +2584,21 @@ if {[is_enabled transport]} {
 # -- Only suggest a gc run if we are going to stay running.
 #
 if {[is_enabled multicommit]} {
-       set object_limit 2000
-       if {[is_Windows]} {set object_limit 200}
-       regexp {^([0-9]+) objects,} [git count-objects] _junk objects_current
+       set object_limit 8
+       if {[is_Windows]} {
+               set object_limit 1
+       }
+       set objects_current [llength [glob \
+               -directory [gitdir objects 42] \
+               -nocomplain \
+               -tails \
+               -- \
+               *]]
        if {$objects_current >= $object_limit} {
+               set objects_current [expr {$objects_current * 256}]
+               set object_limit    [expr {$object_limit    * 256}]
                if {[ask_popup \
-                       "This repository currently has $objects_current loose objects.
+                       "This repository currently has approximately $objects_current loose objects.
 
 To maintain optimal performance it is strongly recommended that you compress the database when more than $object_limit loose objects exist.
 
@@ -2560,8 +2606,11 @@ Compress the database now?"] eq yes} {
                        do_gc
                }
        }
-       unset object_limit _junk objects_current
+       unset object_limit objects_current
 }
 
 lock_index begin-read
+if {![winfo ismapped .]} {
+       wm deiconify .
+}
 after 1 do_rescan