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.
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 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
$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
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
+ }
incr nextupdate 100
fileevent $commfd readable {}
update
incr nextupdate 100
fileevent $commfd readable {}
update
- fileevent $commfd readable "getcommitline $commfd"
+ fileevent $commfd readable "getcommitlines $commfd"
+ 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
set inhdr 1
set comment {}
set inhdr 1
set comment {}
}
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 == {}} {
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)
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} {
proc initgraph {} {
global canvy canvy0 lineno numcommits lthickness nextcolor linespc
proc initgraph {} {
global canvy canvy0 lineno numcommits lthickness nextcolor linespc
+ global mainline sidelines
global nchildren ncleft
allcanvs delete all
global nchildren ncleft
allcanvs delete all
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 mainline}
+ catch {unset sidelines}
foreach id [array names nchildren] {
set ncleft($id) $nchildren($id)
}
foreach id [array names nchildren] {
set ncleft($id) $nchildren($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 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
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)]} {
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
}
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
- 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} {
set todo [linsert $todo $i $p]
incr i
}
set todo [linsert $todo $i $p]
incr i
}
- 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
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 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
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 ($ncleft($p))"
set todo $id
set startcommits $id
initgraph
set todo $id
set startcommits $id
initgraph
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
}
set level [decidenext]
if {$id != [lindex $todo $level]} {
}
set level [decidenext]
if {$id != [lindex $todo $level]} {
-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
projects / git.git / commitdiff