Use git-rev-list --header.

With --header, git-rev-list gives us the contents of the commit
in-line, so we don't need to exec a git-cat-file to get it, and we
don't need the readobj command either.
Also fixed a residual problem with handling the commit that
has a parent listed twice.

diff --git a/gitk b/gitk
index fef705ce97af4b9b42c6016e5c13af6bb4a0e726..922701ca755e40194754fdad1f2a14b4d50f2c29 100755 (executable)
--- a/gitk
+++ b/gitk
@@ -12,30 +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

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

-       set parse_args [concat --default HEAD --merge-order $rargs]
+       set parse_args [concat --default HEAD $rargs]

        set parsed_args [split [eval exec git-rev-parse $parse_args] "\n"]
     }] {
        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
        }
        if {$rargs == {}} {
            set rargs HEAD
        }

-       set parsed_args [concat --merge-order $rargs]
+       set parsed_args $rargs

     }
     if [catch {
     }
     if [catch {

-       set commfd [open "|git-rev-list $parsed_args" r]
+       set commfd [open "|git-rev-list --header --merge-order $parsed_args" r]

     } err] {
        puts stderr "Error executing git-rev-list: $err"
        exit 1
     }
     } err] {
        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


@@ -43,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


@@ -68,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
+                   }

                }
            }
        }
                }
            }
        }


@@ -109,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 {}


@@ -130,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 == {}} {


@@ -153,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)


@@ -545,7 +549,7 @@ proc assigncolor {id} {
     global parents nparents children nchildren
     if [info exists colormap($id)] return
     set ncolors [llength $colors]
     global parents nparents children nchildren
     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} {


@@ -583,7 +587,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


@@ -592,7 +596,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)
     }


@@ -610,12 +615,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


@@ -631,6 +635,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)]} {


@@ -648,21 +653,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


@@ -718,38 +733,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
        }


@@ -758,7 +767,7 @@ proc updatetodo {level noshortcut} {
 }
 
 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
 


@@ -782,33 +791,27 @@ proc drawslants {} {
                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

        }
     }
 }
        }
     }
 }


@@ -849,7 +852,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


@@ -888,14 +891,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]} {


@@ -1636,7 +1637,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