+# Procedures used in reordering commits from git log (without
+# --topo-order) into the order for display.
+
+proc varcinit {view} {
+ global vseeds varcstart vupptr vdownptr vleftptr varctok varcrow
+ global vtokmod varcmod varcix uat
+
+ set vseeds($view) {}
+ set varcstart($view) {{}}
+ set vupptr($view) {0}
+ set vdownptr($view) {0}
+ set vleftptr($view) {0}
+ set varctok($view) {{}}
+ set varcrow($view) {{}}
+ set vtokmod($view) {}
+ set varcmod($view) 0
+ set varcix($view) {{}}
+ set uat 0
+}
+
+proc resetvarcs {view} {
+ global varcid varccommits parents children vseedcount ordertok
+
+ foreach vid [array names varcid $view,*] {
+ unset varcid($vid)
+ unset children($vid)
+ unset parents($vid)
+ }
+ # some commits might have children but haven't been seen yet
+ foreach vid [array names children $view,*] {
+ unset children($vid)
+ }
+ foreach va [array names varccommits $view,*] {
+ unset varccommits($va)
+ }
+ foreach vd [array names vseedcount $view,*] {
+ unset vseedcount($vd)
+ }
+ foreach vid [array names ordertok $view,*] {
+ unset ordertok($vid)
+ }
+}
+
+proc newvarc {view id} {
+ global varcid varctok parents children vseeds
+ global vupptr vdownptr vleftptr varcrow varcix varcstart
+ global commitdata commitinfo vseedcount
+
+ set a [llength $varctok($view)]
+ set vid $view,$id
+ if {[llength $children($vid)] == 0} {
+ if {![info exists commitinfo($id)]} {
+ parsecommit $id $commitdata($id) 1
+ }
+ set cdate [lindex $commitinfo($id) 4]
+ if {![string is integer -strict $cdate]} {
+ set cdate 0
+ }
+ if {![info exists vseedcount($view,$cdate)]} {
+ set vseedcount($view,$cdate) -1
+ }
+ set c [incr vseedcount($view,$cdate)]
+ set cdate [expr {$cdate ^ 0xffffffff}]
+ set tok "s[strrep $cdate][strrep $c]"
+ lappend vseeds($view) $id
+ lappend vupptr($view) 0
+ set ka [lindex $vdownptr($view) 0]
+ if {$ka == 0 ||
+ [string compare $tok [lindex $varctok($view) $ka]] < 0} {
+ lset vdownptr($view) 0 $a
+ lappend vleftptr($view) $ka
+ } else {
+ while {[set b [lindex $vleftptr($view) $ka]] != 0 &&
+ [string compare $tok [lindex $varctok($view) $b]] >= 0} {
+ set ka $b
+ }
+ lset vleftptr($view) $ka $a
+ lappend vleftptr($view) $b
+ }
+ } else {
+ set tok {}
+ foreach k $children($vid) {
+ set ka $varcid($view,$k)
+ if {[string compare [lindex $varctok($view) $ka] $tok] > 0} {
+ set ki $k
+ set tok [lindex $varctok($view) $ka]
+ }
+ }
+ set ka $varcid($view,$ki)
+ lappend vupptr($view) $ka
+ set i [lsearch -exact $parents($view,$ki) $id]
+ set j [expr {[llength $parents($view,$ki)] - 1 - $i}]
+ set rsib 0
+ while {[incr i] < [llength $parents($view,$ki)]} {
+ set bi [lindex $parents($view,$ki) $i]
+ if {[info exists varcid($view,$bi)]} {
+ set b $varcid($view,$bi)
+ if {[lindex $vupptr($view) $b] == $ka} {
+ set rsib $b
+ lappend vleftptr($view) [lindex $vleftptr($view) $b]
+ lset vleftptr($view) $b $a
+ break
+ }
+ }
+ }
+ if {$rsib == 0} {
+ lappend vleftptr($view) [lindex $vdownptr($view) $ka]
+ lset vdownptr($view) $ka $a
+ }
+ append tok [strrep $j]
+ }
+ lappend varctok($view) $tok
+ lappend varcstart($view) $id
+ lappend vdownptr($view) 0
+ lappend varcrow($view) {}
+ lappend varcix($view) {}
+ return $a
+}
+
+proc splitvarc {p v} {
+ global varcid varcstart varccommits varctok
+ global vupptr vdownptr vleftptr varcix varcrow
+
+ set oa $varcid($v,$p)
+ set ac $varccommits($v,$oa)
+ set i [lsearch -exact $varccommits($v,$oa) $p]
+ if {$i <= 0} return
+ set na [llength $varctok($v)]
+ # "%" sorts before "0"...
+ set tok "[lindex $varctok($v) $oa]%[strrep $i]"
+ lappend varctok($v) $tok
+ lappend varcrow($v) {}
+ lappend varcix($v) {}
+ set varccommits($v,$oa) [lrange $ac 0 [expr {$i - 1}]]
+ set varccommits($v,$na) [lrange $ac $i end]
+ lappend varcstart($v) $p
+ foreach id $varccommits($v,$na) {
+ set varcid($v,$id) $na
+ }
+ lappend vdownptr($v) [lindex $vdownptr($v) $oa]
+ lset vdownptr($v) $oa $na
+ lappend vupptr($v) $oa
+ lappend vleftptr($v) 0
+ for {set b [lindex $vdownptr($v) $na]} {$b != 0} {set b [lindex $vleftptr($v) $b]} {
+ lset vupptr($v) $b $na
+ }
+}
+
+proc renumbervarc {a v} {
+ global parents children varctok varcstart varccommits
+ global vupptr vdownptr vleftptr varcid vtokmod varcmod
+
+ set t1 [clock clicks -milliseconds]
+ set todo {}
+ set isrelated($a) 1
+ set ntot 0
+ while {$a != 0} {
+ if {[info exists isrelated($a)]} {
+ lappend todo $a
+ set id [lindex $varccommits($v,$a) end]
+ foreach p $parents($v,$id) {
+ if {[info exists varcid($v,$p)]} {
+ set isrelated($varcid($v,$p)) 1
+ }
+ }
+ }
+ incr ntot
+ set b [lindex $vdownptr($v) $a]
+ if {$b == 0} {
+ while {$a != 0} {
+ set b [lindex $vleftptr($v) $a]
+ if {$b != 0} break
+ set a [lindex $vupptr($v) $a]
+ }
+ }
+ set a $b
+ }
+ foreach a $todo {
+ set id [lindex $varcstart($v) $a]
+ set tok {}
+ foreach k $children($v,$id) {
+ set ka $varcid($v,$k)
+ if {[string compare [lindex $varctok($v) $ka] $tok] > 0} {
+ set ki $k
+ set tok [lindex $varctok($v) $ka]
+ }
+ }
+ if {$tok ne {}} {
+ set ka $varcid($v,$ki)
+ set i [lsearch -exact $parents($v,$ki) $id]
+ set j [expr {[llength $parents($v,$ki)] - 1 - $i}]
+ append tok [strrep $j]
+ set oldtok [lindex $varctok($v) $a]
+ if {$tok eq $oldtok} continue
+ lset varctok($v) $a $tok
+ } else {
+ set ka 0
+ }
+ set b [lindex $vupptr($v) $a]
+ if {$b != $ka} {
+ set c [lindex $vdownptr($v) $b]
+ if {$c == $a} {
+ lset vdownptr($v) $b [lindex $vleftptr($v) $a]
+ } else {
+ set b $c
+ while {$b != 0 && [lindex $vleftptr($v) $b] != $a} {
+ set b [lindex $vleftptr($v) $b]
+ }
+ if {$b != 0} {
+ lset vleftptr($v) $b [lindex $vleftptr($v) $a]
+ } else {
+ puts "oops couldn't find $a in chain for [lindex $vupptr($v) $a]"
+ }
+ }
+ lset vupptr($v) $a $ka
+ set rsib 0
+ while {[incr i] < [llength $parents($v,$ki)]} {
+ set bi [lindex $parents($v,$ki) $i]
+ if {[info exists varcid($v,$bi)]} {
+ set b $varcid($v,$bi)
+ if {[lindex $vupptr($v) $b] == $ka} {
+ set rsib $b
+ lset vleftptr($v) $a [lindex $vleftptr($v) $b]
+ lset vleftptr($v) $b $a
+ break
+ }
+ }
+ }
+ if {$rsib == 0} {
+ lset vleftptr($v) $a [lindex $vdownptr($v) $ka]
+ lset vdownptr($v) $ka $a
+ }
+ }
+ }
+ set t2 [clock clicks -milliseconds]
+ #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
+}
+
+proc fix_reversal {p a v} {
+ global varcid varcstart varctok vupptr vseeds
+
+ set pa $varcid($v,$p)
+ if {$p ne [lindex $varcstart($v) $pa]} {
+ splitvarc $p $v
+ set pa $varcid($v,$p)
+ }
+ # seeds always need to be renumbered (and taken out of the seeds list)
+ if {[lindex $vupptr($v) $pa] == 0} {
+ set i [lsearch -exact $vseeds($v) $p]
+ if {$i >= 0} {
+ set vseeds($v) [lreplace $vseeds($v) $i $i]
+ } else {
+ puts "oops couldn't find [shortids $p] in seeds"
+ }
+ renumbervarc $pa $v
+ } elseif {[string compare [lindex $varctok($v) $a] \
+ [lindex $varctok($v) $pa]] > 0} {
+ renumbervarc $pa $v
+ }
+}
+
+proc insertrow {id p v} {
+ global varcid varccommits parents children cmitlisted ordertok
+ global commitidx varctok vtokmod varcmod
+
+ set a $varcid($v,$p)
+ set i [lsearch -exact $varccommits($v,$a) $p]
+ if {$i < 0} {
+ puts "oops: insertrow can't find [shortids $p] on arc $a"
+ return
+ }
+ set children($v,$id) {}
+ set parents($v,$id) [list $p]
+ set varcid($v,$id) $a
+ if {[llength [lappend children($v,$p) $id]] > 1 &&
+ [vtokcmp $v [lindex $children($v,$p) end-1] $id] > 0} {
+ set children($v,$p) [lsort -command [list vtokcmp $v] $children($v,$p)]
+ }
+ set cmitlisted($v,$id) 1
+ incr commitidx($v)
+ set ordertok($v,$id) $ordertok($v,$p)
+ # note we deliberately don't update varcstart($v) even if $i == 0
+ set varccommits($v,$a) [linsert $varccommits($v,$a) $i $id]
+ set tok [lindex $varctok($v) $a]
+ if {[string compare $tok $vtokmod($v)] < 0} {
+ set vtokmod($v) $tok
+ set varcmod($v) $a
+ }
+ update_arcrows $v
+}
+
+proc removerow {id v} {
+ global varcid varccommits parents children commitidx ordertok
+ global varctok vtokmod varcmod
+
+ if {[llength $parents($v,$id)] != 1} {
+ puts "oops: removerow [shortids $id] has [llength $parents($v,$id)] parents"
+ return
+ }
+ set p [lindex $parents($v,$id) 0]
+ set a $varcid($v,$id)
+ set i [lsearch -exact $varccommits($v,$a) $id]
+ if {$i < 0} {
+ puts "oops: removerow can't find [shortids $id] on arc $a"
+ return
+ }
+ unset varcid($v,$id)
+ set varccommits($v,$a) [lreplace $varccommits($v,$a) $i $i]
+ unset parents($v,$id)
+ unset children($v,$id)
+ unset cmitlisted($v,$id)
+ unset ordertok($v,$id)
+ incr commitidx($v) -1
+ set j [lsearch -exact $children($v,$p) $id]
+ if {$j >= 0} {
+ set children($v,$p) [lreplace $children($v,$p) $j $j]
+ }
+ set tok [lindex $varctok($v) $a]
+ if {[string compare $tok $vtokmod($v)] < 0} {
+ set vtokmod($v) $tok
+ set varcmod($v) $a
+ }
+ update_arcrows $v
+}
+
+proc vtokcmp {v a b} {
+ global varctok varcid
+
+ return [string compare [lindex $varctok($v) $varcid($v,$a)] \
+ [lindex $varctok($v) $varcid($v,$b)]]
+}
+
+proc update_arcrows {v} {
+ global vtokmod varcmod varcrow commitidx currentid selectedline
+ global varcid vseeds vrownum varcorder varcix varccommits
+ global vupptr vdownptr vleftptr varctok
+ global uat displayorder parentlist curview cached_commitrow
+
+ set t1 [clock clicks -milliseconds]
+ set narctot [expr {[llength $varctok($v)] - 1}]
+ set a $varcmod($v)
+ while {$a != 0 && [lindex $varcix($v) $a] eq {}} {
+ # go up the tree until we find something that has a row number,
+ # or we get to a seed
+ set a [lindex $vupptr($v) $a]
+ }
+ if {$a == 0} {
+ set a [lindex $vdownptr($v) 0]
+ if {$a == 0} return
+ set vrownum($v) {0}
+ set varcorder($v) [list $a]
+ lset varcix($v) $a 0
+ lset varcrow($v) $a 0
+ set arcn 0
+ set row 0
+ } else {
+ set arcn [lindex $varcix($v) $a]
+ # see if a is the last arc; if so, nothing to do
+ if {$arcn == $narctot - 1} {
+ return
+ }
+ if {[llength $vrownum($v)] > $arcn + 1} {
+ set vrownum($v) [lrange $vrownum($v) 0 $arcn]
+ set varcorder($v) [lrange $varcorder($v) 0 $arcn]
+ }
+ set row [lindex $varcrow($v) $a]
+ }
+ if {[llength $displayorder] > $row} {
+ set displayorder [lrange $displayorder 0 [expr {$row - 1}]]
+ set parentlist [lrange $parentlist 0 [expr {$row - 1}]]
+ }
+ if {$v == $curview} {
+ catch {unset cached_commitrow}
+ }
+ set startrow $row
+ while {1} {
+ set p $a
+ incr row [llength $varccommits($v,$a)]
+ # go down if possible
+ set b [lindex $vdownptr($v) $a]
+ if {$b == 0} {
+ # if not, go left, or go up until we can go left
+ while {$a != 0} {
+ set b [lindex $vleftptr($v) $a]
+ if {$b != 0} break
+ set a [lindex $vupptr($v) $a]
+ }
+ if {$a == 0} break
+ }
+ set a $b
+ incr arcn
+ lappend vrownum($v) $row
+ lappend varcorder($v) $a
+ lset varcix($v) $a $arcn
+ lset varcrow($v) $a $row
+ }
+ if {[info exists currentid]} {
+ set selectedline [rowofcommit $currentid]
+ }
+ undolayout $startrow
+ if {$row != $commitidx($v)} {
+ puts "oops update_arcrows got to row $row out of $commitidx($v)"
+ set vtokmod($v) {}
+ set varcmod($v) 0
+ } else {
+ set vtokmod($v) [lindex $varctok($v) $p]
+ set varcmod($v) $p
+ }
+ set t2 [clock clicks -milliseconds]
+ incr uat [expr {$t2-$t1}]
+}
+
+# Test whether view $v contains commit $id
+proc commitinview {id v} {
+ global varcid
+
+ return [info exists varcid($v,$id)]
+}
+
+# Return the row number for commit $id in the current view
+proc rowofcommit {id} {
+ global varcid varccommits varcrow curview cached_commitrow
+
+ if {[info exists cached_commitrow($id)]} {
+ return $cached_commitrow($id)
+ }
+ set v $curview
+ if {![info exists varcid($v,$id)]} {
+ puts "oops rowofcommit no arc for [shortids $id]"
+ return {}
+ }
+ set a $varcid($v,$id)
+ set i [lsearch -exact $varccommits($v,$a) $id]
+ if {$i < 0} {
+ puts "oops didn't find commit [shortids $id] in arc $a"
+ return {}
+ }
+ incr i [lindex $varcrow($v) $a]
+ set cached_commitrow($id) $i
+ return $i
+}
+
+proc bsearch {l elt} {
+ if {[llength $l] == 0 || $elt <= [lindex $l 0]} {
+ return 0
+ }
+ set lo 0
+ set hi [llength $l]
+ while {$hi - $lo > 1} {
+ set mid [expr {int(($lo + $hi) / 2)}]
+ set t [lindex $l $mid]
+ if {$elt < $t} {
+ set hi $mid
+ } elseif {$elt > $t} {
+ set lo $mid
+ } else {
+ return $mid
+ }
+ }
+ return $lo
+}
+
+# Make sure rows $start..$end-1 are valid in displayorder and parentlist
+proc make_disporder {start end} {
+ global vrownum curview commitidx displayorder parentlist
+ global varccommits varcorder parents
+ global d_valid_start d_valid_end
+
+ set ai [bsearch $vrownum($curview) $start]
+ set start [lindex $vrownum($curview) $ai]
+ set narc [llength $vrownum($curview)]
+ for {set r $start} {$ai < $narc && $r < $end} {incr ai} {
+ set a [lindex $varcorder($curview) $ai]
+ set l [llength $displayorder]
+ set al [llength $varccommits($curview,$a)]
+ if {$l < $r + $al} {
+ if {$l < $r} {
+ set pad [ntimes [expr {$r - $l}] {}]
+ set displayorder [concat $displayorder $pad]
+ set parentlist [concat $parentlist $pad]
+ } elseif {$l > $r} {
+ set displayorder [lrange $displayorder 0 [expr {$r - 1}]]
+ set parentlist [lrange $parentlist 0 [expr {$r - 1}]]
+ }
+ foreach id $varccommits($curview,$a) {
+ lappend displayorder $id
+ lappend parentlist $parents($curview,$id)
+ }
+ } elseif {[lindex $displayorder $r] eq {}} {
+ set i $r
+ foreach id $varccommits($curview,$a) {
+ lset displayorder $i $id
+ lset parentlist $i $parents($curview,$id)
+ incr i
+ }
+ }
+ incr r $al
+ }
+}
+
+proc commitonrow {row} {
+ global displayorder
+
+ set id [lindex $displayorder $row]
+ if {$id eq {}} {
+ make_disporder $row [expr {$row + 1}]
+ set id [lindex $displayorder $row]
+ }
+ return $id
+}
+
+proc closevarcs {v} {
+ global varctok varccommits varcid parents children
+ global cmitlisted commitidx commitinterest vtokmod varcmod
+
+ set missing_parents 0
+ set scripts {}
+ set narcs [llength $varctok($v)]
+ for {set a 1} {$a < $narcs} {incr a} {
+ set id [lindex $varccommits($v,$a) end]
+ foreach p $parents($v,$id) {
+ if {[info exists varcid($v,$p)]} continue
+ # add p as a new commit
+ incr missing_parents
+ set cmitlisted($v,$p) 0
+ set parents($v,$p) {}
+ if {[llength $children($v,$p)] == 1 &&
+ [llength $parents($v,$id)] == 1} {
+ set b $a
+ } else {
+ set b [newvarc $v $p]
+ }
+ set varcid($v,$p) $b
+ lappend varccommits($v,$b) $p
+ set tok [lindex $varctok($v) $b]
+ if {[string compare $tok $vtokmod($v)] < 0} {
+ set vtokmod($v) $tok
+ set varcmod($v) $b
+ }
+ incr commitidx($v)
+ if {[info exists commitinterest($p)]} {
+ foreach script $commitinterest($p) {
+ lappend scripts [string map [list "%I" $p] $script]
+ }
+ unset commitinterest($id)
+ }
+ }
+ }
+ if {$missing_parents > 0} {
+ update_arcrows $v
+ foreach s $scripts {
+ eval $s
+ }
+ }
+}
+
+proc getcommitlines {fd inst view} {
+ global cmitlisted commitinterest leftover getdbg
+ global commitidx commitdata
+ global parents children curview hlview