proc updatecommits {} {
global viewdata curview phase displayorder
- global children commitrow selectedline thickerline
+ global children commitrow selectedline thickerline showneartags
if {$phase ne {}} {
stop_rev_list
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 {
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
-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
# the cursor is in scans horizontally
proc canvscan {op w x y} {
# 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 .
proc makeuparrow {oid y x} {
global rowidlist uparrowlen idrowranges displayorder
- for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
+ for {set i 0} {$i < $uparrowlen && $y > 1} {incr i} {
incr y -1
set idl [lindex $rowidlist $y]
set x [idcol $idl $oid $x]
set idlist [lindex $rowidlist $row]
while {$row < $endrow} {
set id [lindex $displayorder $row]
- set oldolds {}
- set newolds {}
- set olds [lindex $parentlist $row]
- foreach p $olds {
- 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 {1 || $nev > 0} {
+ if {1} {
if {!$last &&
$row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
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}]
+ set rowchk($i) [expr {$row + $r}]
}
}
lset rowidlist $row $idlist
}
+ set oldolds {}
+ set newolds {}
+ foreach p [lindex $parentlist $row] {
+ if {![info exists idinlist($p)]} {
+ lappend newolds $p
+ } elseif {!$idinlist($p)} {
+ lappend oldolds $p
+ }
+ set idinlist($p) 1
+ }
set col [lsearch -exact $idlist $id]
if {$col < 0} {
set col [idcol $idlist $id]
foreach i $newolds {
set x [idcol $idlist $i $x]
set idlist [linsert $idlist $x $i]
- set idinlist($i) 1
set idrowranges($i) $id
}
foreach oid $oldolds {
- set idinlist($oid) 1
set x [idcol $idlist $oid $x]
set idlist [linsert $idlist $x $oid]
makeuparrow $oid $row $x
set col [expr {[llength $idlist] - 1}]
set id [lindex $idlist $col]
addextraid $id $row
- unset idinlist($id)
+ catch {unset idinlist($id)}
lappend idrowranges($id) $id
lappend rowrangelist $idrowranges($id)
unset idrowranges($id)
global rowidlist
set pad [ntimes $npad {}]
- lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
+ 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]
}
proc optimize_rows {row col endrow} {
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 right too much;
# insert pads in this line
set npad [expr {$z - 1 + $isarrow}]
- set pad [ntimes $npad {}]
- set idlist [eval linsert \$idlist $col $pad]
+ insert_pad $row $col $npad
+ set idlist [lindex $rowidlist $row]
incr col $npad
set z [expr {$x0 - $col}]
set haspad 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]
- } 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]
- }
- }
- return $coords
-}
-
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
set x [xc $row $col]
set y [yc $row]
set y2 [yc $row2]
- set d [expr {int(0.4 * $linespc)}]
+ set d [expr {int(0.5 * $linespc)}]
set ymid [expr {$y + $d}]
set ids [lindex $rowidlist $row2]
# rmx = right-most X coord used
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]
proc getallcommits {} {
global allcommits allids nbmp nextarc seeds
- set allids {}
- set nbmp 0
- set nextarc 0
- set allcommits 0
- set seeds {}
- regetallcommits
-}
-
-# Called when the graph might have changed
-proc regetallcommits {} {
- global allcommits seeds
+ if {![info exists allcommits]} {
+ set allids {}
+ set nbmp 0
+ set nextarc 0
+ set allcommits 0
+ set seeds {}
+ }
set cmd [concat | git rev-list --all --parents]
foreach id $seeds {
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