X-Git-Url: https://git.verplant.org/?a=blobdiff_plain;f=gitk;h=faaffe13a0e8903fa84690c89d6b5a9473bae39d;hb=180926636e47ecfe28d03cec493af75899994f0f;hp=f6c4ec2f1f20b95ecc9df819c977676f1c344d6e;hpb=84ba73458059ff0a50dbf1a63dff73be63f09795;p=git.git

diff --git a/gitk b/gitk
index f6c4ec2f..faaffe13 100755
--- a/gitk
+++ b/gitk
@@ -12,22 +12,31 @@ exec wish "$0" -- "${1+$@}"
 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]
-    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
     }
-    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
@@ -35,13 +44,13 @@ proc getcommits {rargs} {
     $ctext config -cursor watch
 }
 
-proc getcommitline {commfd}  {
-    global commits parents cdate children nchildren ncleft
+proc getcommitlines {commfd}  {
+    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
@@ -60,35 +69,41 @@ to allow selection of commits to be displayed.)}
 	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
-    fileevent $commfd readable "getcommitline $commfd"
+    fileevent $commfd readable "getcommitlines $commfd"
 }
 
 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 noreadobj
 
     set inhdr 1
     set comment {}
@@ -122,13 +141,6 @@ proc readcommit {id} {
     }
     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 == {}} {
@@ -144,12 +156,11 @@ proc readcommit {id} {
 		    }
 		    lappend parents($id) $p
 		    incr nparents($id)
-		    if {[lsearch -exact $children($p) $id] < 0} {
+		    # sometimes we get a commit that lists a parent twice...
+		    if {$listed && [lsearch -exact $children($p) $id] < 0} {
 			lappend children($p) $id
 			incr nchildren($p)
 			incr ncleft($p)
-		    } else {
-			puts "child $id already in $p's list??"
 		    }
 		} elseif {$tag == "author"} {
 		    set x [expr {[llength $line] - 2}]
@@ -163,10 +174,15 @@ proc readcommit {id} {
 	    }
 	} else {
 	    if {$comment == {}} {
-		set headline $line
+		set headline [string trim $line]
 	    } 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
 	}
     }
@@ -536,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
+    global cornercrossings crossings
+
     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} {
@@ -547,22 +565,50 @@ proc assigncolor {id} {
 	}
     }
     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 {[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 {}
+	}
+    }
+    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]
@@ -576,7 +622,7 @@ proc assigncolor {id} {
 
 proc initgraph {} {
     global canvy canvy0 lineno numcommits lthickness nextcolor linespc
-    global glines
+    global mainline sidelines
     global nchildren ncleft
 
     allcanvs delete all
@@ -585,21 +631,30 @@ proc initgraph {} {
     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)
     }
 }
 
+proc bindline {t id} {
+    global canv
+
+    $canv bind $t <Button-3> "linemenu %X %Y $id"
+    $canv bind $t <Enter> "lineenter %x %y $id"
+    $canv bind $t <Motion> "linemotion %x %y $id"
+    $canv bind $t <Leave> "lineleave $id"
+}
+
 proc drawcommitline {level} {
-    global parents children nparents nchildren ncleft todo
+    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
+    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
@@ -615,24 +670,40 @@ proc drawcommitline {level} {
 	    set nparents($id) 0
 	}
     }
+    assigncolor $id
     set currentparents {}
+    set dupparents {}
     if {[info exists commitlisted($id)] && [info exists parents($id)]} {
-	set currentparents $parents($id)
+	foreach p $parents($id) {
+	    if {[lsearch -exact $currentparents $p] < 0} {
+		lappend currentparents $p
+	    } else {
+		# remember that this parent was listed twice
+		lappend dupparents $p
+	    }
+	}
     }
     set x [expr $canvx0 + $level * $linespc]
     set y1 $canvy
     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
-	$canv bind $t <Button-3> "linemenu %X %Y $id"
-	$canv bind $t <Enter> "lineenter %x %y $id"
-	$canv bind $t <Motion> "linemotion %x %y $id"
-	$canv bind $t <Leave> "lineleave $id"
+	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] \
@@ -640,8 +711,8 @@ proc drawcommitline {level} {
 	       -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
@@ -667,10 +738,6 @@ proc drawcommitline {level} {
 	set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
 		   -width $lthickness -fill black]
 	$canv lower $t
-	$canv bind $t <Button-3> "linemenu %X %Y $id"
-	$canv bind $t <Enter> "lineenter %x %y $id"
-	$canv bind $t <Motion> "linemotion %x %y $id"
-	$canv bind $t <Leave> "lineleave $id"
 	foreach tag $marks x $xvals wid $wvals {
 	    set xl [expr $x + $delta]
 	    set xr [expr $x + $delta + $wid + $lthickness]
@@ -701,38 +768,32 @@ proc drawcommitline {level} {
 }
 
 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
 
-    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 {$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 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} {
-	    assigncolor $p
 	    set todo [linsert $todo $i $p]
 	    incr i
 	}
@@ -740,9 +801,37 @@ proc updatetodo {level noshortcut} {
     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 {} {
-    global canv glines canvx0 canvy linespc
-    global oldlevel oldtodo todo currentparents
+    global canv mainline sidelines canvx0 canvy linespc
+    global oldlevel oldtodo todo currentparents dupparents
     global lthickness linespc canvy colormap
 
     set y1 [expr $canvy - $linespc]
@@ -755,34 +844,39 @@ proc drawslants {} {
 	if {$i == $oldlevel} {
 	    foreach p $currentparents {
 		set j [lsearch -exact $todo $p]
-		if {$i == $j && ![info exists glines($p)]} {
-		    set glines($p) [list $xi $y1]
-		} else {
-		    set xj [expr {$canvx0 + $j * $linespc}]
-		    set coords [list $xi $y1]
-		    if {$j < $i - 1} {
-			lappend coords [expr $xj + $linespc] $y1
-		    } elseif {$j > $i + 1} {
-			lappend coords [expr $xj - $linespc] $y1
-		    }
+		set coords [list $xi $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
+		    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 {![info exists glines($p)]} {
-			set glines($p) $coords
+		    lappend sidelines($p) [list $coords 2]
+		    if {![info exists mainline($p)]} {
+			set mainline($p) [list $xj $y2]
+		    }
+		} else {
+		    # normal case, no parent duplicated
+		    if {![info exists mainline($p)]} {
+			if {$i != $j} {
+			    lappend coords $xj $y2
+			}
+			set mainline($p) $coords
 		    } else {
-			set t [$canv create line $coords -width $lthickness \
-				   -fill $colormap($p)]
-			$canv lower $t
-			$canv bind $t <Button-3> "linemenu %X %Y $p"
-			$canv bind $t <Enter> "lineenter %x %y $p"
-			$canv bind $t <Motion> "linemotion %x %y $p"
-			$canv bind $t <Leave> "lineleave $p"
+			lappend coords $xj $y2
+			lappend sidelines($p) [list $coords 1]
 		    }
 		}
 	    }
 	} 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
 	}
     }
 }
@@ -823,7 +917,7 @@ proc decidenext {} {
 	if {$todo != {}} {
 	    puts "ERROR: none of the pending commits can be done yet:"
 	    foreach p $todo {
-		puts "  $p"
+		puts "  $p ($ncleft($p))"
 	    }
 	}
 	return -1
@@ -862,14 +956,12 @@ proc drawcommit {id} {
 	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
-	    assigncolor $id
 	}
 	set level [decidenext]
 	if {$id != [lindex $todo $level]} {
@@ -929,34 +1021,36 @@ proc drawrest {level startix} {
     global numcommits
     global nextupdate startmsecs startcommits idline
 
-    set phase drawgraph
-    set startid [lindex $startcommits $startix]
-    set startline -1
-    if {$startid != {}} {
-	set startline $idline($startid)
-    }
-    while 1 {
-	if {$stopped} break
-	drawcommitline $level
-	set hard [updatetodo $level $datemode]
-	if {$numcommits == $startline} {
-	    lappend todo $startid
-	    set hard 1
-	    incr startix
-	    set startid [lindex $startcommits $startix]
-	    set startline -1
-	    if {$startid != {}} {
-		set startline $idline($startid)
-	    }
+    if {$level >= 0} {
+	set phase drawgraph
+	set startid [lindex $startcommits $startix]
+	set startline -1
+	if {$startid != {}} {
+	    set startline $idline($startid)
 	}
-	if {$hard} {
-	    set level [decidenext]
-	    if {$level < 0} break
-	    drawslants
-	}
-	if {[clock clicks -milliseconds] >= $nextupdate} {
-	    update
-	    incr nextupdate 100
+	while 1 {
+	    if {$stopped} break
+	    drawcommitline $level
+	    set hard [updatetodo $level $datemode]
+	    if {$numcommits == $startline} {
+		lappend todo $startid
+		set hard 1
+		incr startix
+		set startid [lindex $startcommits $startix]
+		set startline -1
+		if {$startid != {}} {
+		    set startline $idline($startid)
+		}
+	    }
+	    if {$hard} {
+		set level [decidenext]
+		if {$level < 0} break
+		drawslants
+	    }
+	    if {[clock clicks -milliseconds] >= $nextupdate} {
+		update
+		incr nextupdate 100
+	    }
 	}
     }
     set phase {}
@@ -1608,7 +1702,6 @@ foreach arg $argv {
     }
 }
 
-set noreadobj [catch {load libreadobj.so.0.0}]
 set stopped 0
 set redisplaying 0
 set stuffsaved 0