Code

gitk: Improve appearance of radiobuttons and checkbuttons
[git.git] / gitk
diff --git a/gitk b/gitk
index d48fbad857c02bc12e058bb020d014268803b984..61771bd05cdb33f59458a192ff84e59b85a4ef2c 100755 (executable)
--- a/gitk
+++ b/gitk
@@ -288,7 +288,7 @@ proc parseviewrevs {view revs} {
            if {$sdm != 2} {
                lappend ret $id
            } else {
-               lset ret end [lindex $ret end]...$id
+               lset ret end $id...[lindex $ret end]
            }
            lappend pos $id
        }
@@ -1677,6 +1677,7 @@ proc readrefs {} {
     global tagids idtags headids idheads tagobjid
     global otherrefids idotherrefs mainhead mainheadid
     global selecthead selectheadid
+    global hideremotes
 
     foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
        catch {unset $v}
@@ -1689,7 +1690,7 @@ proc readrefs {} {
        if {![string match "refs/*" $ref]} continue
        set name [string range $ref 5 end]
        if {[string match "remotes/*" $name]} {
-           if {![string match "*/HEAD" $name]} {
+           if {![string match "*/HEAD" $name] && !$hideremotes} {
                set headids($name) $id
                lappend idheads($id) $name
            }
@@ -1786,10 +1787,10 @@ proc make_transient {window origin} {
     }
 }
 
-proc show_error {w top msg} {
+proc show_error {w top msg {mc mc}} {
     message $w.m -text $msg -justify center -aspect 400
     pack $w.m -side top -fill x -padx 20 -pady 20
-    button $w.ok -text [mc OK] -command "destroy $top"
+    button $w.ok -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"
@@ -2146,7 +2147,7 @@ proc makewindow {} {
     label .bleft.mid.labeldiffcontext -text "      [mc "Lines of context"]: "
     pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
     spinbox .bleft.mid.diffcontext -width 5 -font textfont \
-       -from 1 -increment 1 -to 10000000 \
+       -from 0 -increment 1 -to 10000000 \
        -validate all -validatecommand "diffcontextvalidate %P" \
        -textvariable diffcontextstring
     .bleft.mid.diffcontext set $diffcontext
@@ -2518,12 +2519,14 @@ proc savestuff {w} {
     global maxwidth showneartags showlocalchanges
     global viewname viewfiles viewargs viewargscmd viewperm nextviewnum
     global cmitmode wrapcomment datetimeformat limitdiffs
-    global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
+    global colors uicolor bgcolor fgcolor diffcolors diffcontext selectbgcolor
     global autoselect extdifftool perfile_attrs markbgcolor
+    global hideremotes
 
     if {$stuffsaved} return
     if {![winfo viewable .]} return
     catch {
+       if {[file exists ~/.gitk-new]} {file delete -force ~/.gitk-new}
        set f [open "~/.gitk-new" w]
        if {$::tcl_platform(platform) eq {windows}} {
            file attributes "~/.gitk-new" -hidden true
@@ -2539,9 +2542,11 @@ proc savestuff {w} {
        puts $f [list set wrapcomment $wrapcomment]
        puts $f [list set autoselect $autoselect]
        puts $f [list set showneartags $showneartags]
+       puts $f [list set hideremotes $hideremotes]
        puts $f [list set showlocalchanges $showlocalchanges]
        puts $f [list set datetimeformat $datetimeformat]
        puts $f [list set limitdiffs $limitdiffs]
+       puts $f [list set uicolor $uicolor]
        puts $f [list set bgcolor $bgcolor]
        puts $f [list set fgcolor $fgcolor]
        puts $f [list set colors $colors]
@@ -3164,6 +3169,28 @@ proc flist_hl {only} {
     set gdttype [mc "touching paths:"]
 }
 
+proc gitknewtmpdir {} {
+    global diffnum gitktmpdir gitdir
+
+    if {![info exists gitktmpdir]} {
+       set gitktmpdir [file join [file dirname $gitdir] \
+                           [format ".gitk-tmp.%s" [pid]]]
+       if {[catch {file mkdir $gitktmpdir} err]} {
+           error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
+           unset gitktmpdir
+           return {}
+       }
+       set diffnum 0
+    }
+    incr diffnum
+    set diffdir [file join $gitktmpdir $diffnum]
+    if {[catch {file mkdir $diffdir} err]} {
+       error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
+       return {}
+    }
+    return $diffdir
+}
+
 proc save_file_from_commit {filename output what} {
     global nullfile
 
@@ -3198,11 +3225,10 @@ proc external_diff_get_one_file {diffid filename diffdir} {
 }
 
 proc external_diff {} {
-    global gitktmpdir nullid nullid2
+    global nullid nullid2
     global flist_menu_file
     global diffids
-    global diffnum
-    global gitdir extdifftool
+    global extdifftool
 
     if {[llength $diffids] == 1} {
         # no reference commit given
@@ -3224,22 +3250,8 @@ proc external_diff {} {
     }
 
     # make sure that several diffs wont collide
-    if {![info exists gitktmpdir]} {
-       set gitktmpdir [file join [file dirname $gitdir] \
-                           [format ".gitk-tmp.%s" [pid]]]
-       if {[catch {file mkdir $gitktmpdir} err]} {
-           error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
-           unset gitktmpdir
-           return
-       }
-       set diffnum 0
-    }
-    incr diffnum
-    set diffdir [file join $gitktmpdir $diffnum]
-    if {[catch {file mkdir $diffdir} err]} {
-       error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
-       return
-    }
+    set diffdir [gitknewtmpdir]
+    if {$diffdir eq {}} return
 
     # gather files to diff
     set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
@@ -3831,7 +3843,7 @@ proc vieweditor {top n title} {
     global known_view_options
 
     toplevel $top
-    wm title $top [concat $title "-- criteria for selecting revisions"]
+    wm title $top [concat $title [mc "-- criteria for selecting revisions"]]
     make_transient $top .
 
     # View name
@@ -7213,7 +7225,7 @@ proc diffcmd {ids flags} {
        set cmd [concat | git diff-index --cached $flags]
        if {[llength $ids] > 1} {
            # comparing index with specific revision
-           if {$i == 0} {
+           if {$j == 0} {
                lappend cmd -R [lindex $ids 1]
            } else {
                lappend cmd [lindex $ids 0]
@@ -7308,7 +7320,7 @@ proc diffcontextchange {n1 n2 op} {
     global diffcontextstring diffcontext
 
     if {[string is integer -strict $diffcontextstring]} {
-       if {$diffcontextstring > 0} {
+       if {$diffcontextstring >= 0} {
            set diffcontext $diffcontextstring
            reselectline
        }
@@ -7332,7 +7344,11 @@ proc getblobdiffs {ids} {
     if {[package vcompare $git_version "1.6.1"] >= 0} {
        set textconv "--textconv"
     }
-    set cmd [diffcmd $ids "-p $textconv -C --cc --no-commit-id -U$diffcontext"]
+    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"]
     if {$ignorespace} {
        append cmd " -w"
     }
@@ -7397,7 +7413,7 @@ proc getblobdiffline {bdf ids} {
     $ctext conf -state normal
     while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
        if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
-           close $bdf
+           catch {close $bdf}
            return 0
        }
        if {![string compare -length 5 "diff " $line]} {
@@ -7470,6 +7486,21 @@ proc getblobdiffline {bdf ids} {
            set diffnparents [expr {[string length $ats] - 1}]
            set diffinhdr 0
 
+       } elseif {![string compare -length 10 "Submodule " $line]} {
+           # start of a new submodule
+           if {[string compare [$ctext get "end - 4c" end] "\n \n\n"]} {
+               $ctext insert end "\n";     # Add newline after commit message
+           }
+           set curdiffstart [$ctext index "end - 1c"]
+           lappend ctext_file_names ""
+           set fname [string range $line 10 [expr [string last " " $line] - 1]]
+           lappend ctext_file_lines $fname
+           makediffhdr $fname $ids
+           $ctext insert end "\n$line\n" filesep
+       } elseif {![string compare -length 3 "  >" $line]} {
+           $ctext insert end "$line\n" dresult
+       } elseif {![string compare -length 3 "  <" $line]} {
+           $ctext insert end "$line\n" d0
        } elseif {$diffinhdr} {
            if {![string compare -length 12 "rename from " $line]} {
                set fname [string range $line [expr 6 + [string first " from " $line] ] end]
@@ -7549,7 +7580,7 @@ proc getblobdiffline {bdf ids} {
     }
     $ctext conf -state disabled
     if {[eof $bdf]} {
-       close $bdf
+       catch {close $bdf}
        return 0
     }
     return [expr {$nr >= 1000? 2: 1}]
@@ -7906,6 +7937,11 @@ proc gotocommit {} {
                }
                set id [lindex $matches 0]
            }
+       } else {
+           if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
+               error_popup [mc "Revision %s is not known" $sha1string]
+               return
+           }
        }
     }
     if {[commitinview $id $curview]} {
@@ -7915,7 +7951,7 @@ proc gotocommit {} {
     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
        set msg [mc "SHA1 id %s is not known" $sha1string]
     } else {
-       set msg [mc "Tag/Head %s is not known" $sha1string]
+       set msg [mc "Revision %s is not in the current view" $sha1string]
     }
     error_popup $msg
 }
@@ -8265,8 +8301,11 @@ proc do_cmp_commits {a b} {
                appendshortlink $a [mc "Commit "] "  $heada\n"
                appendshortlink $b [mc " differs from\n       "] \
                    "  $headb\n"
-               $ctext insert end [mc "- stopping\n"]
-               break
+               $ctext insert end [mc "Diff of commits:\n\n"]
+               $ctext conf -state disabled
+               update
+               diffcommits $a $b
+               return
            }
        }
        if {$skipa} {
@@ -8292,6 +8331,31 @@ proc do_cmp_commits {a b} {
     $ctext conf -state disabled
 }
 
+proc diffcommits {a b} {
+    global diffcontext diffids blobdifffd diffinhdr
+
+    set tmpdir [gitknewtmpdir]
+    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
+    } err]} {
+       error_popup [mc "Error writing commit to file: %s" $err]
+       return
+    }
+    if {[catch {
+       set fd [open "| diff -U$diffcontext $fna $fnb" r]
+    } err]} {
+       error_popup [mc "Error diffing commits: %s" $err]
+       return
+    }
+    set diffids [list commits $a $b]
+    set blobdifffd($diffids) $fd
+    set diffinhdr 0
+    filerun $fd [list getblobdiffline $fd $diffids]
+}
+
 proc diffvssel {dirn} {
     global rowmenuid selectedline
 
@@ -10381,8 +10445,9 @@ proc chg_fontparam {v sub op} {
 proc doprefs {} {
     global maxwidth maxgraphpct
     global oldprefs prefstop showneartags showlocalchanges
-    global bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
+    global uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
     global tabstop limitdiffs autoselect extdifftool perfile_attrs
+    global hideremotes
 
     set top .gitkprefs
     set prefstop $top
@@ -10391,7 +10456,7 @@ proc doprefs {} {
        return
     }
     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
-                  limitdiffs tabstop perfile_attrs} {
+                  limitdiffs tabstop perfile_attrs hideremotes} {
        set oldprefs($v) [set $v]
     }
     toplevel $top
@@ -10423,6 +10488,9 @@ proc doprefs {} {
     checkbutton $top.ntag -text [mc "Display nearby tags"] \
        -font optionfont -variable showneartags
     grid x $top.ntag -sticky w
+    checkbutton $top.hideremotes -text [mc "Hide remote refs"] \
+       -font optionfont -variable hideremotes
+    grid x $top.hideremotes -sticky w
     checkbutton $top.ldiff -text [mc "Limit diffs to listed paths"] \
        -font optionfont -variable limitdiffs
     grid x $top.ldiff -sticky w
@@ -10441,6 +10509,10 @@ proc doprefs {} {
 
     label $top.cdisp -text [mc "Colors: press to choose"]
     grid $top.cdisp - -sticky w -pady 10
+    label $top.ui -padx 40 -relief sunk -background $uicolor
+    button $top.uibut -text [mc "Interface"] -font optionfont \
+       -command [list choosecolor uicolor {} $top.ui [mc "interface"] setui]
+    grid x $top.uibut $top.ui -sticky w
     label $top.bg -padx 40 -relief sunk -background $bgcolor
     button $top.bgbut -text [mc "Background"] -font optionfont \
        -command [list choosecolor bgcolor {} $top.bg [mc "background"] setbg]
@@ -10524,6 +10596,20 @@ 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} {
+    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
 
@@ -10547,7 +10633,7 @@ proc prefscan {} {
     global oldprefs prefstop
 
     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
-                  limitdiffs tabstop perfile_attrs} {
+                  limitdiffs tabstop perfile_attrs hideremotes} {
        global $v
        set $v $oldprefs($v)
     }
@@ -10561,6 +10647,7 @@ proc prefsok {} {
     global oldprefs prefstop showneartags showlocalchanges
     global fontpref mainfont textfont uifont
     global limitdiffs treediffs perfile_attrs
+    global hideremotes
 
     catch {destroy $prefstop}
     unset prefstop
@@ -10606,6 +10693,9 @@ proc prefsok {} {
          $limitdiffs != $oldprefs(limitdiffs)} {
        reselectline
     }
+    if {$hideremotes != $oldprefs(hideremotes)} {
+       rereadrefs
+    }
 }
 
 proc formatdate {d} {
@@ -10901,7 +10991,7 @@ proc gitattr {path attr default} {
     } else {
        set r "unspecified"
        if {![catch {set line [exec git check-attr $attr -- $path]}]} {
-           regexp "(.*): encoding: (.*)" $line m f r
+           regexp "(.*): $attr: (.*)" $line m f r
        }
        set path_attr_cache($attr,$path) $r
     }
@@ -10929,7 +11019,7 @@ proc cache_gitattr {attr pathlist} {
        set newlist [lrange $newlist $lim end]
        if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
            foreach row [split $rlist "\n"] {
-               if {[regexp "(.*): encoding: (.*)" $row m path value]} {
+               if {[regexp "(.*): $attr: (.*)" $row m path value]} {
                    if {[string index $path 0] eq "\""} {
                        set path [encoding convertfrom [lindex $path 0]]
                    }
@@ -10954,8 +11044,8 @@ proc get_path_encoding {path} {
 
 # 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."]
+    show_error {} . "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
+                    Gitk requires at least Tcl/Tk 8.4." list
     exit 1
 }
 
@@ -11011,6 +11101,7 @@ set mingaplen 100
 set cmitmode "patch"
 set wrapcomment "none"
 set showneartags 1
+set hideremotes 0
 set maxrefs 20
 set maxlinelen 200
 set showlocalchanges 1
@@ -11026,6 +11117,7 @@ if {[tk windowingsystem] eq "aqua"} {
 }
 
 set colors {green red blue magenta darkgrey brown orange}
+set uicolor grey85
 set bgcolor white
 set fgcolor black
 set diffcolors {red "#00a000" blue}
@@ -11077,6 +11169,8 @@ 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...