proc start_rev_list {view} {
global startmsecs
global commfd leftover tclencoding datemode
- global viewargs viewfiles commitidx
+ global viewargs viewfiles commitidx viewcomplete vnextroot
global lookingforhead showlocalchanges
set startmsecs [clock clicks -milliseconds]
set commitidx($view) 0
+ set viewcomplete($view) 0
+ set vnextroot($view) 0
set order "--topo-order"
if {$datemode} {
set order "--date-order"
show_status "Reading commits..."
}
+# 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]
+}
+
proc getcommitlines {fd view} {
global commitlisted
global leftover commfd
- global displayorder commitidx commitrow commitdata
+ global displayorder commitidx viewcomplete commitrow commitdata
global parentlist children curview hlview
global vparentlist vdisporder vcmitlisted
+ global ordertok vnextroot idpending
set stuff [read $fd 500000]
+ # git log doesn't terminate the last commit with a null...
+ if {$stuff == {} && $leftover($view) ne {} && [eof $fd]} {
+ set stuff "\0"
+ }
if {$stuff == {}} {
if {![eof $fd]} {
return 1
}
+ # Check if we have seen any ids listed as parents that haven't
+ # appeared in the list
+ foreach vid [array names idpending "$view,*"] {
+ # should only get here if git log is buggy
+ set id [lindex [split $vid ","] 1]
+ set commitrow($vid) $commitidx($view)
+ incr commitidx($view)
+ if {$view == $curview} {
+ lappend parentlist {}
+ lappend displayorder $id
+ lappend commitlisted 0
+ } else {
+ lappend vparentlist($view) {}
+ lappend vdisporder($view) $id
+ lappend vcmitlisted($view) 0
+ }
+ }
+ set viewcomplete($view) 1
global viewname
unset commfd($view)
notbusy $view
exit 1
}
set id [lindex $ids 0]
+ if {![info exists ordertok($view,$id)]} {
+ set otok "o[strrep $vnextroot($view)]"
+ incr vnextroot($view)
+ set ordertok($view,$id) $otok
+ } else {
+ set otok $ordertok($view,$id)
+ unset idpending($view,$id)
+ }
if {$listed} {
set olds [lrange $ids 1 end]
- set i 0
- foreach p $olds {
- if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
- lappend children($view,$p) $id
+ if {[llength $olds] == 1} {
+ set p [lindex $olds 0]
+ lappend children($view,$p) $id
+ if {![info exists ordertok($view,$p)]} {
+ set ordertok($view,$p) $ordertok($view,$id)
+ set idpending($view,$p) 1
+ }
+ } else {
+ set i 0
+ foreach p $olds {
+ if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
+ lappend children($view,$p) $id
+ }
+ if {![info exists ordertok($view,$p)]} {
+ set ordertok($view,$p) "$otok[strrep $i]]"
+ set idpending($view,$p) 1
+ }
+ incr i
}
- incr i
}
} else {
set olds {}
}
proc chewcommits {view} {
- global curview hlview commfd
+ global curview hlview viewcomplete
global selectedline pending_select
- set more 0
if {$view == $curview} {
- set allread [expr {![info exists commfd($view)]}]
- set tlimit [expr {[clock clicks -milliseconds] + 50}]
- set more [layoutmore $tlimit $allread]
- if {$allread && !$more} {
+ layoutmore
+ if {$viewcomplete($view)} {
global displayorder commitidx phase
global numcommits startmsecs
if {[info exists hlview] && $view == $hlview} {
vhighlightmore
}
- return $more
+ return 0
}
proc readcommit {id} {
}
proc updatecommits {} {
- global viewdata curview phase displayorder
- global children commitrow selectedline thickerline
+ global viewdata curview phase displayorder ordertok idpending
+ global children commitrow selectedline thickerline showneartags
if {$phase ne {}} {
stop_rev_list
foreach id $displayorder {
catch {unset children($n,$id)}
catch {unset commitrow($n,$id)}
+ catch {unset ordertok($n,$id)}
+ }
+ foreach vid [array names idpending "$n,*"] {
+ unset idpending($vid)
}
set curview -1
catch {unset selectedline}
catch {unset viewdata($n)}
readrefs
changedrefs
- regetallcommits
+ if {$showneartags} {
+ getallcommits
+ }
showview $n
}
lappend idotherrefs($id) $name
}
}
- close $refd
+ catch {close $refd}
set mainhead {}
set mainheadid {}
catch {
global textfont mainfont uifont tabstop
global findtype findtypemenu findloc findstring fstring geometry
global entries sha1entry sha1string sha1but
+ global diffcontextstring diffcontext
global maincursor textcursor curtextcursor
global rowctxmenu fakerowmenu mergemax wrapcomment
global highlight_files gdttype
menu .bar.file
.bar.file add command -label "Update" -command updatecommits
.bar.file add command -label "Reread references" -command rereadrefs
+ .bar.file add command -label "List references" -command showrefs
.bar.file add command -label "Quit" -command doquit
.bar.file configure -font $uifont
menu .bar.edit
-command changediffdisp -variable diffelide -value {0 1}
radiobutton .bleft.mid.new -text "New version" \
-command changediffdisp -variable diffelide -value {1 0}
+ label .bleft.mid.labeldiffcontext -text " Lines of context: " \
+ -font $uifont
pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
+ spinbox .bleft.mid.diffcontext -width 5 -font $textfont \
+ -from 1 -increment 1 -to 10000000 \
+ -validate all -validatecommand "diffcontextvalidate %P" \
+ -textvariable diffcontextstring
+ .bleft.mid.diffcontext set $diffcontext
+ trace add variable diffcontextstring write diffcontextchange
+ lappend entries .bleft.mid.diffcontext
+ pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
set ctext .bleft.ctext
text $ctext -background $bgcolor -foreground $fgcolor \
-tabs "[expr {$tabstop * $charspc}]" \
pack .ctop -fill both -expand 1
bindall <1> {selcanvline %W %x %y}
#bindall <B1-Motion> {selcanvline %W %x %y}
- bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
- bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
+ if {[tk windowingsystem] == "win32"} {
+ bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
+ bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
+ } else {
+ bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
+ bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
+ }
bindall <2> "canvscan mark %W %x %y"
bindall <B2-Motion> "canvscan dragto %W %x %y"
bindkey <Home> selfirstline
bind $cflist <1> {sel_flist %W %x %y; break}
bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
+ bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
set maincursor [. cget -cursor]
set textcursor [$ctext cget -cursor]
-command cobranch
$headctxmenu add command -label "Remove this branch" \
-command rmbranch
+
+ global flist_menu
+ set flist_menu .flistctxmenu
+ menu $flist_menu -tearoff 0
+ $flist_menu add command -label "Highlight this too" \
+ -command {flist_hl 0}
+ $flist_menu add command -label "Highlight this only" \
+ -command {flist_hl 1}
+}
+
+# Windows sends all mouse wheel events to the current focused window, not
+# the one where the mouse hovers, so bind those events here and redirect
+# to the correct window
+proc windows_mousewheel_redirector {W X Y D} {
+ global canv canv2 canv3
+ set w [winfo containing -displayof $W $X $Y]
+ if {$w ne ""} {
+ set u [expr {$D < 0 ? 5 : -5}]
+ if {$w == $canv || $w == $canv2 || $w == $canv3} {
+ allcanvs yview scroll $u units
+ } else {
+ catch {
+ $w yview scroll $u units
+ }
+ }
+ }
}
# mouse-2 makes all windows scan vertically, but only the one
# set the focus back to the toplevel for any click outside
# the entry widgets
proc click {w} {
- global entries
- foreach e $entries {
+ global ctext entries
+ foreach e [concat $entries $ctext] {
if {$w == $e} return
}
focus .
global stuffsaved findmergefiles maxgraphpct
global maxwidth showneartags showlocalchanges
global viewname viewfiles viewargs viewperm nextviewnum
- global cmitmode wrapcomment
- global colors bgcolor fgcolor diffcolors selectbgcolor
+ global cmitmode wrapcomment datetimeformat
+ global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
if {$stuffsaved} return
if {![winfo viewable .]} return
puts $f [list set wrapcomment $wrapcomment]
puts $f [list set showneartags $showneartags]
puts $f [list set showlocalchanges $showlocalchanges]
+ puts $f [list set datetimeformat $datetimeformat]
puts $f [list set bgcolor $bgcolor]
puts $f [list set fgcolor $fgcolor]
puts $f [list set colors $colors]
puts $f [list set diffcolors $diffcolors]
+ puts $f [list set diffcontext $diffcontext]
puts $f [list set selectbgcolor $selectbgcolor]
puts $f "set geometry(main) [wm geometry .]"
0x00, 0x00};
}
+image create bitmap reficon-T -background black -foreground yellow -data {
+ #define tagicon_width 13
+ #define tagicon_height 9
+ static unsigned char tagicon_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
+ 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
+} -maskdata {
+ #define tagicon-mask_width 13
+ #define tagicon-mask_height 9
+ static unsigned char tagicon-mask_bits[] = {
+ 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
+ 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
+}
+set rectdata {
+ #define headicon_width 13
+ #define headicon_height 9
+ static unsigned char headicon_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
+ 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
+}
+set rectmask {
+ #define headicon-mask_width 13
+ #define headicon-mask_height 9
+ static unsigned char headicon-mask_bits[] = {
+ 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
+ 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
+}
+image create bitmap reficon-H -background black -foreground green \
+ -data $rectdata -maskdata $rectmask
+image create bitmap reficon-o -background black -foreground "#ddddff" \
+ -data $rectdata -maskdata $rectmask
+
proc init_flist {first} {
global cflist cflist_top selectedline difffilestart
}
}
+proc pop_flist_menu {w X Y x y} {
+ global ctext cflist cmitmode flist_menu flist_menu_file
+ global treediffs diffids
+
+ set l [lindex [split [$w index "@$x,$y"] "."] 0]
+ if {$l <= 1} return
+ if {$cmitmode eq "tree"} {
+ set e [linetoelt $l]
+ if {[string index $e end] eq "/"} return
+ } else {
+ set e [lindex $treediffs($diffids) [expr {$l-2}]]
+ }
+ set flist_menu_file $e
+ tk_popup $flist_menu $X $Y
+}
+
+proc flist_hl {only} {
+ global flist_menu_file highlight_files
+
+ set x [shellquote $flist_menu_file]
+ if {$only || $highlight_files eq {}} {
+ set highlight_files $x
+ } else {
+ append highlight_files " " $x
+ }
+}
+
# Functions for adding and removing shell-type quoting
proc shellquote {str} {
proc showview {n} {
global curview viewdata viewfiles
- global displayorder parentlist rowidlist rowoffsets
+ global displayorder parentlist rowidlist rowisopt rowfinal
global colormap rowtextx commitrow nextcolor canvxmax
- global numcommits rowrangelist commitlisted idrowranges rowchk
+ global numcommits commitlisted
global selectedline currentid canv canvy0
global treediffs
global pending_select phase
- global commitidx rowlaidout rowoptim
+ global commitidx
global commfd
global selectedview selectfirst
global vparentlist vdisporder vcmitlisted
- global hlview selectedhlview
+ global hlview selectedhlview commitinterest
if {$n == $curview} return
set selid {}
set vparentlist($curview) $parentlist
set vdisporder($curview) $displayorder
set vcmitlisted($curview) $commitlisted
- if {$phase ne {}} {
- set viewdata($curview) \
- [list $phase $rowidlist $rowoffsets $rowrangelist \
- [flatten idrowranges] [flatten idinlist] \
- $rowlaidout $rowoptim $numcommits]
- } elseif {![info exists viewdata($curview)]
- || [lindex $viewdata($curview) 0] ne {}} {
+ if {$phase ne {} ||
+ ![info exists viewdata($curview)] ||
+ [lindex $viewdata($curview) 0] ne {}} {
set viewdata($curview) \
- [list {} $rowidlist $rowoffsets $rowrangelist]
+ [list $phase $rowidlist $rowisopt $rowfinal]
}
}
catch {unset treediffs}
unset hlview
set selectedhlview None
}
+ catch {unset commitinterest}
set curview $n
set selectedview $n
.bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
.bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
+ run refill_reflist
if {![info exists viewdata($n)]} {
if {$selid ne {}} {
set pending_select $selid
set parentlist $vparentlist($n)
set commitlisted $vcmitlisted($n)
set rowidlist [lindex $v 1]
- set rowoffsets [lindex $v 2]
- set rowrangelist [lindex $v 3]
- if {$phase eq {}} {
- set numcommits [llength $displayorder]
- catch {unset idrowranges}
- } else {
- unflatten idrowranges [lindex $v 4]
- unflatten idinlist [lindex $v 5]
- set rowlaidout [lindex $v 6]
- set rowoptim [lindex $v 7]
- set numcommits [lindex $v 8]
- catch {unset rowchk}
- }
+ set rowisopt [lindex $v 2]
+ set rowfinal [lindex $v 3]
+ set numcommits $commitidx($n)
catch {unset colormap}
catch {unset rowtextx}
}
set hlview $n
if {$n != $curview && ![info exists viewdata($n)]} {
- set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
+ set viewdata($n) [list getcommits {{}} 0 0 0]
set vparentlist($n) {}
set vdisporder($n) {}
set vcmitlisted($n) {}
proc find_change {name ix op} {
global nhighlights mainfont boldnamerows
- global findstring findpattern findtype markingmatches
+ global findstring findpattern findtype
# delete previous highlights, if any
foreach row $boldnamerows {
$findstring]
set findpattern "*$e*"
}
- set markingmatches [expr {$findstring ne {}}]
drawvisible
}
}
}
if {$markingmatches} {
- markrowmatches $row [lindex $info 0] [lindex $info 1]
+ markrowmatches $row $id
}
}
set nhighlights($row) $isbold
}
-proc markrowmatches {row headline author} {
- global canv canv2 linehtag linentag
+proc markrowmatches {row id} {
+ global canv canv2 linehtag linentag commitinfo findloc
+ set headline [lindex $commitinfo($id) 0]
+ set author [lindex $commitinfo($id) 1]
$canv delete match$row
$canv2 delete match$row
- set m [findmatches $headline]
- if {$m ne {}} {
- markmatches $canv $row $headline $linehtag($row) $m \
- [$canv itemcget $linehtag($row) -font]
+ if {$findloc eq "All fields" || $findloc eq "Headline"} {
+ set m [findmatches $headline]
+ if {$m ne {}} {
+ markmatches $canv $row $headline $linehtag($row) $m \
+ [$canv itemcget $linehtag($row) -font] $row
+ }
}
- set m [findmatches $author]
- if {$m ne {}} {
- markmatches $canv2 $row $author $linentag($row) $m \
- [$canv2 itemcget $linentag($row) -font]
+ if {$findloc eq "All fields" || $findloc eq "Author"} {
+ set m [findmatches $author]
+ if {$m ne {}} {
+ markmatches $canv2 $row $author $linentag($row) $m \
+ [$canv2 itemcget $linentag($row) -font] $row
+ }
}
}
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 curview
-
- if {[info exists commitrow($curview,$id)]} {
- set r $commitrow($curview,$id)
- if {$l1 <= $r && $r <= $l2} {
- return [expr {$r - $l1 + 1}]
+ set o [list $o]
+ for {set mask 1} {$mask <= $n} {incr mask $mask} {
+ if {($n & $mask) != 0} {
+ set ret [concat $ret $o]
}
+ set o [concat $o $o]
}
- 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
+ return $ret
}
-proc sanity {row {full 0}} {
- global rowidlist rowoffsets
+# Work out where id should go in idlist so that order-token
+# values increase from left to right
+proc idcol {idlist id {i 0}} {
+ global ordertok curview
- 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]
+ set t $ordertok($curview,$id)
+ if {$i >= [llength $idlist] ||
+ $t < $ordertok($curview,[lindex $idlist $i])} {
+ if {$i > [llength $idlist]} {
+ set i [llength $idlist]
}
- }
-}
-
-proc makeuparrow {oid x y z} {
- global rowidlist rowoffsets uparrowlen idrowranges displayorder
-
- 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
- }
+ while {[incr i -1] >= 0 &&
+ $t < $ordertok($curview,[lindex $idlist $i])} {}
+ incr i
+ } else {
+ if {$t > $ordertok($curview,[lindex $idlist $i])} {
+ while {[incr i] < [llength $idlist] &&
+ $t >= $ordertok($curview,[lindex $idlist $i])} {}
}
- 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) [lindex $displayorder $y]
+ return $i
}
proc initlayout {} {
- global rowidlist rowoffsets displayorder commitlisted
- global rowlaidout rowoptim
- global idinlist rowchk rowrangelist idrowranges
+ global rowidlist rowisopt rowfinal displayorder commitlisted
global numcommits canvxmax canv
global nextcolor
global parentlist
set displayorder {}
set commitlisted {}
set parentlist {}
- set rowrangelist {}
set nextcolor 0
- set rowidlist {{}}
- set rowoffsets {{}}
- catch {unset idinlist}
- catch {unset rowchk}
- set rowlaidout 0
- set rowoptim 0
+ set rowidlist {}
+ set rowisopt {}
+ set rowfinal {}
set canvxmax [$canv cget -width]
catch {unset colormap}
catch {unset rowtextx}
- catch {unset idrowranges}
set selectfirst 1
}
return [list $r0 $r1]
}
-proc layoutmore {tmax allread} {
- global rowlaidout rowoptim commitidx numcommits optim_delay
- global uparrowlen curview rowidlist idinlist
+proc layoutmore {} {
+ global commitidx viewcomplete numcommits
+ global uparrowlen downarrowlen mingaplen curview
- set showlast 0
- set showdelay $optim_delay
- set optdelay [expr {$uparrowlen + 1}]
- while {1} {
- if {$rowoptim - $showdelay > $numcommits} {
- showstuff [expr {$rowoptim - $showdelay}] $showlast
- } elseif {$rowlaidout - $optdelay > $rowoptim} {
- set nr [expr {$rowlaidout - $optdelay - $rowoptim}]
- if {$nr > 100} {
- set nr 100
- }
- optimize_rows $rowoptim 0 [expr {$rowoptim + $nr}]
- incr rowoptim $nr
- } elseif {$commitidx($curview) > $rowlaidout} {
- set nr [expr {$commitidx($curview) - $rowlaidout}]
- # may need to increase this threshold if uparrowlen or
- # mingaplen are increased...
- if {$nr > 150} {
- set nr 150
- }
- set row $rowlaidout
- set rowlaidout [layoutrows $row [expr {$row + $nr}] $allread]
- if {$rowlaidout == $row} {
- return 0
- }
- } elseif {$allread} {
- set optdelay 0
- set nrows $commitidx($curview)
- if {[lindex $rowidlist $nrows] ne {} ||
- [array names idinlist] ne {}} {
- layouttail
- set rowlaidout $commitidx($curview)
- } elseif {$rowoptim == $nrows} {
- set showdelay 0
- set showlast 1
- if {$numcommits == $nrows} {
- return 0
- }
- }
- } else {
- return 0
- }
- if {$tmax ne {} && [clock clicks -milliseconds] >= $tmax} {
- return 1
- }
+ set show $commitidx($curview)
+ if {$show > $numcommits} {
+ showstuff $show $viewcomplete($curview)
}
}
proc showstuff {canshow last} {
global numcommits commitrow pending_select selectedline curview
global lookingforhead mainheadid displayorder selectfirst
- global lastscrollset
+ global lastscrollset commitinterest
if {$numcommits == 0} {
global phase
set phase "incrdraw"
allcanvs delete all
}
+ for {set l $numcommits} {$l < $canshow} {incr l} {
+ set id [lindex $displayorder $l]
+ if {[info exists commitinterest($id)]} {
+ foreach script $commitinterest($id) {
+ eval [string map [list "%I" $id] $script]
+ }
+ unset commitinterest($id)
+ }
+ }
set r0 $numcommits
set prev $numcommits
set numcommits $canshow
return 0
}
-proc layoutrows {row endrow last} {
- global rowidlist rowoffsets displayorder
- global uparrowlen downarrowlen maxwidth mingaplen
- global children parentlist
- global idrowranges
- global commitidx curview
- global idinlist rowchk rowrangelist
+proc nextuse {id row} {
+ global commitrow curview children
- set idlist [lindex $rowidlist $row]
- set offs [lindex $rowoffsets $row]
- while {$row < $endrow} {
- set id [lindex $displayorder $row]
- set oldolds {}
- set newolds {}
- foreach p [lindex $parentlist $row] {
- if {![info exists idinlist($p)]} {
- lappend newolds $p
- } elseif {!$idinlist($p)} {
- lappend oldolds $p
- }
- }
- set nev [expr {[llength $idlist] + [llength $newolds]
- + [llength $oldolds] - $maxwidth + 1}]
- if {$nev > 0} {
- if {!$last &&
- $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
- for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
- set i [lindex $idlist $x]
- if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
- set r [usedinrange $i [expr {$row - $downarrowlen}] \
- [expr {$row + $uparrowlen + $mingaplen}]]
- if {$r == 0} {
- set idlist [lreplace $idlist $x $x]
- set offs [lreplace $offs $x $x]
- set offs [incrange $offs $x 1]
- set idinlist($i) 0
- set rm1 [expr {$row - 1}]
- lappend idrowranges($i) [lindex $displayorder $rm1]
- if {[incr nev -1] <= 0} break
- continue
- }
- set rowchk($id) [expr {$row + $r}]
- }
+ if {[info exists children($curview,$id)]} {
+ foreach kid $children($curview,$id) {
+ if {![info exists commitrow($curview,$kid)]} {
+ return -1
+ }
+ if {$commitrow($curview,$kid) > $row} {
+ return $commitrow($curview,$kid)
}
- lset rowidlist $row $idlist
- lset rowoffsets $row $offs
}
- set col [lsearch -exact $idlist $id]
- if {$col < 0} {
- set col [llength $idlist]
- lappend idlist $id
- lset rowidlist $row $idlist
- set z {}
- if {$children($curview,$id) ne {}} {
- set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
- unset idinlist($id)
- }
- lappend offs $z
- lset rowoffsets $row $offs
- if {$z ne {}} {
- makeuparrow $id $col $row $z
+ }
+ if {[info exists commitrow($curview,$id)]} {
+ return $commitrow($curview,$id)
+ }
+ return -1
+}
+
+proc prevuse {id row} {
+ global commitrow curview children
+
+ set ret -1
+ if {[info exists children($curview,$id)]} {
+ foreach kid $children($curview,$id) {
+ if {![info exists commitrow($curview,$kid)]} break
+ if {$commitrow($curview,$kid) < $row} {
+ set ret $commitrow($curview,$kid)
}
- } else {
- unset idinlist($id)
- }
- set ranges {}
- if {[info exists idrowranges($id)]} {
- set ranges $idrowranges($id)
- lappend ranges $id
- unset idrowranges($id)
- }
- lappend rowrangelist $ranges
- incr row
- set offs [ntimes [llength $idlist] 0]
- set l [llength $newolds]
- set idlist [eval lreplace \$idlist $col $col $newolds]
- set o 0
- if {$l != 1} {
- set offs [lrange $offs 0 [expr {$col - 1}]]
- foreach x $newolds {
- lappend offs {}
- incr o -1
- }
- incr o
- set tmp [expr {[llength $idlist] - [llength $offs]}]
- if {$tmp > 0} {
- set offs [concat $offs [ntimes $tmp $o]]
+ }
+ }
+ return $ret
+}
+
+proc make_idlist {row} {
+ global displayorder parentlist uparrowlen downarrowlen mingaplen
+ global commitidx curview ordertok children commitrow
+
+ set r [expr {$row - $mingaplen - $downarrowlen - 1}]
+ if {$r < 0} {
+ set r 0
+ }
+ set ra [expr {$row - $downarrowlen}]
+ if {$ra < 0} {
+ set ra 0
+ }
+ set rb [expr {$row + $uparrowlen}]
+ if {$rb > $commitidx($curview)} {
+ set rb $commitidx($curview)
+ }
+ set ids {}
+ for {} {$r < $ra} {incr r} {
+ set nextid [lindex $displayorder [expr {$r + 1}]]
+ foreach p [lindex $parentlist $r] {
+ if {$p eq $nextid} continue
+ set rn [nextuse $p $r]
+ if {$rn >= $row &&
+ $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
+ lappend ids [list $ordertok($curview,$p) $p]
}
- } else {
- lset offs $col {}
}
- foreach i $newolds {
- set idinlist($i) 1
- set idrowranges($i) $id
+ }
+ for {} {$r < $row} {incr r} {
+ set nextid [lindex $displayorder [expr {$r + 1}]]
+ foreach p [lindex $parentlist $r] {
+ if {$p eq $nextid} continue
+ set rn [nextuse $p $r]
+ if {$rn < 0 || $rn >= $row} {
+ lappend ids [list $ordertok($curview,$p) $p]
+ }
}
- incr col $l
- foreach oid $oldolds {
- set idinlist($oid) 1
- set idlist [linsert $idlist $col $oid]
- set offs [linsert $offs $col $o]
- makeuparrow $oid $col $row $o
- incr col
+ }
+ set id [lindex $displayorder $row]
+ lappend ids [list $ordertok($curview,$id) $id]
+ while {$r < $rb} {
+ foreach p [lindex $parentlist $r] {
+ set firstkid [lindex $children($curview,$p) 0]
+ if {$commitrow($curview,$firstkid) < $row} {
+ lappend ids [list $ordertok($curview,$p) $p]
+ }
+ }
+ incr r
+ set id [lindex $displayorder $r]
+ if {$id ne {}} {
+ set firstkid [lindex $children($curview,$id) 0]
+ if {$firstkid ne {} && $commitrow($curview,$firstkid) < $row} {
+ lappend ids [list $ordertok($curview,$id) $id]
+ }
}
- lappend rowidlist $idlist
- lappend rowoffsets $offs
}
- return $row
+ set idlist {}
+ foreach idx [lsort -unique $ids] {
+ lappend idlist [lindex $idx 1]
+ }
+ return $idlist
}
-proc addextraid {id row} {
- global displayorder commitrow commitinfo
- global commitidx commitlisted
- global parentlist children curview
+proc rowsequal {a b} {
+ while {[set i [lsearch -exact $a {}]] >= 0} {
+ set a [lreplace $a $i $i]
+ }
+ while {[set i [lsearch -exact $b {}]] >= 0} {
+ set b [lreplace $b $i $i]
+ }
+ return [expr {$a eq $b}]
+}
- incr commitidx($curview)
- lappend displayorder $id
- lappend commitlisted 0
- lappend parentlist {}
- set commitrow($curview,$id) $row
- readcommit $id
- if {![info exists commitinfo($id)]} {
- set commitinfo($id) {"No commit information available"}
+proc makeupline {id row rend col} {
+ global rowidlist uparrowlen downarrowlen mingaplen
+
+ for {set r $rend} {1} {set r $rstart} {
+ set rstart [prevuse $id $r]
+ if {$rstart < 0} return
+ if {$rstart < $row} break
+ }
+ if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
+ set rstart [expr {$rend - $uparrowlen - 1}]
}
- if {![info exists children($curview,$id)]} {
- set children($curview,$id) {}
+ for {set r $rstart} {[incr r] <= $row} {} {
+ set idlist [lindex $rowidlist $r]
+ if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
+ set col [idcol $idlist $id $col]
+ lset rowidlist $r [linsert $idlist $col $id]
+ changedrow $r
+ }
}
}
-proc layouttail {} {
- global rowidlist rowoffsets idinlist commitidx curview
- global idrowranges rowrangelist
+proc layoutrows {row endrow} {
+ global rowidlist rowisopt rowfinal displayorder
+ global uparrowlen downarrowlen maxwidth mingaplen
+ global children parentlist
+ global commitidx viewcomplete curview commitrow
- set row $commitidx($curview)
- set idlist [lindex $rowidlist $row]
- while {$idlist ne {}} {
- set col [expr {[llength $idlist] - 1}]
- set id [lindex $idlist $col]
- addextraid $id $row
- unset idinlist($id)
- lappend idrowranges($id) $id
- lappend rowrangelist $idrowranges($id)
- unset idrowranges($id)
- incr row
- set offs [ntimes $col 0]
- set idlist [lreplace $idlist $col $col]
- lappend rowidlist $idlist
- lappend rowoffsets $offs
- }
-
- foreach id [array names idinlist] {
- unset idinlist($id)
- addextraid $id $row
- lset rowidlist $row [list $id]
- lset rowoffsets $row 0
- makeuparrow $id 0 $row 0
- lappend idrowranges($id) $id
- lappend rowrangelist $idrowranges($id)
- unset idrowranges($id)
- incr row
- lappend rowidlist {}
- lappend rowoffsets {}
+ set idlist {}
+ if {$row > 0} {
+ set rm1 [expr {$row - 1}]
+ foreach id [lindex $rowidlist $rm1] {
+ if {$id ne {}} {
+ lappend idlist $id
+ }
+ }
+ set final [lindex $rowfinal $rm1]
+ }
+ for {} {$row < $endrow} {incr row} {
+ set rm1 [expr {$row - 1}]
+ if {$rm1 < 0 || $idlist eq {}} {
+ set idlist [make_idlist $row]
+ set final 1
+ } else {
+ set id [lindex $displayorder $rm1]
+ set col [lsearch -exact $idlist $id]
+ set idlist [lreplace $idlist $col $col]
+ foreach p [lindex $parentlist $rm1] {
+ if {[lsearch -exact $idlist $p] < 0} {
+ set col [idcol $idlist $p $col]
+ set idlist [linsert $idlist $col $p]
+ # if not the first child, we have to insert a line going up
+ if {$id ne [lindex $children($curview,$p) 0]} {
+ makeupline $p $rm1 $row $col
+ }
+ }
+ }
+ set id [lindex $displayorder $row]
+ if {$row > $downarrowlen} {
+ set termrow [expr {$row - $downarrowlen - 1}]
+ foreach p [lindex $parentlist $termrow] {
+ set i [lsearch -exact $idlist $p]
+ if {$i < 0} continue
+ set nr [nextuse $p $termrow]
+ if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
+ set idlist [lreplace $idlist $i $i]
+ }
+ }
+ }
+ set col [lsearch -exact $idlist $id]
+ if {$col < 0} {
+ set col [idcol $idlist $id]
+ set idlist [linsert $idlist $col $id]
+ if {$children($curview,$id) ne {}} {
+ makeupline $id $rm1 $row $col
+ }
+ }
+ set r [expr {$row + $uparrowlen - 1}]
+ if {$r < $commitidx($curview)} {
+ set x $col
+ foreach p [lindex $parentlist $r] {
+ if {[lsearch -exact $idlist $p] >= 0} continue
+ set fk [lindex $children($curview,$p) 0]
+ if {$commitrow($curview,$fk) < $row} {
+ set x [idcol $idlist $p $x]
+ set idlist [linsert $idlist $x $p]
+ }
+ }
+ if {[incr r] < $commitidx($curview)} {
+ set p [lindex $displayorder $r]
+ if {[lsearch -exact $idlist $p] < 0} {
+ set fk [lindex $children($curview,$p) 0]
+ if {$fk ne {} && $commitrow($curview,$fk) < $row} {
+ set x [idcol $idlist $p $x]
+ set idlist [linsert $idlist $x $p]
+ }
+ }
+ }
+ }
+ }
+ if {$final && !$viewcomplete($curview) &&
+ $row + $uparrowlen + $mingaplen + $downarrowlen
+ >= $commitidx($curview)} {
+ set final 0
+ }
+ set l [llength $rowidlist]
+ if {$row == $l} {
+ lappend rowidlist $idlist
+ lappend rowisopt 0
+ lappend rowfinal $final
+ } elseif {$row < $l} {
+ if {![rowsequal $idlist [lindex $rowidlist $row]]} {
+ lset rowidlist $row $idlist
+ changedrow $row
+ }
+ lset rowfinal $row $final
+ } else {
+ set pad [ntimes [expr {$row - $l}] {}]
+ set rowidlist [concat $rowidlist $pad]
+ lappend rowidlist $idlist
+ set rowfinal [concat $rowfinal $pad]
+ lappend rowfinal $final
+ set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
+ }
+ }
+ return $row
+}
+
+proc changedrow {row} {
+ global displayorder iddrawn rowisopt need_redisplay
+
+ set l [llength $rowisopt]
+ if {$row < $l} {
+ lset rowisopt $row 0
+ if {$row + 1 < $l} {
+ lset rowisopt [expr {$row + 1}] 0
+ if {$row + 2 < $l} {
+ lset rowisopt [expr {$row + 2}] 0
+ }
+ }
+ }
+ set id [lindex $displayorder $row]
+ if {[info exists iddrawn($id)]} {
+ set need_redisplay 1
}
}
proc insert_pad {row col npad} {
- global rowidlist rowoffsets
+ global rowidlist
set pad [ntimes $npad {}]
- lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
- set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
- lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
+ set idlist [lindex $rowidlist $row]
+ set bef [lrange $idlist 0 [expr {$col - 1}]]
+ set aft [lrange $idlist $col end]
+ set i [lsearch -exact $aft {}]
+ if {$i > 0} {
+ set aft [lreplace $aft $i $i]
+ }
+ lset rowidlist $row [concat $bef $pad $aft]
+ changedrow $row
}
proc optimize_rows {row col endrow} {
- global rowidlist rowoffsets displayorder
+ global rowidlist rowisopt displayorder curview children
- for {} {$row < $endrow} {incr row} {
- set idlist [lindex $rowidlist $row]
- set offs [lindex $rowoffsets $row]
+ if {$row < 1} {
+ set row 1
+ }
+ for {} {$row < $endrow} {incr row; set col 0} {
+ if {[lindex $rowisopt $row]} continue
set haspad 0
- for {} {$col < [llength $offs]} {incr col} {
- if {[lindex $idlist $col] eq {}} {
+ set y0 [expr {$row - 1}]
+ set ym [expr {$row - 2}]
+ set idlist [lindex $rowidlist $row]
+ set previdlist [lindex $rowidlist $y0]
+ if {$idlist eq {} || $previdlist eq {}} continue
+ if {$ym >= 0} {
+ set pprevidlist [lindex $rowidlist $ym]
+ if {$pprevidlist eq {}} continue
+ } else {
+ set pprevidlist {}
+ }
+ set x0 -1
+ set xm -1
+ for {} {$col < [llength $idlist]} {incr col} {
+ set id [lindex $idlist $col]
+ if {[lindex $previdlist $col] eq $id} continue
+ if {$id eq {}} {
set haspad 1
continue
}
- set z [lindex $offs $col]
- if {$z eq {}} continue
+ set x0 [lsearch -exact $previdlist $id]
+ if {$x0 < 0} continue
+ set z [expr {$x0 - $col}]
set isarrow 0
- set x0 [expr {$col + $z}]
- set y0 [expr {$row - 1}]
- set z0 [lindex $rowoffsets $y0 $x0]
+ set z0 {}
+ if {$ym >= 0} {
+ set xm [lsearch -exact $pprevidlist $id]
+ if {$xm >= 0} {
+ set z0 [expr {$xm - $x0}]
+ }
+ }
if {$z0 eq {}} {
- set id [lindex $idlist $col]
- set ranges [rowranges $id]
- if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
+ # if row y0 is the first child of $id then it's not an arrow
+ if {[lindex $children($curview,$id) 0] ne
+ [lindex $displayorder $y0]} {
set isarrow 1
}
}
+ if {!$isarrow && $id ne [lindex $displayorder $row] &&
+ [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
+ set isarrow 1
+ }
# Looking at lines from this row to the previous row,
# make them go straight up if they end in an arrow on
# the previous row; otherwise make them go straight up
# Line currently goes left too much;
# insert pads in the previous row, then optimize it
set npad [expr {-1 - $z + $isarrow}]
- set offs [incrange $offs $col $npad]
insert_pad $y0 $x0 $npad
if {$y0 > 0} {
optimize_rows $y0 $x0 $row
}
- set z [lindex $offs $col]
- set x0 [expr {$col + $z}]
- set z0 [lindex $rowoffsets $y0 $x0]
+ set previdlist [lindex $rowidlist $y0]
+ set x0 [lsearch -exact $previdlist $id]
+ set z [expr {$x0 - $col}]
+ if {$z0 ne {}} {
+ set pprevidlist [lindex $rowidlist $ym]
+ set xm [lsearch -exact $pprevidlist $id]
+ set z0 [expr {$xm - $x0}]
+ }
} elseif {$z > 1 || ($z > 0 && $isarrow)} {
# Line currently goes right too much;
- # insert pads in this line and adjust the next's rowoffsets
+ # insert pads in this line
set npad [expr {$z - 1 + $isarrow}]
- set y1 [expr {$row + 1}]
- set offs2 [lindex $rowoffsets $y1]
- set x1 -1
- foreach z $offs2 {
- incr x1
- if {$z eq {} || $x1 + $z < $col} continue
- if {$x1 + $z > $col} {
- incr npad
- }
- lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
- break
- }
- set pad [ntimes $npad {}]
- set idlist [eval linsert \$idlist $col $pad]
- set tmp [eval linsert \$offs $col $pad]
+ insert_pad $row $col $npad
+ set idlist [lindex $rowidlist $row]
incr col $npad
- set offs [incrange $tmp $col [expr {-$npad}]]
- set z [lindex $offs $col]
+ set z [expr {$x0 - $col}]
set haspad 1
}
- if {$z0 eq {} && !$isarrow} {
+ if {$z0 eq {} && !$isarrow && $ym >= 0} {
# this line links to its first child on row $row-2
- set rm2 [expr {$row - 2}]
- set id [lindex $displayorder $rm2]
- set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
+ set id [lindex $displayorder $ym]
+ set xc [lsearch -exact $pprevidlist $id]
if {$xc >= 0} {
set z0 [expr {$xc - $x0}]
}
# avoid lines jigging left then immediately right
if {$z0 ne {} && $z < 0 && $z0 > 0} {
insert_pad $y0 $x0 1
- set offs [incrange $offs $col 1]
- optimize_rows $y0 [expr {$x0 + 1}] $row
+ incr x0
+ optimize_rows $y0 $x0 $row
+ set previdlist [lindex $rowidlist $y0]
}
}
if {!$haspad} {
- set o {}
# Find the first column that doesn't have a line going right
for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
- set o [lindex $offs $col]
- if {$o eq {}} {
+ set id [lindex $idlist $col]
+ if {$id eq {}} break
+ set x0 [lsearch -exact $previdlist $id]
+ if {$x0 < 0} {
# check if this is the link to the first child
- set id [lindex $idlist $col]
- set ranges [rowranges $id]
- if {$ranges ne {} && $row == [lindex $ranges 0]} {
+ set kid [lindex $displayorder $y0]
+ if {[lindex $children($curview,$id) 0] eq $kid} {
# it is, work out offset to child
- set y0 [expr {$row - 1}]
- set id [lindex $displayorder $y0]
- set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
- if {$x0 >= 0} {
- set o [expr {$x0 - $col}]
- }
+ set x0 [lsearch -exact $previdlist $kid]
}
}
- if {$o eq {} || $o <= 0} break
+ if {$x0 <= $col} break
}
# Insert a pad at that column as long as it has a line and
- # isn't the last column, and adjust the next row' offsets
- if {$o ne {} && [incr col] < [llength $idlist]} {
- set y1 [expr {$row + 1}]
- set offs2 [lindex $rowoffsets $y1]
- set x1 -1
- foreach z $offs2 {
- incr x1
- if {$z eq {} || $x1 + $z < $col} continue
- lset rowoffsets $y1 [incrange $offs2 $x1 1]
- break
- }
+ # isn't the last column
+ if {$x0 >= 0 && [incr col] < [llength $idlist]} {
set idlist [linsert $idlist $col {}]
- set tmp [linsert $offs $col {}]
- incr col
- set offs [incrange $tmp $col -1]
+ lset rowidlist $row $idlist
+ changedrow $row
}
}
- lset rowidlist $row $idlist
- lset rowoffsets $row $offs
- set col 0
}
}
}
proc rowranges {id} {
- global phase idrowranges commitrow rowlaidout rowrangelist curview
-
- set ranges {}
- if {$phase eq {} ||
- ([info exists commitrow($curview,$id)]
- && $commitrow($curview,$id) < $rowlaidout)} {
- set ranges [lindex $rowrangelist $commitrow($curview,$id)]
- } elseif {[info exists idrowranges($id)]} {
- set ranges $idrowranges($id)
- }
- set linenos {}
- foreach rid $ranges {
- lappend linenos $commitrow($curview,$rid)
- }
- if {$linenos ne {}} {
- lset linenos 0 [expr {[lindex $linenos 0] + 1}]
- }
- return $linenos
-}
-
-# work around tk8.4 refusal to draw arrows on diagonal segments
-proc adjarrowhigh {coords} {
- global linespc
-
- set x0 [lindex $coords 0]
- set x1 [lindex $coords 2]
- if {$x0 != $x1} {
- set y0 [lindex $coords 1]
- set y1 [lindex $coords 3]
- if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
- # we have a nearby vertical segment, just trim off the diag bit
- set coords [lrange $coords 2 end]
+ global commitrow curview children uparrowlen downarrowlen
+ global rowidlist
+
+ set kids $children($curview,$id)
+ if {$kids eq {}} {
+ return {}
+ }
+ set ret {}
+ lappend kids $id
+ foreach child $kids {
+ if {![info exists commitrow($curview,$child)]} break
+ set row $commitrow($curview,$child)
+ if {![info exists prev]} {
+ lappend ret [expr {$row + 1}]
} else {
- set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
- set xi [expr {$x0 - $slope * $linespc / 2}]
- set yi [expr {$y0 - $linespc / 2}]
- set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
+ if {$row <= $prevrow} {
+ puts "oops children out of order [shortids $id] $row < [shortids $prev] $prevrow"
+ }
+ # see if the line extends the whole way from prevrow to row
+ if {$row > $prevrow + $uparrowlen + $downarrowlen &&
+ [lsearch -exact [lindex $rowidlist \
+ [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
+ # it doesn't, see where it ends
+ set r [expr {$prevrow + $downarrowlen}]
+ if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
+ while {[incr r -1] > $prevrow &&
+ [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
+ } else {
+ while {[incr r] <= $row &&
+ [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
+ incr r -1
+ }
+ lappend ret $r
+ # see where it starts up again
+ set r [expr {$row - $uparrowlen}]
+ if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
+ while {[incr r] < $row &&
+ [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
+ } else {
+ while {[incr r -1] >= $prevrow &&
+ [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
+ incr r
+ }
+ lappend ret $r
+ }
+ }
+ if {$child eq $id} {
+ lappend ret $row
}
+ set prev $id
+ set prevrow $row
}
- return $coords
+ return $ret
}
proc drawlineseg {id row endrow arrowlow} {
global rowidlist displayorder iddrawn linesegs
- global canv colormap linespc curview maxlinelen
+ global canv colormap linespc curview maxlinelen parentlist
set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
set le [expr {$row + 1}]
set itl [lindex $lines [expr {$i-1}] 2]
set al [$canv itemcget $itl -arrow]
set arrowlow [expr {$al eq "last" || $al eq "both"}]
- } elseif {$arrowlow &&
- [lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0} {
- set arrowlow 0
+ } elseif {$arrowlow} {
+ if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
+ [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
+ set arrowlow 0
+ }
}
set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
for {set y $le} {[incr y -1] > $row} {} {
set xc [lsearch -exact [lindex $rowidlist $row] $ch]
if {$xc < 0} {
puts "oops: drawlineseg: child $ch not on row $row"
- } else {
- if {$xc < $x - 1} {
+ } elseif {$xc != $x} {
+ if {($arrowhigh && $le == $row + 1) || $dir == 0} {
+ set d [expr {int(0.5 * $linespc)}]
+ set x1 [xc $row $x]
+ if {$xc < $x} {
+ set x2 [expr {$x1 - $d}]
+ } else {
+ set x2 [expr {$x1 + $d}]
+ }
+ set y2 [yc $row]
+ set y1 [expr {$y2 + $d}]
+ lappend coords $x1 $y1 $x2 $y2
+ } elseif {$xc < $x - 1} {
lappend coords [xc $row [expr {$x-1}]] [yc $row]
} elseif {$xc > $x + 1} {
lappend coords [xc $row [expr {$x+1}]] [yc $row]
} else {
set xn [xc $row $xp]
set yn [yc $row]
- # work around tk8.4 refusal to draw arrows on diagonal segments
- if {$arrowlow && $xn != [lindex $coords end-1]} {
- if {[llength $coords] < 4 ||
- [lindex $coords end-3] != [lindex $coords end-1] ||
- [lindex $coords end] - $yn > 2 * $linespc} {
- set xn [xc $row [expr {$xp - 0.5 * $dir}]]
- set yo [yc [expr {$row + 0.5}]]
- lappend coords $xn $yo $xn $yn
- }
- } else {
- lappend coords $xn $yn
- }
+ lappend coords $xn $yn
}
if {!$joinhigh} {
- if {$arrowhigh} {
- set coords [adjarrowhigh $coords]
- }
assigncolor $id
set t [$canv create line $coords -width [linewidth $id] \
-fill $colormap($id) -tags lines.$id -arrow $arrow]
set coords [concat $coords $clow]
if {!$joinhigh} {
lset lines [expr {$i-1}] 1 $le
- if {$arrowhigh} {
- set coords [adjarrowhigh $coords]
- }
} else {
# coalesce two pieces
$canv delete $ith
proc drawparentlinks {id row} {
global rowidlist canv colormap curview parentlist
- global idpos
+ global idpos linespc
set rowids [lindex $rowidlist $row]
set col [lsearch -exact $rowids $id]
set x [xc $row $col]
set y [yc $row]
set y2 [yc $row2]
+ set d [expr {int(0.5 * $linespc)}]
+ set ymid [expr {$y + $d}]
set ids [lindex $rowidlist $row2]
# rmx = right-most X coord used
set rmx 0
if {$x2 > $rmx} {
set rmx $x2
}
- if {[lsearch -exact $rowids $p] < 0} {
+ set j [lsearch -exact $rowids $p]
+ if {$j < 0} {
# drawlineseg will do this one for us
continue
}
assigncolor $p
# should handle duplicated parents here...
set coords [list $x $y]
- if {$i < $col - 1} {
- lappend coords [xc $row [expr {$i + 1}]] $y
- } elseif {$i > $col + 1} {
- lappend coords [xc $row [expr {$i - 1}]] $y
+ if {$i != $col} {
+ # if attaching to a vertical segment, draw a smaller
+ # slant for visual distinctness
+ if {$i == $j} {
+ if {$i < $col} {
+ lappend coords [expr {$x2 + $d}] $y $x2 $ymid
+ } else {
+ lappend coords [expr {$x2 - $d}] $y $x2 $ymid
+ }
+ } elseif {$i < $col && $i < $j} {
+ # segment slants towards us already
+ lappend coords [xc $row $j] $y
+ } else {
+ if {$i < $col - 1} {
+ lappend coords [expr {$x2 + $linespc}] $y
+ } elseif {$i > $col + 1} {
+ lappend coords [expr {$x2 - $linespc}] $y
+ }
+ lappend coords $x2 $y2
+ }
+ } else {
+ lappend coords $x2 $y2
}
- lappend coords $x2 $y2
set t [$canv create line $coords -width [linewidth $p] \
-fill $colormap($p) -tags lines.$p]
$canv lower $t
global linespc canv canv2 canv3 canvy0 fgcolor curview
global commitlisted commitinfo rowidlist parentlist
global rowtextx idpos idtags idheads idotherrefs
- global linehtag linentag linedtag markingmatches
+ global linehtag linentag linedtag selectedline
global mainfont canvxmax boldrows boldnamerows fgcolor nullid nullid2
# listed is 0 for boundary, 1 for normal, 2 for left, 3 for right
-text $name -font $nfont -tags text]
set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
-text $date -font $mainfont -tags text]
- set xr [expr {$xt + [font measure $mainfont $headline]}]
- if {$markingmatches} {
- markrowmatches $row $headline $name
+ if {[info exists selectedline] && $selectedline == $row} {
+ make_secsel $row
}
+ set xr [expr {$xt + [font measure $mainfont $headline]}]
if {$xr > $canvxmax} {
set canvxmax $xr
setcanvscroll
}
proc drawcmitrow {row} {
- global displayorder rowidlist
- global iddrawn
+ global displayorder rowidlist nrows_drawn
+ global iddrawn markingmatches
global commitinfo parentlist numcommits
global filehighlight fhighlights findstring nhighlights
global hlview vhighlights
if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
askrelhighlight $row $id
}
- if {[info exists iddrawn($id)]} return
- set col [lsearch -exact [lindex $rowidlist $row] $id]
- if {$col < 0} {
- puts "oops, row $row id $id not in list"
- return
+ if {![info exists iddrawn($id)]} {
+ set col [lsearch -exact [lindex $rowidlist $row] $id]
+ if {$col < 0} {
+ puts "oops, row $row id $id not in list"
+ return
+ }
+ if {![info exists commitinfo($id)]} {
+ getcommit $id
+ }
+ assigncolor $id
+ drawcmittext $id $row $col
+ set iddrawn($id) 1
+ incr nrows_drawn
}
- if {![info exists commitinfo($id)]} {
- getcommit $id
+ if {$markingmatches} {
+ markrowmatches $row $id
}
- assigncolor $id
- drawcmittext $id $row $col
- set iddrawn($id) 1
}
proc drawcommits {row {endrow {}}} {
- global numcommits iddrawn displayorder curview
- global parentlist rowidlist
+ global numcommits iddrawn displayorder curview need_redisplay
+ global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
if {$row < 0} {
set row 0
set endrow [expr {$numcommits - 1}]
}
+ set rl1 [expr {$row - $downarrowlen - 3}]
+ if {$rl1 < 0} {
+ set rl1 0
+ }
+ set ro1 [expr {$row - 3}]
+ if {$ro1 < 0} {
+ set ro1 0
+ }
+ set r2 [expr {$endrow + $uparrowlen + 3}]
+ if {$r2 > $numcommits} {
+ set r2 $numcommits
+ }
+ for {set r $rl1} {$r < $r2} {incr r} {
+ if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
+ if {$rl1 < $r} {
+ layoutrows $rl1 $r
+ }
+ set rl1 [expr {$r + 1}]
+ }
+ }
+ if {$rl1 < $r} {
+ layoutrows $rl1 $r
+ }
+ optimize_rows $ro1 0 $r2
+ if {$need_redisplay || $nrows_drawn > 2000} {
+ clear_display
+ drawvisible
+ }
+
# make the lines join to already-drawn rows either side
set r [expr {$row - 1}]
if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
}
proc clear_display {} {
- global iddrawn linesegs
+ global iddrawn linesegs need_redisplay nrows_drawn
global vhighlights fhighlights nhighlights rhighlights
allcanvs delete all
catch {unset fhighlights}
catch {unset nhighlights}
catch {unset rhighlights}
+ set need_redisplay 0
+ set nrows_drawn 0
}
proc findcrossings {id} {
- global rowidlist parentlist numcommits rowoffsets displayorder
+ global rowidlist parentlist numcommits displayorder
set cross {}
set ccross {}
set e [expr {$numcommits - 1}]
}
if {$e <= $s} continue
- set x [lsearch -exact [lindex $rowidlist $e] $id]
- if {$x < 0} {
- puts "findcrossings: oops, no [shortids $id] in row $e"
- continue
- }
for {set row $e} {[incr row -1] >= $s} {} {
+ set x [lsearch -exact [lindex $rowidlist $row] $id]
+ if {$x < 0} break
set olds [lindex $parentlist $row]
set kid [lindex $displayorder $row]
set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
}
}
}
- set inc [lindex $rowoffsets $row $x]
- if {$inc eq {}} break
- incr x $inc
}
}
return [concat $ccross {{}} $cross]
# on that row and below will move down one row.
proc insertrow {row newcmit} {
global displayorder parentlist commitlisted children
- global commitrow curview rowidlist rowoffsets numcommits
- global rowrangelist rowlaidout rowoptim numcommits
- global selectedline rowchk commitidx
+ global commitrow curview rowidlist rowisopt rowfinal numcommits
+ global numcommits
+ global selectedline commitidx ordertok
if {$row >= $numcommits} {
puts "oops, inserting new row $row but only have $numcommits rows"
set commitrow($curview,$id) $r
}
incr commitidx($curview)
+ set ordertok($curview,$newcmit) $ordertok($curview,$p)
set idlist [lindex $rowidlist $row]
- set offs [lindex $rowoffsets $row]
- set newoffs {}
- foreach x $idlist {
- if {$x eq {} || ($x eq $p && [llength $kids] == 1)} {
- lappend newoffs {}
- } else {
- lappend newoffs 0
- }
- }
if {[llength $kids] == 1} {
set col [lsearch -exact $idlist $p]
lset idlist $col $newcmit
} else {
set col [llength $idlist]
lappend idlist $newcmit
- lappend offs {}
- lset rowoffsets $row $offs
}
set rowidlist [linsert $rowidlist $row $idlist]
- set rowoffsets [linsert $rowoffsets [expr {$row+1}] $newoffs]
+ set rowisopt [linsert $rowisopt $row 0]
+ set rowfinal [linsert $rowfinal $row [lindex $rowfinal $row]]
- set rowrangelist [linsert $rowrangelist $row {}]
- if {[llength $kids] > 1} {
- set rp1 [expr {$row + 1}]
- set ranges [lindex $rowrangelist $rp1]
- if {$ranges eq {}} {
- set ranges [list $newcmit $p]
- } elseif {[lindex $ranges end-1] eq $p} {
- lset ranges end-1 $newcmit
- }
- lset rowrangelist $rp1 $ranges
- }
-
- catch {unset rowchk}
-
- incr rowlaidout
- incr rowoptim
incr numcommits
if {[info exists selectedline] && $selectedline >= $row} {
# Remove a commit that was inserted with insertrow on row $row.
proc removerow {row} {
global displayorder parentlist commitlisted children
- global commitrow curview rowidlist rowoffsets numcommits
- global rowrangelist idrowranges rowlaidout rowoptim numcommits
- global linesegends selectedline rowchk commitidx
+ global commitrow curview rowidlist rowisopt rowfinal numcommits
+ global numcommits
+ global linesegends selectedline commitidx
if {$row >= $numcommits} {
puts "oops, removing row $row but only have $numcommits rows"
incr commitidx($curview) -1
set rowidlist [lreplace $rowidlist $row $row]
- set rowoffsets [lreplace $rowoffsets $rp1 $rp1]
- if {$kids ne {}} {
- set offs [lindex $rowoffsets $row]
- set offs [lreplace $offs end end]
- lset rowoffsets $row $offs
- }
+ set rowisopt [lreplace $rowisopt $row $row]
+ set rowfinal [lreplace $rowfinal $row $row]
- set rowrangelist [lreplace $rowrangelist $row $row]
- if {[llength $kids] > 0} {
- set ranges [lindex $rowrangelist $row]
- if {[lindex $ranges end-1] eq $id} {
- set ranges [lreplace $ranges end-1 end]
- lset rowrangelist $row $ranges
- }
- }
-
- catch {unset rowchk}
-
- incr rowlaidout -1
- incr rowoptim -1
incr numcommits -1
if {[info exists selectedline] && $selectedline > $row} {
if {!$rev} {
run findmore
} else {
- set findcurline $findstartline
if {$findcurline == 0} {
set findcurline $numcommits
}
proc findmore {} {
global commitdata commitinfo numcommits findstring findpattern findloc
- global findstartline findcurline markingmatches displayorder
+ global findstartline findcurline displayorder
set fldtypes {Headline Author Date Committer CDate Comments}
set l [expr {$findcurline + 1}]
set last 0
for {} {$l < $lim} {incr l} {
set id [lindex $displayorder $l]
+ # shouldn't happen unless git log doesn't give all the commits...
+ if {![info exists commitdata($id)]} continue
if {![doesmatch $commitdata($id)]} continue
if {![info exists commitinfo($id)]} {
getcommit $id
foreach f $info ty $fldtypes {
if {($findloc eq "All fields" || $findloc eq $ty) &&
[doesmatch $f]} {
- set markingmatches 1
findselectline $l
notbusy finding
return 0
proc findmorerev {} {
global commitdata commitinfo numcommits findstring findpattern findloc
- global findstartline findcurline markingmatches displayorder
+ global findstartline findcurline displayorder
set fldtypes {Headline Author Date Committer CDate Comments}
set l $findcurline
set last 0
for {} {$l > $lim} {incr l -1} {
set id [lindex $displayorder $l]
+ if {![info exists commitdata($id)]} continue
if {![doesmatch $commitdata($id)]} continue
if {![info exists commitinfo($id)]} {
getcommit $id
foreach f $info ty $fldtypes {
if {($findloc eq "All fields" || $findloc eq $ty) &&
[doesmatch $f]} {
- set markingmatches 1
findselectline $l
notbusy finding
return 0
}
proc findselectline {l} {
- global findloc commentend ctext
+ global findloc commentend ctext findcurline markingmatches
+
+ set markingmatches 1
+ set findcurline $l
selectline $l 1
if {$findloc == "All fields" || $findloc == "Comments"} {
# highlight the matches in the comments
$ctext tag add found "1.0 + $start c" "1.0 + $end c"
}
}
+ drawvisible
}
# mark the bits of a headline or author that match a find string
-proc markmatches {canv l str tag matches font} {
+proc markmatches {canv l str tag matches font row} {
+ global selectedline
+
set bbox [$canv bbox $tag]
set x0 [lindex $bbox 0]
set y0 [lindex $bbox 1]
[expr {$x0+$xlen+2}] $y1 \
-outline {} -tags [list match$l matches] -fill yellow]
$canv lower $t
+ if {[info exists selectedline] && $row == $selectedline} {
+ $canv raise $t secsel
+ }
}
}
# append some text to the ctext widget, and make any SHA1 ID
# that we know about be a clickable link.
proc appendwithlinks {text tags} {
- global ctext commitrow linknum curview
+ global ctext commitrow linknum curview pendinglinks
set start [$ctext index "end - 1c"]
$ctext insert end $text $tags
set s [lindex $l 0]
set e [lindex $l 1]
set linkid [string range $text $s $e]
- if {![info exists commitrow($curview,$linkid)]} continue
incr e
- $ctext tag add link "$start + $s c" "$start + $e c"
$ctext tag add link$linknum "$start + $s c" "$start + $e c"
- $ctext tag bind link$linknum <1> \
- [list selectline $commitrow($curview,$linkid) 1]
+ setlink $linkid link$linknum
incr linknum
}
- $ctext tag conf link -foreground blue -underline 1
- $ctext tag bind link <Enter> { %W configure -cursor hand2 }
- $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
+}
+
+proc setlink {id lk} {
+ global curview commitrow ctext pendinglinks commitinterest
+
+ if {[info exists commitrow($curview,$id)]} {
+ $ctext tag conf $lk -foreground blue -underline 1
+ $ctext tag bind $lk <1> [list selectline $commitrow($curview,$id) 1]
+ $ctext tag bind $lk <Enter> {linkcursor %W 1}
+ $ctext tag bind $lk <Leave> {linkcursor %W -1}
+ } else {
+ lappend pendinglinks($id) $lk
+ lappend commitinterest($id) {makelink %I}
+ }
+}
+
+proc makelink {id} {
+ global pendinglinks
+
+ if {![info exists pendinglinks($id)]} return
+ foreach lk $pendinglinks($id) {
+ setlink $id $lk
+ }
+ unset pendinglinks($id)
+}
+
+proc linkcursor {w inc} {
+ global linkentercount curtextcursor
+
+ if {[incr linkentercount $inc] > 0} {
+ $w configure -cursor hand2
+ } else {
+ $w configure -cursor $curtextcursor
+ if {$linkentercount < 0} {
+ set linkentercount 0
+ }
+ }
}
proc viewnextline {dir} {
$ctext tag delete $lk
$ctext insert $pos $sep
$ctext insert $pos [lindex $ti 0] $lk
- if {[info exists commitrow($curview,$id)]} {
- $ctext tag conf $lk -foreground blue
- $ctext tag bind $lk <1> \
- [list selectline $commitrow($curview,$id) 1]
- $ctext tag conf $lk -underline 1
- $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
- $ctext tag bind $lk <Leave> \
- { %W configure -cursor $curtextcursor }
- }
+ setlink $id $lk
set sep ", "
}
}
}
}
+proc make_secsel {l} {
+ global linehtag linentag linedtag canv canv2 canv3
+
+ if {![info exists linehtag($l)]} return
+ $canv delete secsel
+ set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
+ -tags secsel -fill [$canv cget -selectbackground]]
+ $canv lower $t
+ $canv2 delete secsel
+ set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
+ -tags secsel -fill [$canv2 cget -selectbackground]]
+ $canv2 lower $t
+ $canv3 delete secsel
+ set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
+ -tags secsel -fill [$canv3 cget -selectbackground]]
+ $canv3 lower $t
+}
+
proc selectline {l isnew} {
- global canv canv2 canv3 ctext commitinfo selectedline
- global displayorder linehtag linentag linedtag
+ global canv ctext commitinfo selectedline
+ global displayorder
global canvy0 linespc parentlist children curview
global currentid sha1entry
global commentend idtags linknum
$canv delete hover
normalline
cancel_next_highlight
+ unsel_reflist
if {$l < 0 || $l >= $numcommits} return
set y [expr {$canvy0 + $l * $linespc}]
set ymax [lindex [$canv cget -scrollregion] 3]
drawvisible
}
- if {![info exists linehtag($l)]} return
- $canv delete secsel
- set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
- -tags secsel -fill [$canv cget -selectbackground]]
- $canv lower $t
- $canv2 delete secsel
- set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
- -tags secsel -fill [$canv2 cget -selectbackground]]
- $canv2 lower $t
- $canv3 delete secsel
- set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
- -tags secsel -fill [$canv3 cget -selectbackground]]
- $canv3 lower $t
+ make_secsel $l
if {$isnew} {
addtohistory [list selectline $l 0]
proc selnextline {dir} {
global selectedline
+ focus .
if {![info exists selectedline]} return
set l [expr {$selectedline + $dir}]
unmarkmatches
proc goback {} {
global history historyindex
+ focus .
if {$historyindex > 1} {
incr historyindex -1
proc goforw {} {
global history historyindex
+ focus .
if {$historyindex < [llength $history]} {
set cmd [lindex $history $historyindex]
return 0
}
+# empty string or positive integer
+proc diffcontextvalidate {v} {
+ return [regexp {^(|[1-9][0-9]*)$} $v]
+}
+
+proc diffcontextchange {n1 n2 op} {
+ global diffcontextstring diffcontext
+
+ if {[string is integer -strict $diffcontextstring]} {
+ if {$diffcontextstring > 0} {
+ set diffcontext $diffcontextstring
+ reselectline
+ }
+ }
+}
+
proc getblobdiffs {ids} {
global diffopts blobdifffd diffids env
global diffinhdr treediffs
+ global diffcontext
set env(GIT_DIFF_OPTS) $diffopts
- if {[catch {set bdf [open [diffcmd $ids {-p -C --no-commit-id}] r]} err]} {
+ if {[catch {set bdf [open [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"] r]} err]} {
puts "error getting diffs: $err"
return
}
# the middle char will be a space, and the two bits either
# side will be a/name and b/name, or "a/name" and "b/name".
# If the name has changed we'll get "rename from" and
- # "rename to" lines following this, and we'll use them
- # to get the filenames.
+ # "rename to" or "copy from" and "copy to" lines following this,
+ # and we'll use them to get the filenames.
# This complexity is necessary because spaces in the filename(s)
# don't get escaped.
set l [string length $line]
set diffinhdr 0
} elseif {$diffinhdr} {
- if {![string compare -length 12 "rename from " $line]} {
- set fname [string range $line 12 end]
+ if {![string compare -length 12 "rename from " $line] ||
+ ![string compare -length 10 "copy from " $line]} {
+ set fname [string range $line [expr 6 + [string first " from " $line] ] end]
if {[string index $fname 0] eq "\""} {
set fname [lindex $fname 0]
}
if {$i >= 0} {
setinlist difffilestart $i $curdiffstart
}
- } elseif {![string compare -length 10 $line "rename to "]} {
- set fname [string range $line 10 end]
+ } elseif {![string compare -length 10 $line "rename to "] ||
+ ![string compare -length 8 $line "copy to "]} {
+ set fname [string range $line [expr 4 + [string first " to " $line] ] end]
if {[string index $fname 0] eq "\""} {
set fname [lindex $fname 0]
}
proc clear_ctext {{first 1.0}} {
global ctext smarktop smarkbot
+ global pendinglinks
set l [lindex [split $first .] 0]
if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
set smarkbot $l
}
$ctext delete $first end
+ if {$first eq "1.0"} {
+ catch {unset pendinglinks}
+ }
}
proc incrsearch {name ix op} {
}
proc incrfont {inc} {
- global mainfont textfont ctext canv phase cflist
+ global mainfont textfont ctext canv phase cflist showrefstop
global charspc tabstop
global stopped entries
unmarkmatches
if {$phase eq "getcommits"} {
$canv itemconf textitems -font $mainfont
}
+ if {[info exists showrefstop] && [winfo exists $showrefstop]} {
+ $showrefstop.list conf -font $mainfont
+ }
redisplay
}
}
proc lineclick {x y id isnew} {
- global ctext commitinfo children canv thickerline curview
+ global ctext commitinfo children canv thickerline curview commitrow
if {![info exists commitinfo($id)] && ![getcommit $id]} return
unmarkmatches
# fill the details pane with info about this line
$ctext conf -state normal
clear_ctext
- $ctext tag conf link -foreground blue -underline 1
- $ctext tag bind link <Enter> { %W configure -cursor hand2 }
- $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
$ctext insert end "Parent:\t"
- $ctext insert end $id [list link link0]
- $ctext tag bind link0 <1> [list selbyid $id]
+ $ctext insert end $id link0
+ setlink $id link0
set info $commitinfo($id)
$ctext insert end "\n\t[lindex $info 0]\n"
$ctext insert end "\tAuthor:\t[lindex $info 1]\n"
if {![info exists commitinfo($child)] && ![getcommit $child]} continue
set info $commitinfo($child)
$ctext insert end "\n\t"
- $ctext insert end $child [list link link$i]
- $ctext tag bind link$i <1> [list selbyid $child]
+ $ctext insert end $child link$i
+ setlink $child link$i
$ctext insert end "\n\t[lindex $info 0]"
$ctext insert end "\n\tAuthor:\t[lindex $info 1]"
set date [formatdate [lindex $info 2]]
clear_ctext
init_flist "Top"
$ctext insert end "From "
- $ctext tag conf link -foreground blue -underline 1
- $ctext tag bind link <Enter> { %W configure -cursor hand2 }
- $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
- $ctext tag bind link0 <1> [list selbyid $oldid]
- $ctext insert end $oldid [list link link0]
+ $ctext insert end $oldid link0
+ setlink $oldid link0
$ctext insert end "\n "
$ctext insert end [lindex $commitinfo($oldid) 0]
$ctext insert end "\n\nTo "
- $ctext tag bind link1 <1> [list selbyid $newid]
- $ctext insert end $newid [list link link1]
+ $ctext insert end $newid link1
+ setlink $newid link1
$ctext insert end "\n "
$ctext insert end [lindex $commitinfo($newid) 0]
$ctext insert end "\n"
lappend idtags($id) $tag
redrawtags $id
addedtag $id
+ dispneartags 0
+ run refill_reflist
}
proc redrawtags {id} {
notbusy newbranch
redrawtags $id
dispneartags 0
+ run refill_reflist
}
}
proc rmbranch {} {
global headmenuid headmenuhead mainhead
- global headids idheads
+ global idheads
set head $headmenuhead
set id $headmenuid
return
}
set dheads [descheads $id]
- if {$dheads eq $headids($head)} {
+ if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
# the stuff on this branch isn't on any other branch
if {![confirm_popup "The commits on branch $head aren't on any other\
branch.\nReally delete branch $head?"]} return
redrawtags $id
notbusy rmbranch
dispneartags 0
+ run refill_reflist
}
-# Stuff for finding nearby tags
-proc getallcommits {} {
- global allcommits allids nbmp nextarc seeds
+# Display a list of tags and heads
+proc showrefs {} {
+ global showrefstop bgcolor fgcolor selectbgcolor mainfont
+ global bglist fglist uifont reflistfilter reflist maincursor
- set allids {}
- set nbmp 0
- set nextarc 0
- set allcommits 0
- set seeds {}
- regetallcommits
+ set top .showrefs
+ set showrefstop $top
+ if {[winfo exists $top]} {
+ raise $top
+ refill_reflist
+ return
+ }
+ toplevel $top
+ wm title $top "Tags and heads: [file tail [pwd]]"
+ text $top.list -background $bgcolor -foreground $fgcolor \
+ -selectbackground $selectbgcolor -font $mainfont \
+ -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
+ -width 30 -height 20 -cursor $maincursor \
+ -spacing1 1 -spacing3 1 -state disabled
+ $top.list tag configure highlight -background $selectbgcolor
+ lappend bglist $top.list
+ lappend fglist $top.list
+ scrollbar $top.ysb -command "$top.list yview" -orient vertical
+ scrollbar $top.xsb -command "$top.list xview" -orient horizontal
+ grid $top.list $top.ysb -sticky nsew
+ grid $top.xsb x -sticky ew
+ frame $top.f
+ label $top.f.l -text "Filter: " -font $uifont
+ entry $top.f.e -width 20 -textvariable reflistfilter -font $uifont
+ set reflistfilter "*"
+ trace add variable reflistfilter write reflistfilter_change
+ pack $top.f.e -side right -fill x -expand 1
+ pack $top.f.l -side left
+ grid $top.f - -sticky ew -pady 2
+ button $top.close -command [list destroy $top] -text "Close" \
+ -font $uifont
+ grid $top.close -
+ grid columnconfigure $top 0 -weight 1
+ grid rowconfigure $top 0 -weight 1
+ bind $top.list <1> {break}
+ bind $top.list <B1-Motion> {break}
+ bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
+ set reflist {}
+ refill_reflist
}
-# Called when the graph might have changed
-proc regetallcommits {} {
- global allcommits seeds
+proc sel_reflist {w x y} {
+ global showrefstop reflist headids tagids otherrefids
- set cmd [concat | git rev-list --all --parents]
- foreach id $seeds {
- lappend cmd "^$id"
+ if {![winfo exists $showrefstop]} return
+ set l [lindex [split [$w index "@$x,$y"] "."] 0]
+ set ref [lindex $reflist [expr {$l-1}]]
+ set n [lindex $ref 0]
+ switch -- [lindex $ref 1] {
+ "H" {selbyid $headids($n)}
+ "T" {selbyid $tagids($n)}
+ "o" {selbyid $otherrefids($n)}
+ }
+ $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
+}
+
+proc unsel_reflist {} {
+ global showrefstop
+
+ if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
+ $showrefstop.list tag remove highlight 0.0 end
+}
+
+proc reflistfilter_change {n1 n2 op} {
+ global reflistfilter
+
+ after cancel refill_reflist
+ after 200 refill_reflist
+}
+
+proc refill_reflist {} {
+ global reflist reflistfilter showrefstop headids tagids otherrefids
+ global commitrow curview commitinterest
+
+ if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
+ set refs {}
+ foreach n [array names headids] {
+ if {[string match $reflistfilter $n]} {
+ if {[info exists commitrow($curview,$headids($n))]} {
+ lappend refs [list $n H]
+ } else {
+ set commitinterest($headids($n)) {run refill_reflist}
+ }
+ }
+ }
+ foreach n [array names tagids] {
+ if {[string match $reflistfilter $n]} {
+ if {[info exists commitrow($curview,$tagids($n))]} {
+ lappend refs [list $n T]
+ } else {
+ set commitinterest($tagids($n)) {run refill_reflist}
+ }
+ }
+ }
+ foreach n [array names otherrefids] {
+ if {[string match $reflistfilter $n]} {
+ if {[info exists commitrow($curview,$otherrefids($n))]} {
+ lappend refs [list $n o]
+ } else {
+ set commitinterest($otherrefids($n)) {run refill_reflist}
+ }
+ }
+ }
+ set refs [lsort -index 0 $refs]
+ if {$refs eq $reflist} return
+
+ # Update the contents of $showrefstop.list according to the
+ # differences between $reflist (old) and $refs (new)
+ $showrefstop.list conf -state normal
+ $showrefstop.list insert end "\n"
+ set i 0
+ set j 0
+ while {$i < [llength $reflist] || $j < [llength $refs]} {
+ if {$i < [llength $reflist]} {
+ if {$j < [llength $refs]} {
+ set cmp [string compare [lindex $reflist $i 0] \
+ [lindex $refs $j 0]]
+ if {$cmp == 0} {
+ set cmp [string compare [lindex $reflist $i 1] \
+ [lindex $refs $j 1]]
+ }
+ } else {
+ set cmp -1
+ }
+ } else {
+ set cmp 1
+ }
+ switch -- $cmp {
+ -1 {
+ $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
+ incr i
+ }
+ 0 {
+ incr i
+ incr j
+ }
+ 1 {
+ set l [expr {$j + 1}]
+ $showrefstop.list image create $l.0 -align baseline \
+ -image reficon-[lindex $refs $j 1] -padx 2
+ $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
+ incr j
+ }
+ }
+ }
+ set reflist $refs
+ # delete last newline
+ $showrefstop.list delete end-2c end-1c
+ $showrefstop.list conf -state disabled
+}
+
+# Stuff for finding nearby tags
+proc getallcommits {} {
+ global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
+ global idheads idtags idotherrefs allparents tagobjid
+
+ if {![info exists allcommits]} {
+ set nextarc 0
+ set allcommits 0
+ set seeds {}
+ set allcwait 0
+ set cachedarcs 0
+ set allccache [file join [gitdir] "gitk.cache"]
+ if {![catch {
+ set f [open $allccache r]
+ set allcwait 1
+ getcache $f
+ }]} return
+ }
+
+ if {$allcwait} {
+ return
+ }
+ set cmd [list | git rev-list --parents]
+ set allcupdate [expr {$seeds ne {}}]
+ if {!$allcupdate} {
+ set ids "--all"
+ } else {
+ set refs [concat [array names idheads] [array names idtags] \
+ [array names idotherrefs]]
+ set ids {}
+ set tagobjs {}
+ foreach name [array names tagobjid] {
+ lappend tagobjs $tagobjid($name)
+ }
+ foreach id [lsort -unique $refs] {
+ if {![info exists allparents($id)] &&
+ [lsearch -exact $tagobjs $id] < 0} {
+ lappend ids $id
+ }
+ }
+ if {$ids ne {}} {
+ foreach id $seeds {
+ lappend ids "^$id"
+ }
+ }
+ }
+ if {$ids ne {}} {
+ set fd [open [concat $cmd $ids] r]
+ fconfigure $fd -blocking 0
+ incr allcommits
+ nowbusy allcommits
+ filerun $fd [list getallclines $fd]
+ } else {
+ dispneartags 0
}
- set fd [open $cmd r]
- fconfigure $fd -blocking 0
- incr allcommits
- nowbusy allcommits
- filerun $fd [list getallclines $fd]
}
# Since most commits have 1 parent and 1 child, we group strings of
# coming from descendents, and "outgoing" means going towards ancestors.
proc getallclines {fd} {
- global allids allparents allchildren idtags idheads nextarc nbmp
+ global allparents allchildren idtags idheads nextarc
global arcnos arcids arctags arcout arcend arcstart archeads growing
- global seeds allcommits
-
+ global seeds allcommits cachedarcs allcupdate
+
set nid 0
while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
set id [lindex $line 0]
# seen it already
continue
}
- lappend allids $id
+ set cachedarcs 0
set olds [lrange $line 1 end]
set allparents($id) $olds
if {![info exists allchildren($id)]} {
continue
}
}
- incr nbmp
foreach a $arcnos($id) {
lappend arcids($a) $id
set arcend($a) $id
if {![eof $fd]} {
return [expr {$nid >= 1000? 2: 1}]
}
- close $fd
+ set cacheok 1
+ if {[catch {
+ fconfigure $fd -blocking 1
+ close $fd
+ } err]} {
+ # got an error reading the list of commits
+ # if we were updating, try rereading the whole thing again
+ if {$allcupdate} {
+ incr allcommits -1
+ dropcache $err
+ return
+ }
+ error_popup "Error reading commit topology information;\
+ branch and preceding/following tag information\
+ will be incomplete.\n($err)"
+ set cacheok 0
+ }
if {[incr allcommits -1] == 0} {
notbusy allcommits
+ if {$cacheok} {
+ run savecache
+ }
}
dispneartags 0
return 0
}
proc splitarc {p} {
- global arcnos arcids nextarc nbmp arctags archeads idtags idheads
+ global arcnos arcids nextarc arctags archeads idtags idheads
global arcstart arcend arcout allparents growing
set a $arcnos($p)
set growing($na) 1
unset growing($a)
}
- incr nbmp
foreach id $tail {
if {[llength $arcnos($id)] == 1} {
# Update things for a new commit added that is a child of one
# existing commit. Used when cherry-picking.
proc addnewchild {id p} {
- global allids allparents allchildren idtags nextarc nbmp
+ global allparents allchildren idtags nextarc
global arcnos arcids arctags arcout arcend arcstart archeads growing
- global seeds
+ global seeds allcommits
- lappend allids $id
+ if {![info exists allcommits]} return
set allparents($id) [list $p]
set allchildren($id) {}
set arcnos($id) {}
lappend seeds $id
- incr nbmp
lappend allchildren($p) $id
set a [incr nextarc]
set arcstart($a) $id
set arcout($id) [list $a]
}
+# This implements a cache for the topology information.
+# The cache saves, for each arc, the start and end of the arc,
+# the ids on the arc, and the outgoing arcs from the end.
+proc readcache {f} {
+ global arcnos arcids arcout arcstart arcend arctags archeads nextarc
+ global idtags idheads allparents cachedarcs possible_seeds seeds growing
+ global allcwait
+
+ set a $nextarc
+ set lim $cachedarcs
+ if {$lim - $a > 500} {
+ set lim [expr {$a + 500}]
+ }
+ if {[catch {
+ if {$a == $lim} {
+ # finish reading the cache and setting up arctags, etc.
+ set line [gets $f]
+ if {$line ne "1"} {error "bad final version"}
+ close $f
+ foreach id [array names idtags] {
+ if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
+ [llength $allparents($id)] == 1} {
+ set a [lindex $arcnos($id) 0]
+ if {$arctags($a) eq {}} {
+ recalcarc $a
+ }
+ }
+ }
+ foreach id [array names idheads] {
+ if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
+ [llength $allparents($id)] == 1} {
+ set a [lindex $arcnos($id) 0]
+ if {$archeads($a) eq {}} {
+ recalcarc $a
+ }
+ }
+ }
+ foreach id [lsort -unique $possible_seeds] {
+ if {$arcnos($id) eq {}} {
+ lappend seeds $id
+ }
+ }
+ set allcwait 0
+ } else {
+ while {[incr a] <= $lim} {
+ set line [gets $f]
+ if {[llength $line] != 3} {error "bad line"}
+ set s [lindex $line 0]
+ set arcstart($a) $s
+ lappend arcout($s) $a
+ if {![info exists arcnos($s)]} {
+ lappend possible_seeds $s
+ set arcnos($s) {}
+ }
+ set e [lindex $line 1]
+ if {$e eq {}} {
+ set growing($a) 1
+ } else {
+ set arcend($a) $e
+ if {![info exists arcout($e)]} {
+ set arcout($e) {}
+ }
+ }
+ set arcids($a) [lindex $line 2]
+ foreach id $arcids($a) {
+ lappend allparents($s) $id
+ set s $id
+ lappend arcnos($id) $a
+ }
+ if {![info exists allparents($s)]} {
+ set allparents($s) {}
+ }
+ set arctags($a) {}
+ set archeads($a) {}
+ }
+ set nextarc [expr {$a - 1}]
+ }
+ } err]} {
+ dropcache $err
+ return 0
+ }
+ if {!$allcwait} {
+ getallcommits
+ }
+ return $allcwait
+}
+
+proc getcache {f} {
+ global nextarc cachedarcs possible_seeds
+
+ if {[catch {
+ set line [gets $f]
+ if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
+ # make sure it's an integer
+ set cachedarcs [expr {int([lindex $line 1])}]
+ if {$cachedarcs < 0} {error "bad number of arcs"}
+ set nextarc 0
+ set possible_seeds {}
+ run readcache $f
+ } err]} {
+ dropcache $err
+ }
+ return 0
+}
+
+proc dropcache {err} {
+ global allcwait nextarc cachedarcs seeds
+
+ #puts "dropping cache ($err)"
+ foreach v {arcnos arcout arcids arcstart arcend growing \
+ arctags archeads allparents allchildren} {
+ global $v
+ catch {unset $v}
+ }
+ set allcwait 0
+ set nextarc 0
+ set cachedarcs 0
+ set seeds {}
+ getallcommits
+}
+
+proc writecache {f} {
+ global cachearc cachedarcs allccache
+ global arcstart arcend arcnos arcids arcout
+
+ set a $cachearc
+ set lim $cachedarcs
+ if {$lim - $a > 1000} {
+ set lim [expr {$a + 1000}]
+ }
+ if {[catch {
+ while {[incr a] <= $lim} {
+ if {[info exists arcend($a)]} {
+ puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
+ } else {
+ puts $f [list $arcstart($a) {} $arcids($a)]
+ }
+ }
+ } err]} {
+ catch {close $f}
+ catch {file delete $allccache}
+ #puts "writing cache failed ($err)"
+ return 0
+ }
+ set cachearc [expr {$a - 1}]
+ if {$a > $cachedarcs} {
+ puts $f "1"
+ close $f
+ return 0
+ }
+ return 1
+}
+
+proc savecache {} {
+ global nextarc cachedarcs cachearc allccache
+
+ if {$nextarc == $cachedarcs} return
+ set cachearc 0
+ set cachedarcs $nextarc
+ catch {
+ set f [open $allccache w]
+ puts $f [list 1 $cachedarcs]
+ run writecache $f
+ }
+}
+
# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
# or 0 if neither is true.
proc anc_or_desc {a b} {
redrawtags $id
}
}
+ run refill_reflist
}
proc listrefs {id} {
}
proc formatdate {d} {
+ global datetimeformat
if {$d ne {}} {
- set d [clock format $d -format "%Y-%m-%d %H:%M:%S"]
+ set d [clock format $d -format $datetimeformat]
}
return $d
}
set maxwidth 16
set revlistorder 0
set fastdate 0
-set uparrowlen 7
-set downarrowlen 7
-set mingaplen 30
+set uparrowlen 5
+set downarrowlen 5
+set mingaplen 100
set cmitmode "patch"
set wrapcomment "none"
set showneartags 1
set maxrefs 20
set maxlinelen 200
set showlocalchanges 1
+set datetimeformat "%Y-%m-%d %H:%M:%S"
set colors {green red blue magenta darkgrey brown orange}
set bgcolor white
set fgcolor black
set diffcolors {red "#00a000" blue}
+set diffcontext 3
set selectbgcolor gray85
catch {source ~/.gitk}
font create optionfont -family sans-serif -size -12
# check that we can find a .git directory somewhere...
-set gitdir [gitdir]
+if {[catch {set gitdir [gitdir]}]} {
+ show_error {} . "Cannot find a git repository here."
+ exit 1
+}
if {![file isdirectory $gitdir]} {
show_error {} . "Cannot find the git directory \"$gitdir\"."
exit 1
set boldnamerows {}
set diffelide {0 0}
set markingmatches 0
-
-set optim_delay 16
+set linkentercount 0
+set need_redisplay 0
+set nrows_drawn 0
set nextviewnum 1
set curview 0
set lserial 0
setcoords
makewindow
+# wait for the window to become visible
+tkwait visibility .
wm title . "[file tail $argv0]: [file tail [pwd]]"
readrefs