Clean up git-diff-tree 'header' generation

[git.git] / gitk

diff --git a/gitk b/gitk
index d509998..faaffe1 100755 (executable)
--- a/gitk
+++ b/gitk
@@ -12,22 +12,31 @@ exec wish "$0" -- "${1+$@}"
 proc getcommits {rargs} {
     global commits commfd phase canv mainfont
     global startmsecs nextupdate
 proc getcommits {rargs} {
     global commits commfd phase canv mainfont
     global startmsecs nextupdate

-    global ctext maincursor textcursor nlines
+    global ctext maincursor textcursor leftover

 
 

-    if {$rargs == {}} {
-       set rargs HEAD
-    }

     set commits {}
     set phase getcommits
     set startmsecs [clock clicks -milliseconds]
     set nextupdate [expr $startmsecs + 100]
     set commits {}
     set phase getcommits
     set startmsecs [clock clicks -milliseconds]
     set nextupdate [expr $startmsecs + 100]

-    if [catch {set commfd [open "|git-rev-list --merge-order $rargs" r]} err] {
+    if [catch {
+       set parse_args [concat --default HEAD $rargs]
+       set parsed_args [split [eval exec git-rev-parse $parse_args] "\n"]
+    }] {
+       # if git-rev-parse failed for some reason...
+       if {$rargs == {}} {
+           set rargs HEAD
+       }
+       set parsed_args $rargs
+    }
+    if [catch {
+       set commfd [open "|git-rev-list --header --merge-order $parsed_args" r]
+    } err] {

        puts stderr "Error executing git-rev-list: $err"
        exit 1
     }
        puts stderr "Error executing git-rev-list: $err"
        exit 1
     }

-    set nlines 0
-    fconfigure $commfd -blocking 0
-    fileevent $commfd readable "getcommitline $commfd"
+    set leftover {}
+    fconfigure $commfd -blocking 0 -translation binary
+    fileevent $commfd readable "getcommitlines $commfd"

     $canv delete all
     $canv create text 3 3 -anchor nw -text "Reading commits..." \
        -font $mainfont -tags textitems
     $canv delete all
     $canv create text 3 3 -anchor nw -text "Reading commits..." \
        -font $mainfont -tags textitems


@@ -35,13 +44,13 @@ proc getcommits {rargs} {
     $ctext config -cursor watch
 }
 
     $ctext config -cursor watch
 }
 

-proc getcommitline {commfd}  {
+proc getcommitlines {commfd}  {

     global commits parents cdate children nchildren
     global commitlisted phase commitinfo nextupdate
     global commits parents cdate children nchildren
     global commitlisted phase commitinfo nextupdate

-    global stopped redisplaying nlines
+    global stopped redisplaying leftover

 
 

-    set n [gets $commfd line]
-    if {$n < 0} {
+    set stuff [read $commfd]
+    if {$stuff == {}} {

        if {![eof $commfd]} return
        # this works around what is apparently a bug in Tcl...
        fconfigure $commfd -blocking 1
        if {![eof $commfd]} return
        # this works around what is apparently a bug in Tcl...
        fconfigure $commfd -blocking 1


@@ -60,35 +69,41 @@ to allow selection of commits to be displayed.)}
        error_popup $err
        exit 1
     }
        error_popup $err
        exit 1
     }

-    incr nlines
-    if {![regexp {^[0-9a-f]{40}$} $line id]} {
-       error_popup "Can't parse git-rev-list output: {$line}"
-       exit 1
-    }
-    lappend commits $id
-    set commitlisted($id) 1
-    if {![info exists commitinfo($id)]} {
-       readcommit $id
-    }
-    foreach p $parents($id) {
-       if {[info exists commitlisted($p)]} {
-           puts "oops, parent $p before child $id"
+    set start 0
+    while 1 {
+       set i [string first "\0" $stuff $start]
+       if {$i < 0} {
+           set leftover [string range $stuff $start end]
+           return

        }
        }

-    }
-    drawcommit $id
-    if {[clock clicks -milliseconds] >= $nextupdate} {
-       doupdate
-    }
-    while {$redisplaying} {
-       set redisplaying 0
-       if {$stopped == 1} {
-           set stopped 0
-           set phase "getcommits"
-           foreach id $commits {
-               drawcommit $id
-               if {$stopped} break
-               if {[clock clicks -milliseconds] >= $nextupdate} {
-                   doupdate
+       set cmit [string range $stuff $start [expr {$i - 1}]]
+       if {$start == 0} {
+           set cmit "$leftover$cmit"
+       }
+       set start [expr {$i + 1}]
+       if {![regexp {^([0-9a-f]{40})\n} $cmit match id]} {
+           error_popup "Can't parse git-rev-list output: {$cmit}"
+           exit 1
+       }
+       set cmit [string range $cmit 41 end]
+       lappend commits $id
+       set commitlisted($id) 1
+       parsecommit $id $cmit 1
+       drawcommit $id
+       if {[clock clicks -milliseconds] >= $nextupdate} {
+           doupdate
+       }
+       while {$redisplaying} {
+           set redisplaying 0
+           if {$stopped == 1} {
+               set stopped 0
+               set phase "getcommits"
+               foreach id $commits {
+                   drawcommit $id
+                   if {$stopped} break
+                   if {[clock clicks -milliseconds] >= $nextupdate} {
+                       doupdate
+                   }

                }
            }
        }
                }
            }
        }


@@ -101,12 +116,16 @@ proc doupdate {} {
     incr nextupdate 100
     fileevent $commfd readable {}
     update
     incr nextupdate 100
     fileevent $commfd readable {}
     update

-    fileevent $commfd readable "getcommitline $commfd"
+    fileevent $commfd readable "getcommitlines $commfd"

 }
 
 proc readcommit {id} {
 }
 
 proc readcommit {id} {

+    if [catch {set contents [exec git-cat-file commit $id]}] return
+    parsecommit $id $contents 0
+}
+
+proc parsecommit {id contents listed} {

     global commitinfo children nchildren parents nparents cdate ncleft
     global commitinfo children nchildren parents nparents cdate ncleft

-    global noreadobj

 
     set inhdr 1
     set comment {}
 
     set inhdr 1
     set comment {}


@@ -122,13 +141,6 @@ proc readcommit {id} {
     }
     set parents($id) {}
     set nparents($id) 0
     }
     set parents($id) {}
     set nparents($id) 0

-    if {$noreadobj} {
-       if [catch {set contents [exec git-cat-file commit $id]}] return
-    } else {
-       if [catch {set x [readobj $id]}] return
-       if {[lindex $x 0] != "commit"} return
-       set contents [lindex $x 1]
-    }

     foreach line [split $contents "\n"] {
        if {$inhdr} {
            if {$line == {}} {
     foreach line [split $contents "\n"] {
        if {$inhdr} {
            if {$line == {}} {


@@ -145,7 +157,7 @@ proc readcommit {id} {
                    lappend parents($id) $p
                    incr nparents($id)
                    # sometimes we get a commit that lists a parent twice...
                    lappend parents($id) $p
                    incr nparents($id)
                    # sometimes we get a commit that lists a parent twice...

-                   if {[lsearch -exact $children($p) $id] < 0} {
+                   if {$listed && [lsearch -exact $children($p) $id] < 0} {

                        lappend children($p) $id
                        incr nchildren($p)
                        incr ncleft($p)
                        lappend children($p) $id
                        incr nchildren($p)
                        incr ncleft($p)


@@ -162,10 +174,15 @@ proc readcommit {id} {
            }
        } else {
            if {$comment == {}} {
            }
        } else {
            if {$comment == {}} {

-               set headline $line
+               set headline [string trim $line]

            } else {
                append comment "\n"
            }
            } else {
                append comment "\n"
            }

+           if {!$listed} {
+               # git-rev-list indents the comment by 4 spaces;
+               # if we got this via git-cat-file, add the indentation
+               append comment "    "
+           }

            append comment $line
        }
     }
            append comment $line
        }
     }


@@ -535,9 +552,11 @@ Use and redistribute under the terms of the GNU General Public License
 proc assigncolor {id} {
     global commitinfo colormap commcolors colors nextcolor
     global parents nparents children nchildren
 proc assigncolor {id} {
     global commitinfo colormap commcolors colors nextcolor
     global parents nparents children nchildren

+    global cornercrossings crossings
+

     if [info exists colormap($id)] return
     set ncolors [llength $colors]
     if [info exists colormap($id)] return
     set ncolors [llength $colors]

-    if {$nparents($id) == 1 && $nchildren($id) == 1} {
+    if {$nparents($id) <= 1 && $nchildren($id) == 1} {

        set child [lindex $children($id) 0]
        if {[info exists colormap($child)]
            && $nparents($child) == 1} {
        set child [lindex $children($id) 0]
        if {[info exists colormap($child)]
            && $nparents($child) == 1} {


@@ -546,22 +565,50 @@ proc assigncolor {id} {
        }
     }
     set badcolors {}
        }
     }
     set badcolors {}

-    foreach child $children($id) {
-       if {[info exists colormap($child)]
-           && [lsearch -exact $badcolors $colormap($child)] < 0} {
-           lappend badcolors $colormap($child)
+    if {[info exists cornercrossings($id)]} {
+       foreach x $cornercrossings($id) {
+           if {[info exists colormap($x)]
+               && [lsearch -exact $badcolors $colormap($x)] < 0} {
+               lappend badcolors $colormap($x)
+           }
+       }
+       if {[llength $badcolors] >= $ncolors} {
+           set badcolors {}

        }
        }

-       if {[info exists parents($child)]} {
-           foreach p $parents($child) {
-               if {[info exists colormap($p)]
-                   && [lsearch -exact $badcolors $colormap($p)] < 0} {
-                   lappend badcolors $colormap($p)
+    }
+    set origbad $badcolors
+    if {[llength $badcolors] < $ncolors - 1} {
+       if {[info exists crossings($id)]} {
+           foreach x $crossings($id) {
+               if {[info exists colormap($x)]
+                   && [lsearch -exact $badcolors $colormap($x)] < 0} {
+                   lappend badcolors $colormap($x)

                }
            }
                }
            }

+           if {[llength $badcolors] >= $ncolors} {
+               set badcolors $origbad
+           }

        }
        }

+       set origbad $badcolors

     }
     }

-    if {[llength $badcolors] >= $ncolors} {
-       set badcolors {}
+    if {[llength $badcolors] < $ncolors - 1} {
+       foreach child $children($id) {
+           if {[info exists colormap($child)]
+               && [lsearch -exact $badcolors $colormap($child)] < 0} {
+               lappend badcolors $colormap($child)
+           }
+           if {[info exists parents($child)]} {
+               foreach p $parents($child) {
+                   if {[info exists colormap($p)]
+                       && [lsearch -exact $badcolors $colormap($p)] < 0} {
+                       lappend badcolors $colormap($p)
+                   }
+               }
+           }
+       }
+       if {[llength $badcolors] >= $ncolors} {
+           set badcolors $origbad
+       }

     }
     for {set i 0} {$i <= $ncolors} {incr i} {
        set c [lindex $colors $nextcolor]
     }
     for {set i 0} {$i <= $ncolors} {incr i} {
        set c [lindex $colors $nextcolor]


@@ -575,7 +622,7 @@ proc assigncolor {id} {
 
 proc initgraph {} {
     global canvy canvy0 lineno numcommits lthickness nextcolor linespc
 
 proc initgraph {} {
     global canvy canvy0 lineno numcommits lthickness nextcolor linespc

-    global glines
+    global mainline sidelines

     global nchildren ncleft
 
     allcanvs delete all
     global nchildren ncleft
 
     allcanvs delete all


@@ -584,7 +631,8 @@ proc initgraph {} {
     set lineno -1
     set numcommits 0
     set lthickness [expr {int($linespc / 9) + 1}]
     set lineno -1
     set numcommits 0
     set lthickness [expr {int($linespc / 9) + 1}]

-    catch {unset glines}
+    catch {unset mainline}
+    catch {unset sidelines}

     foreach id [array names nchildren] {
        set ncleft($id) $nchildren($id)
     }
     foreach id [array names nchildren] {
        set ncleft($id) $nchildren($id)
     }


@@ -602,12 +650,11 @@ proc bindline {t id} {
 proc drawcommitline {level} {
     global parents children nparents nchildren todo
     global canv canv2 canv3 mainfont namefont canvx0 canvy linespc
 proc drawcommitline {level} {
     global parents children nparents nchildren todo
     global canv canv2 canv3 mainfont namefont canvx0 canvy linespc

-    global datemode cdate

     global lineid linehtag linentag linedtag commitinfo
     global colormap numcommits currentparents dupparents
     global oldlevel oldnlines oldtodo
     global idtags idline idheads
     global lineid linehtag linentag linedtag commitinfo
     global colormap numcommits currentparents dupparents
     global oldlevel oldnlines oldtodo
     global idtags idline idheads

-    global lineno lthickness glines
+    global lineno lthickness mainline sidelines

     global commitlisted
 
     incr numcommits
     global commitlisted
 
     incr numcommits


@@ -623,6 +670,7 @@ proc drawcommitline {level} {
            set nparents($id) 0
        }
     }
            set nparents($id) 0
        }
     }

+    assigncolor $id

     set currentparents {}
     set dupparents {}
     if {[info exists commitlisted($id)] && [info exists parents($id)]} {
     set currentparents {}
     set dupparents {}
     if {[info exists commitlisted($id)] && [info exists parents($id)]} {


@@ -640,21 +688,31 @@ proc drawcommitline {level} {
     set canvy [expr $canvy + $linespc]
     allcanvs conf -scrollregion \
        [list 0 0 0 [expr $y1 + 0.5 * $linespc + 2]]
     set canvy [expr $canvy + $linespc]
     allcanvs conf -scrollregion \
        [list 0 0 0 [expr $y1 + 0.5 * $linespc + 2]]

-    if {[info exists glines($id)]} {
-       lappend glines($id) $x $y1
-       set t [$canv create line $glines($id) \
+    if {[info exists mainline($id)]} {
+       lappend mainline($id) $x $y1
+       set t [$canv create line $mainline($id) \

                   -width $lthickness -fill $colormap($id)]
        $canv lower $t
        bindline $t $id
     }
                   -width $lthickness -fill $colormap($id)]
        $canv lower $t
        bindline $t $id
     }

+    if {[info exists sidelines($id)]} {
+       foreach ls $sidelines($id) {
+           set coords [lindex $ls 0]
+           set thick [lindex $ls 1]
+           set t [$canv create line $coords -fill $colormap($id) \
+                      -width [expr {$thick * $lthickness}]]
+           $canv lower $t
+           bindline $t $id
+       }
+    }

     set orad [expr {$linespc / 3}]
     set t [$canv create oval [expr $x - $orad] [expr $y1 - $orad] \
               [expr $x + $orad - 1] [expr $y1 + $orad - 1] \
               -fill $ofill -outline black -width 1]
     $canv raise $t
     set xt [expr $canvx0 + [llength $todo] * $linespc]
     set orad [expr {$linespc / 3}]
     set t [$canv create oval [expr $x - $orad] [expr $y1 - $orad] \
               [expr $x + $orad - 1] [expr $y1 + $orad - 1] \
               -fill $ofill -outline black -width 1]
     $canv raise $t
     set xt [expr $canvx0 + [llength $todo] * $linespc]

-    if {$nparents($id) > 2} {
-       set xt [expr {$xt + ($nparents($id) - 2) * $linespc}]
+    if {[llength $currentparents] > 2} {
+       set xt [expr {$xt + ([llength $currentparents] - 2) * $linespc}]

     }
     set marks {}
     set ntags 0
     }
     set marks {}
     set ntags 0


@@ -710,38 +768,32 @@ proc drawcommitline {level} {
 }
 
 proc updatetodo {level noshortcut} {
 }
 
 proc updatetodo {level noshortcut} {

-    global datemode currentparents ncleft todo
-    global glines oldlevel oldtodo oldnlines
-    global canvx0 canvy linespc glines
+    global currentparents ncleft todo
+    global mainline oldlevel oldtodo oldnlines
+    global canvx0 canvy linespc mainline

     global commitinfo
 
     global commitinfo
 

-    foreach p $currentparents {
-       if {![info exists commitinfo($p)]} {
-           readcommit $p
-       }
-    }
-    set x [expr $canvx0 + $level * $linespc]
-    set y [expr $canvy - $linespc]
+    set oldlevel $level
+    set oldtodo $todo
+    set oldnlines [llength $todo]

     if {!$noshortcut && [llength $currentparents] == 1} {
        set p [lindex $currentparents 0]
     if {!$noshortcut && [llength $currentparents] == 1} {
        set p [lindex $currentparents 0]

-       if {$ncleft($p) == 0 && [lsearch -exact $todo $p] < 0} {
-           assigncolor $p
-           set glines($p) [list $x $y]
+       if {$ncleft($p) == 1 && [lsearch -exact $todo $p] < 0} {
+           set ncleft($p) 0
+           set x [expr $canvx0 + $level * $linespc]
+           set y [expr $canvy - $linespc]
+           set mainline($p) [list $x $y]

            set todo [lreplace $todo $level $level $p]
            return 0
        }
     }
 
            set todo [lreplace $todo $level $level $p]
            return 0
        }
     }
 

-    set oldlevel $level
-    set oldtodo $todo
-    set oldnlines [llength $todo]

     set todo [lreplace $todo $level $level]
     set i $level
     foreach p $currentparents {
        incr ncleft($p) -1
        set k [lsearch -exact $todo $p]
        if {$k < 0} {
     set todo [lreplace $todo $level $level]
     set i $level
     foreach p $currentparents {
        incr ncleft($p) -1
        set k [lsearch -exact $todo $p]
        if {$k < 0} {

-           assigncolor $p

            set todo [linsert $todo $i $p]
            incr i
        }
            set todo [linsert $todo $i $p]
            incr i
        }


@@ -749,8 +801,36 @@ proc updatetodo {level noshortcut} {
     return 1
 }
 
     return 1
 }
 

+proc notecrossings {id lo hi corner} {
+    global oldtodo crossings cornercrossings
+
+    for {set i $lo} {[incr i] < $hi} {} {
+       set p [lindex $oldtodo $i]
+       if {$p == {}} continue
+       if {$i == $corner} {
+           if {![info exists cornercrossings($id)]
+               || [lsearch -exact $cornercrossings($id) $p] < 0} {
+               lappend cornercrossings($id) $p
+           }
+           if {![info exists cornercrossings($p)]
+               || [lsearch -exact $cornercrossings($p) $id] < 0} {
+               lappend cornercrossings($p) $id
+           }
+       } else {
+           if {![info exists crossings($id)]
+               || [lsearch -exact $crossings($id) $p] < 0} {
+               lappend crossings($id) $p
+           }
+           if {![info exists crossings($p)]
+               || [lsearch -exact $crossings($p) $id] < 0} {
+               lappend crossings($p) $id
+           }
+       }
+    }
+}
+

 proc drawslants {} {
 proc drawslants {} {

-    global canv glines canvx0 canvy linespc
+    global canv mainline sidelines canvx0 canvy linespc

     global oldlevel oldtodo todo currentparents dupparents
     global lthickness linespc canvy colormap
 
     global oldlevel oldtodo todo currentparents dupparents
     global lthickness linespc canvy colormap
 


@@ -768,39 +848,35 @@ proc drawslants {} {
                set xj [expr {$canvx0 + $j * $linespc}]
                if {$j < $i - 1} {
                    lappend coords [expr $xj + $linespc] $y1
                set xj [expr {$canvx0 + $j * $linespc}]
                if {$j < $i - 1} {
                    lappend coords [expr $xj + $linespc] $y1

+                   notecrossings $p $j $i [expr {$j + 1}]

                } elseif {$j > $i + 1} {
                    lappend coords [expr $xj - $linespc] $y1
                } elseif {$j > $i + 1} {
                    lappend coords [expr $xj - $linespc] $y1

+                   notecrossings $p $i $j [expr {$j - 1}]

                }
                if {[lsearch -exact $dupparents $p] >= 0} {
                    # draw a double-width line to indicate the doubled parent
                    lappend coords $xj $y2
                }
                if {[lsearch -exact $dupparents $p] >= 0} {
                    # draw a double-width line to indicate the doubled parent
                    lappend coords $xj $y2

-                   set t [$canv create line $coords \
-                              -width [expr 2*$lthickness] -fill $colormap($p)]
-                   $canv lower $t
-                   bindline $t $p
-                   if {![info exists glines($p)]} {
-                       set glines($p) [list $xj $y2]
+                   lappend sidelines($p) [list $coords 2]
+                   if {![info exists mainline($p)]} {
+                       set mainline($p) [list $xj $y2]

                    }
                } else {
                    # normal case, no parent duplicated
                    }
                } else {
                    # normal case, no parent duplicated

-                   if {![info exists glines($p)]} {
+                   if {![info exists mainline($p)]} {

                        if {$i != $j} {
                            lappend coords $xj $y2
                        }
                        if {$i != $j} {
                            lappend coords $xj $y2
                        }

-                       set glines($p) $coords
+                       set mainline($p) $coords

                    } else {
                        lappend coords $xj $y2
                    } else {
                        lappend coords $xj $y2

-                       set t [$canv create line $coords \
-                                  -width $lthickness -fill $colormap($p)]
-                       $canv lower $t
-                       bindline $t $p
+                       lappend sidelines($p) [list $coords 1]

                    }
                }
            }
        } elseif {[lindex $todo $i] != $id} {
            set j [lsearch -exact $todo $id]
            set xj [expr {$canvx0 + $j * $linespc}]
                    }
                }
            }
        } elseif {[lindex $todo $i] != $id} {
            set j [lsearch -exact $todo $id]
            set xj [expr {$canvx0 + $j * $linespc}]

-           lappend glines($id) $xi $y1 $xj $y2
+           lappend mainline($id) $xi $y1 $xj $y2

        }
     }
 }
        }
     }
 }


@@ -841,7 +917,7 @@ proc decidenext {} {
        if {$todo != {}} {
            puts "ERROR: none of the pending commits can be done yet:"
            foreach p $todo {
        if {$todo != {}} {
            puts "ERROR: none of the pending commits can be done yet:"
            foreach p $todo {

-               puts "  $p"
+               puts "  $p ($ncleft($p))"

            }
        }
        return -1
            }
        }
        return -1


@@ -880,14 +956,12 @@ proc drawcommit {id} {
        set todo $id
        set startcommits $id
        initgraph
        set todo $id
        set startcommits $id
        initgraph

-       assigncolor $id

        drawcommitline 0
        updatetodo 0 $datemode
     } else {
        if {$nchildren($id) == 0} {
            lappend todo $id
            lappend startcommits $id
        drawcommitline 0
        updatetodo 0 $datemode
     } else {
        if {$nchildren($id) == 0} {
            lappend todo $id
            lappend startcommits $id

-           assigncolor $id

        }
        set level [decidenext]
        if {$id != [lindex $todo $level]} {
        }
        set level [decidenext]
        if {$id != [lindex $todo $level]} {


@@ -1628,7 +1702,6 @@ foreach arg $argv {
     }
 }
 
     }
 }
 

-set noreadobj [catch {load libreadobj.so.0.0}]

 set stopped 0
 set redisplaying 0
 set stuffsaved 0
 set stopped 0
 set redisplaying 0
 set stuffsaved 0