gitk

#!/bin/sh
# Tcl ignores the next line -*- tcl -*- \
exec wish "$0" -- "$@"

# Copyright © 2005-2014 Paul Mackerras.  All rights reserved.
# This program is free software; it may be used, copied, modified
# and distributed under the terms of the GNU General Public Licence,
# either version 2, or (at your option) any later version.

package require Tk

proc hasworktree {} {
    return [expr {[exec git rev-parse --is-bare-repository] == "false" &&
		  [exec git rev-parse --is-inside-git-dir] == "false"}]
}

proc reponame {} {
    global gitdir
    set n [file normalize $gitdir]
    if {[string match "*/.git" $n]} {
	set n [string range $n 0 end-5]
    }
    return [file tail $n]
}

proc gitworktree {} {
    variable _gitworktree
    if {[info exists _gitworktree]} {
	return $_gitworktree
    }
    # v1.7.0 introduced --show-toplevel to return the canonical work-tree
    if {[catch {set _gitworktree [exec git rev-parse --show-toplevel]}]} {
        # try to set work tree from environment, core.worktree or use
        # cdup to obtain a relative path to the top of the worktree. If
        # run from the top, the ./ prefix ensures normalize expands pwd.
        if {[catch { set _gitworktree $env(GIT_WORK_TREE) }]} {
	    catch {set _gitworktree [exec git config --get core.worktree]}
	    if {$_gitworktree eq ""} {
		set _gitworktree [file normalize ./[exec git rev-parse --show-cdup]]
	    }
        }
    }
    return $_gitworktree
}

# A simple scheduler for compute-intensive stuff.
# The aim is to make sure that event handlers for GUI actions can
# run at least every 50-100 ms.  Unfortunately fileevent handlers are
# run before X event handlers, so reading from a fast source can
# make the GUI completely unresponsive.
proc run args {
    global isonrunq runq currunq

    set script $args
    if {[info exists isonrunq($script)]} return
    if {$runq eq {} && ![info exists currunq]} {
	after idle dorunq
    }
    lappend runq [list {} $script]
    set isonrunq($script) 1
}

proc filerun {fd script} {
    fileevent $fd readable [list filereadable $fd $script]
}

proc filereadable {fd script} {
    global runq currunq

    fileevent $fd readable {}
    if {$runq eq {} && ![info exists currunq]} {
	after idle dorunq
    }
    lappend runq [list $fd $script]
}

proc nukefile {fd} {
    global runq

    for {set i 0} {$i < [llength $runq]} {} {
	if {[lindex $runq $i 0] eq $fd} {
	    set runq [lreplace $runq $i $i]
	} else {
	    incr i
	}
    }
}

proc dorunq {} {
    global isonrunq runq currunq

    set tstart [clock clicks -milliseconds]
    set t0 $tstart
    while {[llength $runq] > 0} {
	set fd [lindex $runq 0 0]
	set script [lindex $runq 0 1]
	set currunq [lindex $runq 0]
	set runq [lrange $runq 1 end]
	set repeat [eval $script]
	unset currunq
	set t1 [clock clicks -milliseconds]
	set t [expr {$t1 - $t0}]
	if {$repeat ne {} && $repeat} {
	    if {$fd eq {} || $repeat == 2} {
		# script returns 1 if it wants to be readded
		# file readers return 2 if they could do more straight away
		lappend runq [list $fd $script]
	    } else {
		fileevent $fd readable [list filereadable $fd $script]
	    }
	} elseif {$fd eq {}} {
	    unset isonrunq($script)
	}
	set t0 $t1
	if {$t1 - $tstart >= 80} break
    }
    if {$runq ne {}} {
	after idle dorunq
    }
}

proc reg_instance {fd} {
    global commfd leftover loginstance

    set i [incr loginstance]
    set commfd($i) $fd
    set leftover($i) {}
    return $i
}

proc unmerged_files {files} {
    global nr_unmerged

    # find the list of unmerged files
    set mlist {}
    set nr_unmerged 0
    if {[catch {
	set fd [open "| git ls-files -u" r]
    } err]} {
	show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
	exit 1
    }
    while {[gets $fd line] >= 0} {
	set i [string first "\t" $line]
	if {$i < 0} continue
	set fname [string range $line [expr {$i+1}] end]
	if {[lsearch -exact $mlist $fname] >= 0} continue
	incr nr_unmerged
	if {$files eq {} || [path_filter $files $fname]} {
	    lappend mlist $fname
	}
    }
    catch {close $fd}
    return $mlist
}

proc parseviewargs {n arglist} {
    global vdatemode vmergeonly vflags vdflags vrevs vfiltered vorigargs env
    global vinlinediff
    global worddiff git_version

    set vdatemode($n) 0
    set vmergeonly($n) 0
    set vinlinediff($n) 0
    set glflags {}
    set diffargs {}
    set nextisval 0
    set revargs {}
    set origargs $arglist
    set allknown 1
    set filtered 0
    set i -1
    foreach arg $arglist {
	incr i
	if {$nextisval} {
	    lappend glflags $arg
	    set nextisval 0
	    continue
	}
	switch -glob -- $arg {
	    "-d" -
	    "--date-order" {
		set vdatemode($n) 1
		# remove from origargs in case we hit an unknown option
		set origargs [lreplace $origargs $i $i]
		incr i -1
	    }
	    "-[puabwcrRBMC]" -
	    "--no-renames" - "--full-index" - "--binary" - "--abbrev=*" -
	    "--find-copies-harder" - "-l*" - "--ext-diff" - "--no-ext-diff" -
	    "--src-prefix=*" - "--dst-prefix=*" - "--no-prefix" -
	    "-O*" - "--text" - "--full-diff" - "--ignore-space-at-eol" -
	    "--ignore-space-change" - "-U*" - "--unified=*" {
		# These request or affect diff output, which we don't want.
		# Some could be used to set our defaults for diff display.
		lappend diffargs $arg
	    }
	    "--raw" - "--patch-with-raw" - "--patch-with-stat" -
	    "--name-only" - "--name-status" - "--color" -
	    "--log-size" - "--pretty=*" - "--decorate" - "--abbrev-commit" -
	    "--cc" - "-z" - "--header" - "--parents" - "--boundary" -
	    "--no-color" - "-g" - "--walk-reflogs" - "--no-walk" -
	    "--timestamp" - "relative-date" - "--date=*" - "--stdin" -
	    "--objects" - "--objects-edge" - "--reverse" {
		# These cause our parsing of git log's output to fail, or else
		# they're options we want to set ourselves, so ignore them.
	    }
	    "--color-words*" - "--word-diff=color" {
		# These trigger a word diff in the console interface,
		# so help the user by enabling our own support
		if {[package vcompare $git_version "1.7.2"] >= 0} {
		    set worddiff [mc "Color words"]
		}
	    }
	    "--word-diff*" {
		if {[package vcompare $git_version "1.7.2"] >= 0} {
		    set worddiff [mc "Markup words"]
		}
	    }
	    "--stat=*" - "--numstat" - "--shortstat" - "--summary" -
	    "--check" - "--exit-code" - "--quiet" - "--topo-order" -
	    "--full-history" - "--dense" - "--sparse" -
	    "--follow" - "--left-right" - "--encoding=*" {
		# These are harmless, and some are even useful
		lappend glflags $arg
	    }
	    "--diff-filter=*" - "--no-merges" - "--unpacked" -
	    "--max-count=*" - "--skip=*" - "--since=*" - "--after=*" -
	    "--until=*" - "--before=*" - "--max-age=*" - "--min-age=*" -
	    "--author=*" - "--committer=*" - "--grep=*" - "-[iE]" -
	    "--remove-empty" - "--first-parent" - "--cherry-pick" -
	    "-S*" - "-G*" - "--pickaxe-all" - "--pickaxe-regex" -
	    "--simplify-by-decoration" {
		# These mean that we get a subset of the commits
		set filtered 1
		lappend glflags $arg
	    }
	    "-L*" {
		# Line-log with 'stuck' argument (unstuck form is
		# not supported)
		set filtered 1
		set vinlinediff($n) 1
		set allknown 0
		lappend glflags $arg
	    }
	    "-n" {
		# This appears to be the only one that has a value as a
		# separate word following it
		set filtered 1
		set nextisval 1
		lappend glflags $arg
	    }
	    "--not" - "--all" {
		lappend revargs $arg
	    }
	    "--merge" {
		set vmergeonly($n) 1
		# git rev-parse doesn't understand --merge
		lappend revargs --gitk-symmetric-diff-marker MERGE_HEAD...HEAD
	    }
	    "--no-replace-objects" {
		set env(GIT_NO_REPLACE_OBJECTS) "1"
	    }
	    "-*" {
		# Other flag arguments including -<n>
		if {[string is digit -strict [string range $arg 1 end]]} {
		    set filtered 1
		} else {
		    # a flag argument that we don't recognize;
		    # that means we can't optimize
		    set allknown 0
		}
		lappend glflags $arg
	    }
	    default {
		# Non-flag arguments specify commits or ranges of commits
		if {[string match "*...*" $arg]} {
		    lappend revargs --gitk-symmetric-diff-marker
		}
		lappend revargs $arg
	    }
	}
    }
    set vdflags($n) $diffargs
    set vflags($n) $glflags
    set vrevs($n) $revargs
    set vfiltered($n) $filtered
    set vorigargs($n) $origargs
    return $allknown
}

proc parseviewrevs {view revs} {
    global vposids vnegids

    if {$revs eq {}} {
	set revs HEAD
    }
    if {[catch {set ids [eval exec git rev-parse $revs]} err]} {
	# we get stdout followed by stderr in $err
	# for an unknown rev, git rev-parse echoes it and then errors out
	set errlines [split $err "\n"]
	set badrev {}
	for {set l 0} {$l < [llength $errlines]} {incr l} {
	    set line [lindex $errlines $l]
	    if {!([string length $line] == 40 && [string is xdigit $line])} {
		if {[string match "fatal:*" $line]} {
		    if {[string match "fatal: ambiguous argument*" $line]
			&& $badrev ne {}} {
			if {[llength $badrev] == 1} {
			    set err "unknown revision $badrev"
			} else {
			    set err "unknown revisions: [join $badrev ", "]"
			}
		    } else {
			set err [join [lrange $errlines $l end] "\n"]
		    }
		    break
		}
		lappend badrev $line
	    }
	}
	error_popup "[mc "Error parsing revisions:"] $err"
	return {}
    }
    set ret {}
    set pos {}
    set neg {}
    set sdm 0
    foreach id [split $ids "\n"] {
	if {$id eq "--gitk-symmetric-diff-marker"} {
	    set sdm 4
	} elseif {[string match "^*" $id]} {
	    if {$sdm != 1} {
		lappend ret $id
		if {$sdm == 3} {
		    set sdm 0
		}
	    }
	    lappend neg [string range $id 1 end]
	} else {
	    if {$sdm != 2} {
		lappend ret $id
	    } else {
		lset ret end $id...[lindex $ret end]
	    }
	    lappend pos $id
	}
	incr sdm -1
    }
    set vposids($view) $pos
    set vnegids($view) $neg
    return $ret
}

# Start off a git log process and arrange to read its output
proc start_rev_list {view} {
    global startmsecs commitidx viewcomplete curview
    global tclencoding
    global viewargs viewargscmd viewfiles vfilelimit
    global showlocalchanges
    global viewactive viewinstances vmergeonly
    global mainheadid viewmainheadid viewmainheadid_orig
    global vcanopt vflags vrevs vorigargs
    global show_notes

    set startmsecs [clock clicks -milliseconds]
    set commitidx($view) 0
    # these are set this way for the error exits
    set viewcomplete($view) 1
    set viewactive($view) 0
    varcinit $view

    set args $viewargs($view)
    if {$viewargscmd($view) ne {}} {
	if {[catch {
	    set str [exec sh -c $viewargscmd($view)]
	} err]} {
	    error_popup "[mc "Error executing --argscmd command:"] $err"
	    return 0
	}
	set args [concat $args [split $str "\n"]]
    }
    set vcanopt($view) [parseviewargs $view $args]

    set files $viewfiles($view)
    if {$vmergeonly($view)} {
	set files [unmerged_files $files]
	if {$files eq {}} {
	    global nr_unmerged
	    if {$nr_unmerged == 0} {
		error_popup [mc "No files selected: --merge specified but\
			     no files are unmerged."]
	    } else {
		error_popup [mc "No files selected: --merge specified but\
			     no unmerged files are within file limit."]
	    }
	    return 0
	}
    }
    set vfilelimit($view) $files

    if {$vcanopt($view)} {
	set revs [parseviewrevs $view $vrevs($view)]
	if {$revs eq {}} {
	    return 0
	}
	set args [concat $vflags($view) $revs]
    } else {
	set args $vorigargs($view)
    }

    if {[catch {
	set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
			--parents --boundary $args "--" $files] r]
    } err]} {
	error_popup "[mc "Error executing git log:"] $err"
	return 0
    }
    set i [reg_instance $fd]
    set viewinstances($view) [list $i]
    set viewmainheadid($view) $mainheadid
    set viewmainheadid_orig($view) $mainheadid
    if {$files ne {} && $mainheadid ne {}} {
	get_viewmainhead $view
    }
    if {$showlocalchanges && $viewmainheadid($view) ne {}} {
	interestedin $viewmainheadid($view) dodiffindex
    }
    fconfigure $fd -blocking 0 -translation lf -eofchar {}
    if {$tclencoding != {}} {
	fconfigure $fd -encoding $tclencoding
    }
    filerun $fd [list getcommitlines $fd $i $view 0]
    nowbusy $view [mc "Reading"]
    set viewcomplete($view) 0
    set viewactive($view) 1
    return 1
}

proc stop_instance {inst} {
    global commfd leftover

    set fd $commfd($inst)
    catch {
	set pid [pid $fd]

	if {$::tcl_platform(platform) eq {windows}} {
	    exec kill -f $pid
	} else {
	    exec kill $pid
	}
    }
    catch {close $fd}
    nukefile $fd
    unset commfd($inst)
    unset leftover($inst)
}

proc stop_backends {} {
    global commfd

    foreach inst [array names commfd] {
	stop_instance $inst
    }
}

proc stop_rev_list {view} {
    global viewinstances

    foreach inst $viewinstances($view) {
	stop_instance $inst
    }
    set viewinstances($view) {}
}

proc reset_pending_select {selid} {
    global pending_select mainheadid selectheadid

    if {$selid ne {}} {
	set pending_select $selid
    } elseif {$selectheadid ne {}} {
	set pending_select $selectheadid
    } else {
	set pending_select $mainheadid
    }
}

proc getcommits {selid} {
    global canv curview need_redisplay viewactive

    initlayout
    if {[start_rev_list $curview]} {
	reset_pending_select $selid
	show_status [mc "Reading commits..."]
	set need_redisplay 1
    } else {
	show_status [mc "No commits selected"]
    }
}

proc updatecommits {} {
    global curview vcanopt vorigargs vfilelimit viewinstances
    global viewactive viewcomplete tclencoding
    global startmsecs showneartags showlocalchanges
    global mainheadid viewmainheadid viewmainheadid_orig pending_select
    global hasworktree
    global varcid vposids vnegids vflags vrevs
    global show_notes

    set hasworktree [hasworktree]
    rereadrefs
    set view $curview
    if {$mainheadid ne $viewmainheadid_orig($view)} {
	if {$showlocalchanges} {
	    dohidelocalchanges
	}
	set viewmainheadid($view) $mainheadid
	set viewmainheadid_orig($view) $mainheadid
	if {$vfilelimit($view) ne {}} {
	    get_viewmainhead $view
	}
    }
    if {$showlocalchanges} {
	doshowlocalchanges
    }
    if {$vcanopt($view)} {
	set oldpos $vposids($view)
	set oldneg $vnegids($view)
	set revs [parseviewrevs $view $vrevs($view)]
	if {$revs eq {}} {
	    return
	}
	# note: getting the delta when negative refs change is hard,
	# and could require multiple git log invocations, so in that
	# case we ask git log for all the commits (not just the delta)
	if {$oldneg eq $vnegids($view)} {
	    set newrevs {}
	    set npos 0
	    # take out positive refs that we asked for before or
	    # that we have already seen
	    foreach rev $revs {
		if {[string length $rev] == 40} {
		    if {[lsearch -exact $oldpos $rev] < 0
			&& ![info exists varcid($view,$rev)]} {
			lappend newrevs $rev
			incr npos
		    }
		} else {
		    lappend $newrevs $rev
		}
	    }
	    if {$npos == 0} return
	    set revs $newrevs
	    set vposids($view) [lsort -unique [concat $oldpos $vposids($view)]]
	}
	set args [concat $vflags($view) $revs --not $oldpos]
    } else {
	set args $vorigargs($view)
    }
    if {[catch {
	set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
			--parents --boundary $args "--" $vfilelimit($view)] r]
    } err]} {
	error_popup "[mc "Error executing git log:"] $err"
	return
    }
    if {$viewactive($view) == 0} {
	set startmsecs [clock clicks -milliseconds]
    }
    set i [reg_instance $fd]
    lappend viewinstances($view) $i
    fconfigure $fd -blocking 0 -translation lf -eofchar {}
    if {$tclencoding != {}} {
	fconfigure $fd -encoding $tclencoding
    }
    filerun $fd [list getcommitlines $fd $i $view 1]
    incr viewactive($view)
    set viewcomplete($view) 0
    reset_pending_select {}
    nowbusy $view [mc "Reading"]
    if {$showneartags} {
	getallcommits
    }
}

proc reloadcommits {} {
    global curview viewcomplete selectedline currentid thickerline
    global showneartags treediffs commitinterest cached_commitrow
    global targetid

    set selid {}
    if {$selectedline ne {}} {
	set selid $currentid
    }

    if {!$viewcomplete($curview)} {
	stop_rev_list $curview
    }
    resetvarcs $curview
    set selectedline {}
    catch {unset currentid}
    catch {unset thickerline}
    catch {unset treediffs}
    readrefs
    changedrefs
    if {$showneartags} {
	getallcommits
    }
    clear_display
    catch {unset commitinterest}
    catch {unset cached_commitrow}
    catch {unset targetid}
    setcanvscroll
    getcommits $selid
    return 0
}

# This makes a string representation of a positive integer which
# sorts as a string in numerical order
proc strrep {n} {
    if {$n < 16} {
	return [format "%x" $n]
    } elseif {$n < 256} {
	return [format "x%.2x" $n]
    } elseif {$n < 65536} {
	return [format "y%.4x" $n]
    }
    return [format "z%.8x" $n]
}

# Procedures used in reordering commits from git log (without
# --topo-order) into the order for display.

proc varcinit {view} {
    global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
    global vtokmod varcmod vrowmod varcix vlastins

    set varcstart($view) {{}}
    set vupptr($view) {0}
    set vdownptr($view) {0}
    set vleftptr($view) {0}
    set vbackptr($view) {0}
    set varctok($view) {{}}
    set varcrow($view) {{}}
    set vtokmod($view) {}
    set varcmod($view) 0
    set vrowmod($view) 0
    set varcix($view) {{}}
    set vlastins($view) {0}
}

proc resetvarcs {view} {
    global varcid varccommits parents children vseedcount ordertok
    global vshortids

    foreach vid [array names varcid $view,*] {
	unset varcid($vid)
	unset children($vid)
	unset parents($vid)
    }
    foreach vid [array names vshortids $view,*] {
	unset vshortids($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)
    }
    catch {unset ordertok}
}

# returns a list of the commits with no children
proc seeds {v} {
    global vdownptr vleftptr varcstart

    set ret {}
    set a [lindex $vdownptr($v) 0]
    while {$a != 0} {
	lappend ret [lindex $varcstart($v) $a]
	set a [lindex $vleftptr($v) $a]
    }
    return $ret
}

proc newvarc {view id} {
    global varcid varctok parents children vdatemode
    global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
    global commitdata commitinfo vseedcount varccommits vlastins

    set a [llength $varctok($view)]
    set vid $view,$id
    if {[llength $children($vid)] == 0 || $vdatemode($view)} {
	if {![info exists commitinfo($id)]} {
	    parsecommit $id $commitdata($id) 1
	}
	set cdate [lindex [lindex $commitinfo($id) 4] 0]
	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]"
    } else {
	set tok {}
    }
    set ka 0
    if {[llength $children($vid)] > 0} {
	set kid [lindex $children($vid) end]
	set k $varcid($view,$kid)
	if {[string compare [lindex $varctok($view) $k] $tok] > 0} {
	    set ki $kid
	    set ka $k
	    set tok [lindex $varctok($view) $k]
	}
    }
    if {$ka != 0} {
	set i [lsearch -exact $parents($view,$ki) $id]
	set j [expr {[llength $parents($view,$ki)] - 1 - $i}]
	append tok [strrep $j]
    }
    set c [lindex $vlastins($view) $ka]
    if {$c == 0 || [string compare $tok [lindex $varctok($view) $c]] < 0} {
	set c $ka
	set b [lindex $vdownptr($view) $ka]
    } else {
	set b [lindex $vleftptr($view) $c]
    }
    while {$b != 0 && [string compare $tok [lindex $varctok($view) $b]] >= 0} {
	set c $b
	set b [lindex $vleftptr($view) $c]
    }
    if {$c == $ka} {
	lset vdownptr($view) $ka $a
	lappend vbackptr($view) 0
    } else {
	lset vleftptr($view) $c $a
	lappend vbackptr($view) $c
    }
    lset vlastins($view) $ka $a
    lappend vupptr($view) $ka
    lappend vleftptr($view) $b
    if {$b != 0} {
	lset vbackptr($view) $b $a
    }
    lappend varctok($view) $tok
    lappend varcstart($view) $id
    lappend vdownptr($view) 0
    lappend varcrow($view) {}
    lappend varcix($view) {}
    set varccommits($view,$a) {}
    lappend vlastins($view) 0
    return $a
}

proc splitvarc {p v} {
    global varcid varcstart varccommits varctok vtokmod
    global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins

    set oa $varcid($v,$p)
    set otok [lindex $varctok($v) $oa]
    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 "$otok%[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]
    lappend vlastins($v) [lindex $vlastins($v) $oa]
    lset vdownptr($v) $oa $na
    lset vlastins($v) $oa 0
    lappend vupptr($v) $oa
    lappend vleftptr($v) 0
    lappend vbackptr($v) 0
    for {set b [lindex $vdownptr($v) $na]} {$b != 0} {set b [lindex $vleftptr($v) $b]} {
	lset vupptr($v) $b $na
    }
    if {[string compare $otok $vtokmod($v)] <= 0} {
	modify_arc $v $oa
    }
}

proc renumbervarc {a v} {
    global parents children varctok varcstart varccommits
    global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod vdatemode

    set t1 [clock clicks -milliseconds]
    set todo {}
    set isrelated($a) 1
    set kidchanged($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 {
	if {![info exists kidchanged($a)]} continue
	set id [lindex $varcstart($v) $a]
	if {[llength $children($v,$id)] > 1} {
	    set children($v,$id) [lsort -command [list vtokcmp $v] \
				      $children($v,$id)]
	}
	set oldtok [lindex $varctok($v) $a]
	if {!$vdatemode($v)} {
	    set tok {}
	} else {
	    set tok $oldtok
	}
	set ka 0
	set kid [last_real_child $v,$id]
	if {$kid ne {}} {
	    set k $varcid($v,$kid)
	    if {[string compare [lindex $varctok($v) $k] $tok] > 0} {
		set ki $kid
		set ka $k
		set tok [lindex $varctok($v) $k]
	    }
	}
	if {$ka != 0} {
	    set i [lsearch -exact $parents($v,$ki) $id]
	    set j [expr {[llength $parents($v,$ki)] - 1 - $i}]
	    append tok [strrep $j]
	}
	if {$tok eq $oldtok} {
	    continue
	}
	set id [lindex $varccommits($v,$a) end]
	foreach p $parents($v,$id) {
	    if {[info exists varcid($v,$p)]} {
		set kidchanged($varcid($v,$p)) 1
	    } else {
		set sortkids($p) 1
	    }
	}
	lset varctok($v) $a $tok
	set b [lindex $vupptr($v) $a]
	if {$b != $ka} {
	    if {[string compare [lindex $varctok($v) $ka] $vtokmod($v)] < 0} {
		modify_arc $v $ka
	    }
	    if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
		modify_arc $v $b
	    }
	    set c [lindex $vbackptr($v) $a]
	    set d [lindex $vleftptr($v) $a]
	    if {$c == 0} {
		lset vdownptr($v) $b $d
	    } else {
		lset vleftptr($v) $c $d
	    }
	    if {$d != 0} {
		lset vbackptr($v) $d $c
	    }
	    if {[lindex $vlastins($v) $b] == $a} {
		lset vlastins($v) $b $c
	    }
	    lset vupptr($v) $a $ka
	    set c [lindex $vlastins($v) $ka]
	    if {$c == 0 || \
		    [string compare $tok [lindex $varctok($v) $c]] < 0} {
		set c $ka
		set b [lindex $vdownptr($v) $ka]
	    } else {
		set b [lindex $vleftptr($v) $c]
	    }
	    while {$b != 0 && \
		      [string compare $tok [lindex $varctok($v) $b]] >= 0} {
		set c $b
		set b [lindex $vleftptr($v) $c]
	    }
	    if {$c == $ka} {
 		lset vdownptr($v) $ka $a
		lset vbackptr($v) $a 0
	    } else {
		lset vleftptr($v) $c $a
		lset vbackptr($v) $a $c
	    }
	    lset vleftptr($v) $a $b
	    if {$b != 0} {
		lset vbackptr($v) $b $a
	    }
	    lset vlastins($v) $ka $a
	}
    }
    foreach id [array names sortkids] {
	if {[llength $children($v,$id)] > 1} {
	    set children($v,$id) [lsort -command [list vtokcmp $v] \
				      $children($v,$id)]
	}
    }
    set t2 [clock clicks -milliseconds]
    #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
}

# Fix up the graph after we have found out that in view $v,
# $p (a commit that we have already seen) is actually the parent
# of the last commit in arc $a.
proc fix_reversal {p a v} {
    global varcid varcstart varctok vupptr

    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
    if {[lindex $vupptr($v) $pa] == 0 ||
	[string compare [lindex $varctok($v) $a] \
	     [lindex $varctok($v) $pa]] > 0} {
	renumbervarc $pa $v
    }
}

proc insertrow {id p v} {
    global cmitlisted children parents varcid varctok vtokmod
    global varccommits ordertok commitidx numcommits curview
    global targetid targetrow vshortids

    readcommit $id
    set vid $v,$id
    set cmitlisted($vid) 1
    set children($vid) {}
    set parents($vid) [list $p]
    set a [newvarc $v $id]
    set varcid($vid) $a
    lappend vshortids($v,[string range $id 0 3]) $id
    if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] < 0} {
	modify_arc $v $a
    }
    lappend varccommits($v,$a) $id
    set vp $v,$p
    if {[llength [lappend children($vp) $id]] > 1} {
	set children($vp) [lsort -command [list vtokcmp $v] $children($vp)]
	catch {unset ordertok}
    }
    fix_reversal $p $a $v
    incr commitidx($v)
    if {$v == $curview} {
	set numcommits $commitidx($v)
	setcanvscroll
	if {[info exists targetid]} {
	    if {![comes_before $targetid $p]} {
		incr targetrow
	    }
	}
    }
}

proc insertfakerow {id p} {
    global varcid varccommits parents children cmitlisted
    global commitidx varctok vtokmod targetid targetrow curview numcommits

    set v $curview
    set a $varcid($v,$p)
    set i [lsearch -exact $varccommits($v,$a) $p]
    if {$i < 0} {
	puts "oops: insertfakerow can't find [shortids $p] on arc $a"
	return
    }
    set children($v,$id) {}
    set parents($v,$id) [list $p]
    set varcid($v,$id) $a
    lappend children($v,$p) $id
    set cmitlisted($v,$id) 1
    set numcommits [incr commitidx($v)]
    # note we deliberately don't update varcstart($v) even if $i == 0
    set varccommits($v,$a) [linsert $varccommits($v,$a) $i $id]