- # make sure all the previous commits's parents are on the screen
- foreach p $currentparents {
- if {$onscreen($p) < 0} {
- lappend reins [list $p 0]
- }
- }
- # bring back anything requested by caller
- if {$needonscreen ne {}} {
- lappend reins $needonscreen
- }
-
- # try the shortcut
- if {$currentparents == $id && $onscreen($id) == 0 && $reins eq {}} {
- set dlevel $olddlevel
- set x [xcoord $dlevel $dlevel $lineno]
- set mainline($id) [list $x $y1]
- set mainlinearrow($id) none
- set lastuse($id) $lineno
- set displist [lreplace $displist $dlevel $dlevel $id]
- set onscreen($id) 1
- set xspc1([expr {$lineno + 1}]) $xspc1($lineno)
- return $dlevel
- }
-
- # update displist
- set displist [lreplace $displist $olddlevel $olddlevel]
- set j $olddlevel
- foreach p $currentparents {
- set lastuse($p) $lineno
- if {$onscreen($p) == 0} {
- set displist [linsert $displist $j $p]
- set onscreen($p) 1
- incr j
- }
- }
- if {$onscreen($id) == 0} {
- lappend displist $id
- set onscreen($id) 1
- }
-
- # remove the null entry if present
- set nullentry [lsearch -exact $displist {}]
- if {$nullentry >= 0} {
- set displist [lreplace $displist $nullentry $nullentry]
- }
-
- # bring back the ones we need now (if we did it earlier
- # it would change displist and invalidate olddlevel)
- foreach pi $reins {
- # test again in case of duplicates in reins
- set p [lindex $pi 0]
- if {$onscreen($p) < 0} {
- set onscreen($p) 1
- set lastuse($p) $lineno
- set displist [linsert $displist [lindex $pi 1] $p]
- incr nhyperspace -1
- }
- }
-
- set lastuse($id) $lineno
-
- # see if we need to make any lines jump off into hyperspace
- set displ [llength $displist]
- if {$displ > $maxwidth} {
- set ages {}
- foreach x $displist {
- lappend ages [list $lastuse($x) $x]
- }
- set ages [lsort -integer -index 0 $ages]
- set k 0
- while {$displ > $maxwidth} {
- set use [lindex $ages $k 0]
- set victim [lindex $ages $k 1]
- if {$use >= $lineno - 5} break
- incr k
- if {[lsearch -exact $nohs $victim] >= 0} continue
- set i [lsearch -exact $displist $victim]
- set displist [lreplace $displist $i $i]
- set onscreen($victim) -1
- incr nhyperspace
- incr displ -1
- if {$i < $nullentry} {
- incr nullentry -1
- }
- set x [lindex $mainline($victim) end-1]
- lappend mainline($victim) $x $y1
- set line [trimdiagend $mainline($victim)]
- set arrow "last"
- if {$mainlinearrow($victim) ne "none"} {
- set line [trimdiagstart $line]
- set arrow "both"
- }
- lappend sidelines($victim) [list $line 1 $arrow]
- unset mainline($victim)
- }
- }
-
- set dlevel [lsearch -exact $displist $id]
-
- # If we are reducing, put in a null entry
- if {$displ < $oldnlines} {
- # does the next line look like a merge?
- # i.e. does it have > 1 new parent?
- if {$nnewparents($id) > 1} {
- set i [expr {$dlevel + 1}]
- } elseif {$nnewparents([lindex $olddisplist $olddlevel]) == 0} {
- set i $olddlevel
- if {$nullentry >= 0 && $nullentry < $i} {
- incr i -1
- }
- } elseif {$nullentry >= 0} {
- set i $nullentry
- while {$i < $displ
- && [lindex $olddisplist $i] == [lindex $displist $i]} {
+}
+
+proc bolden_name {row font} {
+ global canv2 linentag selectedline boldnamerows
+
+ lappend boldnamerows $row
+ $canv2 itemconf $linentag($row) -font $font
+ if {[info exists selectedline] && $row == $selectedline} {
+ $canv2 delete secsel
+ set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
+ -outline {{}} -tags secsel \
+ -fill [$canv2 cget -selectbackground]]
+ $canv2 lower $t
+ }
+}
+
+proc unbolden {} {
+ global mainfont boldrows
+
+ set stillbold {}
+ foreach row $boldrows {
+ if {![ishighlighted $row]} {
+ bolden $row $mainfont
+ } else {
+ lappend stillbold $row
+ }
+ }
+ set boldrows $stillbold
+}
+
+proc addvhighlight {n} {
+ global hlview curview viewdata vhl_done vhighlights commitidx
+
+ if {[info exists hlview]} {
+ delvhighlight
+ }
+ set hlview $n
+ if {$n != $curview && ![info exists viewdata($n)]} {
+ set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
+ set vparentlist($n) {}
+ set vchildlist($n) {}
+ set vdisporder($n) {}
+ set vcmitlisted($n) {}
+ start_rev_list $n
+ }
+ set vhl_done $commitidx($hlview)
+ if {$vhl_done > 0} {
+ drawvisible
+ }
+}
+
+proc delvhighlight {} {
+ global hlview vhighlights
+
+ if {![info exists hlview]} return
+ unset hlview
+ catch {unset vhighlights}
+ unbolden
+}
+
+proc vhighlightmore {} {
+ global hlview vhl_done commitidx vhighlights
+ global displayorder vdisporder curview mainfont
+
+ set font [concat $mainfont bold]
+ set max $commitidx($hlview)
+ if {$hlview == $curview} {
+ set disp $displayorder
+ } else {
+ set disp $vdisporder($hlview)
+ }
+ set vr [visiblerows]
+ set r0 [lindex $vr 0]
+ set r1 [lindex $vr 1]
+ for {set i $vhl_done} {$i < $max} {incr i} {
+ set id [lindex $disp $i]
+ if {[info exists commitrow($curview,$id)]} {
+ set row $commitrow($curview,$id)
+ if {$r0 <= $row && $row <= $r1} {
+ if {![highlighted $row]} {
+ bolden $row $font
+ }
+ set vhighlights($row) 1
+ }
+ }
+ }
+ set vhl_done $max
+}
+
+proc askvhighlight {row id} {
+ global hlview vhighlights commitrow iddrawn mainfont
+
+ if {[info exists commitrow($hlview,$id)]} {
+ if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
+ bolden $row [concat $mainfont bold]
+ }
+ set vhighlights($row) 1
+ } else {
+ set vhighlights($row) 0
+ }
+}
+
+proc hfiles_change {name ix op} {
+ global highlight_files filehighlight fhighlights fh_serial
+ global mainfont highlight_paths
+
+ if {[info exists filehighlight]} {
+ # delete previous highlights
+ catch {close $filehighlight}
+ unset filehighlight
+ catch {unset fhighlights}
+ unbolden
+ unhighlight_filelist
+ }
+ set highlight_paths {}
+ after cancel do_file_hl $fh_serial
+ incr fh_serial
+ if {$highlight_files ne {}} {
+ after 300 do_file_hl $fh_serial
+ }
+}
+
+proc makepatterns {l} {
+ set ret {}
+ foreach e $l {
+ set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
+ if {[string index $ee end] eq "/"} {
+ lappend ret "$ee*"
+ } else {
+ lappend ret $ee
+ lappend ret "$ee/*"
+ }
+ }
+ return $ret
+}
+
+proc do_file_hl {serial} {
+ global highlight_files filehighlight highlight_paths gdttype fhl_list
+
+ if {$gdttype eq "touching paths:"} {
+ if {[catch {set paths [shellsplit $highlight_files]}]} return
+ set highlight_paths [makepatterns $paths]
+ highlight_filelist
+ set gdtargs [concat -- $paths]
+ } else {
+ set gdtargs [list "-S$highlight_files"]
+ }
+ set cmd [concat | git-diff-tree -r -s --stdin $gdtargs]
+ set filehighlight [open $cmd r+]
+ fconfigure $filehighlight -blocking 0
+ fileevent $filehighlight readable readfhighlight
+ set fhl_list {}
+ drawvisible
+ flushhighlights
+}
+
+proc flushhighlights {} {
+ global filehighlight fhl_list
+
+ if {[info exists filehighlight]} {
+ lappend fhl_list {}
+ puts $filehighlight ""
+ flush $filehighlight
+ }
+}
+
+proc askfilehighlight {row id} {
+ global filehighlight fhighlights fhl_list
+
+ lappend fhl_list $id
+ set fhighlights($row) -1
+ puts $filehighlight $id
+}
+
+proc readfhighlight {} {
+ global filehighlight fhighlights commitrow curview mainfont iddrawn
+ global fhl_list
+
+ while {[gets $filehighlight line] >= 0} {
+ set line [string trim $line]
+ set i [lsearch -exact $fhl_list $line]
+ if {$i < 0} continue
+ for {set j 0} {$j < $i} {incr j} {
+ set id [lindex $fhl_list $j]
+ if {[info exists commitrow($curview,$id)]} {
+ set fhighlights($commitrow($curview,$id)) 0
+ }
+ }
+ set fhl_list [lrange $fhl_list [expr {$i+1}] end]
+ if {$line eq {}} continue
+ if {![info exists commitrow($curview,$line)]} continue
+ set row $commitrow($curview,$line)
+ if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
+ bolden $row [concat $mainfont bold]
+ }
+ set fhighlights($row) 1
+ }
+ if {[eof $filehighlight]} {
+ # strange...
+ puts "oops, git-diff-tree died"
+ catch {close $filehighlight}
+ unset filehighlight
+ }
+ next_hlcont
+}
+
+proc find_change {name ix op} {
+ global nhighlights mainfont boldnamerows
+ global findstring findpattern findtype
+
+ # delete previous highlights, if any
+ foreach row $boldnamerows {
+ bolden_name $row $mainfont
+ }
+ set boldnamerows {}
+ catch {unset nhighlights}
+ unbolden
+ if {$findtype ne "Regexp"} {
+ set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
+ $findstring]
+ set findpattern "*$e*"
+ }
+ drawvisible
+}
+
+proc askfindhighlight {row id} {
+ global nhighlights commitinfo iddrawn mainfont
+ global findstring findtype findloc findpattern
+
+ if {![info exists commitinfo($id)]} {
+ getcommit $id
+ }
+ set info $commitinfo($id)
+ set isbold 0
+ set fldtypes {Headline Author Date Committer CDate Comments}
+ foreach f $info ty $fldtypes {
+ if {$findloc ne "All fields" && $findloc ne $ty} {
+ continue
+ }
+ if {$findtype eq "Regexp"} {
+ set doesmatch [regexp $findstring $f]
+ } elseif {$findtype eq "IgnCase"} {
+ set doesmatch [string match -nocase $findpattern $f]
+ } else {
+ set doesmatch [string match $findpattern $f]
+ }
+ if {$doesmatch} {
+ if {$ty eq "Author"} {
+ set isbold 2
+ } else {
+ set isbold 1
+ }
+ }
+ }
+ if {[info exists iddrawn($id)]} {
+ if {$isbold && ![ishighlighted $row]} {
+ bolden $row [concat $mainfont bold]
+ }
+ if {$isbold >= 2} {
+ bolden_name $row [concat $mainfont bold]
+ }
+ }
+ set nhighlights($row) $isbold
+}
+
+proc vrel_change {name ix op} {
+ global highlight_related
+
+ rhighlight_none
+ if {$highlight_related ne "None"} {
+ after idle drawvisible
+ }
+}
+
+# prepare for testing whether commits are descendents or ancestors of a
+proc rhighlight_sel {a} {
+ global descendent desc_todo ancestor anc_todo
+ global highlight_related rhighlights
+
+ catch {unset descendent}
+ set desc_todo [list $a]
+ catch {unset ancestor}
+ set anc_todo [list $a]
+ if {$highlight_related ne "None"} {
+ rhighlight_none
+ after idle drawvisible
+ }
+}
+
+proc rhighlight_none {} {
+ global rhighlights
+
+ catch {unset rhighlights}
+ unbolden
+}
+
+proc is_descendent {a} {
+ global curview children commitrow descendent desc_todo
+
+ set v $curview
+ set la $commitrow($v,$a)
+ set todo $desc_todo
+ set leftover {}
+ set done 0
+ for {set i 0} {$i < [llength $todo]} {incr i} {
+ set do [lindex $todo $i]
+ if {$commitrow($v,$do) < $la} {
+ lappend leftover $do
+ continue
+ }
+ foreach nk $children($v,$do) {
+ if {![info exists descendent($nk)]} {
+ set descendent($nk) 1
+ lappend todo $nk
+ if {$nk eq $a} {
+ set done 1
+ }
+ }
+ }
+ if {$done} {
+ set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
+ return
+ }
+ }
+ set descendent($a) 0
+ set desc_todo $leftover
+}
+
+proc is_ancestor {a} {
+ global curview parentlist commitrow ancestor anc_todo
+
+ set v $curview
+ set la $commitrow($v,$a)
+ set todo $anc_todo
+ set leftover {}
+ set done 0
+ for {set i 0} {$i < [llength $todo]} {incr i} {
+ set do [lindex $todo $i]
+ if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
+ lappend leftover $do
+ continue
+ }
+ foreach np [lindex $parentlist $commitrow($v,$do)] {
+ if {![info exists ancestor($np)]} {
+ set ancestor($np) 1
+ lappend todo $np
+ if {$np eq $a} {
+ set done 1
+ }
+ }
+ }
+ if {$done} {
+ set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
+ return
+ }
+ }
+ set ancestor($a) 0
+ set anc_todo $leftover
+}
+
+proc askrelhighlight {row id} {
+ global descendent highlight_related iddrawn mainfont rhighlights
+ global selectedline ancestor
+
+ if {![info exists selectedline]} return
+ set isbold 0
+ if {$highlight_related eq "Descendent" ||
+ $highlight_related eq "Not descendent"} {
+ if {![info exists descendent($id)]} {
+ is_descendent $id
+ }
+ if {$descendent($id) == ($highlight_related eq "Descendent")} {
+ set isbold 1
+ }
+ } elseif {$highlight_related eq "Ancestor" ||
+ $highlight_related eq "Not ancestor"} {
+ if {![info exists ancestor($id)]} {
+ is_ancestor $id
+ }
+ if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
+ set isbold 1
+ }
+ }
+ if {[info exists iddrawn($id)]} {
+ if {$isbold && ![ishighlighted $row]} {
+ bolden $row [concat $mainfont bold]
+ }
+ }
+ set rhighlights($row) $isbold
+}
+
+proc next_hlcont {} {
+ global fhl_row fhl_dirn displayorder numcommits
+ global vhighlights fhighlights nhighlights rhighlights
+ global hlview filehighlight findstring highlight_related
+
+ if {![info exists fhl_dirn] || $fhl_dirn == 0} return
+ set row $fhl_row
+ while {1} {
+ if {$row < 0 || $row >= $numcommits} {
+ bell
+ set fhl_dirn 0
+ return
+ }
+ set id [lindex $displayorder $row]
+ if {[info exists hlview]} {
+ if {![info exists vhighlights($row)]} {
+ askvhighlight $row $id
+ }
+ if {$vhighlights($row) > 0} break
+ }
+ if {$findstring ne {}} {
+ if {![info exists nhighlights($row)]} {
+ askfindhighlight $row $id
+ }
+ if {$nhighlights($row) > 0} break
+ }
+ if {$highlight_related ne "None"} {
+ if {![info exists rhighlights($row)]} {
+ askrelhighlight $row $id
+ }
+ if {$rhighlights($row) > 0} break
+ }
+ if {[info exists filehighlight]} {
+ if {![info exists fhighlights($row)]} {
+ # ask for a few more while we're at it...
+ set r $row
+ for {set n 0} {$n < 100} {incr n} {
+ if {![info exists fhighlights($r)]} {
+ askfilehighlight $r [lindex $displayorder $r]
+ }
+ incr r $fhl_dirn
+ if {$r < 0 || $r >= $numcommits} break
+ }
+ flushhighlights
+ }
+ if {$fhighlights($row) < 0} {
+ set fhl_row $row
+ return
+ }
+ if {$fhighlights($row) > 0} break
+ }
+ incr row $fhl_dirn
+ }
+ set fhl_dirn 0
+ selectline $row 1
+}
+
+proc next_highlight {dirn} {
+ global selectedline fhl_row fhl_dirn
+ global hlview filehighlight findstring highlight_related
+
+ if {![info exists selectedline]} return
+ if {!([info exists hlview] || $findstring ne {} ||
+ $highlight_related ne "None" || [info exists filehighlight])} return
+ set fhl_row [expr {$selectedline + $dirn}]
+ set fhl_dirn $dirn
+ next_hlcont
+}
+
+proc cancel_next_highlight {} {
+ global fhl_dirn
+
+ set fhl_dirn 0
+}
+
+# Graph layout functions
+
+proc shortids {ids} {
+ set res {}
+ foreach id $ids {
+ if {[llength $id] > 1} {
+ lappend res [shortids $id]
+ } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
+ lappend res [string range $id 0 7]
+ } else {
+ lappend res $id
+ }
+ }
+ return $res
+}
+
+proc incrange {l x o} {
+ set n [llength $l]
+ while {$x < $n} {
+ set e [lindex $l $x]
+ if {$e ne {}} {
+ lset l $x [expr {$e + $o}]
+ }
+ incr x
+ }
+ return $l
+}
+
+proc ntimes {n o} {
+ set ret {}
+ for {} {$n > 0} {incr n -1} {
+ lappend ret $o
+ }
+ return $ret
+}
+
+proc usedinrange {id l1 l2} {
+ global children commitrow childlist curview
+
+ if {[info exists commitrow($curview,$id)]} {
+ set r $commitrow($curview,$id)
+ if {$l1 <= $r && $r <= $l2} {
+ return [expr {$r - $l1 + 1}]
+ }
+ set kids [lindex $childlist $r]
+ } else {
+ set kids $children($curview,$id)
+ }
+ foreach c $kids {
+ set r $commitrow($curview,$c)
+ if {$l1 <= $r && $r <= $l2} {
+ return [expr {$r - $l1 + 1}]
+ }
+ }
+ return 0
+}
+
+proc sanity {row {full 0}} {
+ global rowidlist rowoffsets
+
+ set col -1
+ set ids [lindex $rowidlist $row]
+ foreach id $ids {
+ incr col
+ if {$id eq {}} continue
+ if {$col < [llength $ids] - 1 &&
+ [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
+ puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
+ }
+ set o [lindex $rowoffsets $row $col]
+ set y $row
+ set x $col
+ while {$o ne {}} {
+ incr y -1
+ incr x $o
+ if {[lindex $rowidlist $y $x] != $id} {
+ puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
+ puts " id=[shortids $id] check started at row $row"
+ for {set i $row} {$i >= $y} {incr i -1} {
+ puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
+ }
+ break
+ }
+ if {!$full} break
+ set o [lindex $rowoffsets $y $x]
+ }
+ }
+}
+
+proc makeuparrow {oid x y z} {
+ global rowidlist rowoffsets uparrowlen idrowranges
+
+ for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
+ incr y -1
+ incr x $z
+ set off0 [lindex $rowoffsets $y]
+ for {set x0 $x} {1} {incr x0} {
+ if {$x0 >= [llength $off0]} {
+ set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
+ break
+ }
+ set z [lindex $off0 $x0]
+ if {$z ne {}} {
+ incr x0 $z
+ break
+ }
+ }
+ set z [expr {$x0 - $x}]
+ lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
+ lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
+ }
+ set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
+ lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
+ lappend idrowranges($oid) $y
+}
+
+proc initlayout {} {
+ global rowidlist rowoffsets displayorder commitlisted
+ global rowlaidout rowoptim
+ global idinlist rowchk rowrangelist idrowranges
+ global numcommits canvxmax canv
+ global nextcolor
+ global parentlist childlist children
+ global colormap rowtextx
+ global linesegends
+
+ set numcommits 0
+ set displayorder {}
+ set commitlisted {}
+ set parentlist {}
+ set childlist {}
+ set rowrangelist {}
+ set nextcolor 0
+ set rowidlist {{}}
+ set rowoffsets {{}}
+ catch {unset idinlist}
+ catch {unset rowchk}
+ set rowlaidout 0
+ set rowoptim 0
+ set canvxmax [$canv cget -width]
+ catch {unset colormap}
+ catch {unset rowtextx}
+ catch {unset idrowranges}
+ set linesegends {}
+}
+
+proc setcanvscroll {} {
+ global canv canv2 canv3 numcommits linespc canvxmax canvy0
+
+ set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
+ $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
+ $canv2 conf -scrollregion [list 0 0 0 $ymax]
+ $canv3 conf -scrollregion [list 0 0 0 $ymax]
+}
+
+proc visiblerows {} {
+ global canv numcommits linespc
+
+ set ymax [lindex [$canv cget -scrollregion] 3]
+ if {$ymax eq {} || $ymax == 0} return
+ set f [$canv yview]
+ set y0 [expr {int([lindex $f 0] * $ymax)}]
+ set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
+ if {$r0 < 0} {
+ set r0 0
+ }
+ set y1 [expr {int([lindex $f 1] * $ymax)}]
+ set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
+ if {$r1 >= $numcommits} {
+ set r1 [expr {$numcommits - 1}]
+ }
+ return [list $r0 $r1]
+}
+
+proc layoutmore {} {
+ global rowlaidout rowoptim commitidx numcommits optim_delay
+ global uparrowlen curview
+
+ set row $rowlaidout
+ set rowlaidout [layoutrows $row $commitidx($curview) 0]
+ set orow [expr {$rowlaidout - $uparrowlen - 1}]
+ if {$orow > $rowoptim} {
+ optimize_rows $rowoptim 0 $orow
+ set rowoptim $orow
+ }
+ set canshow [expr {$rowoptim - $optim_delay}]
+ if {$canshow > $numcommits} {
+ showstuff $canshow
+ }
+}
+
+proc showstuff {canshow} {
+ global numcommits commitrow pending_select selectedline
+ global linesegends idrowranges idrangedrawn curview
+
+ if {$numcommits == 0} {
+ global phase
+ set phase "incrdraw"
+ allcanvs delete all
+ }
+ set row $numcommits
+ set numcommits $canshow
+ setcanvscroll
+ set rows [visiblerows]
+ set r0 [lindex $rows 0]
+ set r1 [lindex $rows 1]
+ set selrow -1
+ for {set r $row} {$r < $canshow} {incr r} {
+ foreach id [lindex $linesegends [expr {$r+1}]] {
+ set i -1
+ foreach {s e} [rowranges $id] {