# and distributed under the terms of the GNU General Public Licence,
# either version 2, or (at your option) any later version.
-# CVS $Revision: 1.23 $
+# CVS $Revision: 1.24 $
proc getcommits {rargs} {
global commits commfd phase canv mainfont
global startmsecs nextupdate
- global ctext maincursor textcursor
+ global ctext maincursor textcursor nlines
if {$rargs == {}} {
set rargs HEAD
puts stderr "Error executing git-rev-list: $err"
exit 1
}
+ set nlines 0
fconfigure $commfd -blocking 0
fileevent $commfd readable "getcommitline $commfd"
$canv delete all
proc getcommitline {commfd} {
global commits parents cdate children nchildren ncleft
global commitlisted phase commitinfo nextupdate
- global stopped redisplaying
+ global stopped redisplaying nlines
set n [gets $commfd line]
if {$n < 0} {
error_popup $err
exit 1
}
+ incr nlines
if {![regexp {^[0-9a-f]{40}$} $line id]} {
error_popup "Can't parse git-rev-list output: {$line}"
exit 1
global findtype findloc findstring fstring geometry
global entries sha1entry sha1string sha1but
global maincursor textcursor
+ global linectxmenu
menu .bar
.bar add cascade -label "File" -menu .bar.file
set maincursor [. cget -cursor]
set textcursor [$ctext cget -cursor]
+
+ set linectxmenu .linectxmenu
+ menu $linectxmenu -tearoff 0
+ $linectxmenu add command -label "Select" -command lineselect
}
# when we make a key binding for the toplevel, make sure
Use and redistribute under the terms of the GNU General Public License
-(CVS $Revision: 1.23 $)} \
+(CVS $Revision: 1.24 $)} \
-justify center -aspect 400
pack $w.m -side top -fill x -padx 20 -pady 20
button $w.ok -text Close -command "destroy $w"
proc initgraph {} {
global canvy canvy0 lineno numcommits lthickness nextcolor linespc
- global linestarty
+ global glines
global nchildren ncleft
allcanvs delete all
set lineno -1
set numcommits 0
set lthickness [expr {int($linespc / 9) + 1}]
- catch {unset linestarty}
+ catch {unset glines}
foreach id [array names nchildren] {
set ncleft($id) $nchildren($id)
}
global colormap numcommits currentparents
global oldlevel oldnlines oldtodo
global idtags idline idheads
- global lineno lthickness linestarty
+ global lineno lthickness glines
global commitlisted
incr numcommits
set canvy [expr $canvy + $linespc]
allcanvs conf -scrollregion \
[list 0 0 0 [expr $y1 + 0.5 * $linespc + 2]]
- if {[info exists linestarty($id)] && $linestarty($id) < $y1} {
- set t [$canv create line $x $linestarty($id) $x $y1 \
+ if {[info exists glines($id)]} {
+ lappend glines($id) $x $y1
+ set t [$canv create line $glines($id) \
-width $lthickness -fill $colormap($id)]
$canv lower $t
+ $canv bind $t <Button-3> "linemenu %X %Y $id"
+ $canv bind $t <Enter> "lineenter %x %y $id"
+ $canv bind $t <Motion> "linemotion %x %y $id"
+ $canv bind $t <Leave> "lineleave $id"
}
set orad [expr {$linespc / 3}]
set t [$canv create oval [expr $x - $orad] [expr $y1 - $orad] \
set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
-width $lthickness -fill black]
$canv lower $t
+ $canv bind $t <Button-3> "linemenu %X %Y $id"
+ $canv bind $t <Enter> "lineenter %x %y $id"
+ $canv bind $t <Motion> "linemotion %x %y $id"
+ $canv bind $t <Leave> "lineleave $id"
foreach tag $marks x $xvals wid $wvals {
set xl [expr $x + $delta]
set xr [expr $x + $delta + $wid + $lthickness]
proc updatetodo {level noshortcut} {
global datemode currentparents ncleft todo
- global linestarty oldlevel oldtodo oldnlines
- global canvy linespc
+ global glines oldlevel oldtodo oldnlines
+ global canvx0 canvy linespc glines
global commitinfo
foreach p $currentparents {
readcommit $p
}
}
+ set x [expr $canvx0 + $level * $linespc]
+ set y [expr $canvy - $linespc]
if {!$noshortcut && [llength $currentparents] == 1} {
set p [lindex $currentparents 0]
if {$ncleft($p) == 0 && [lsearch -exact $todo $p] < 0} {
assigncolor $p
- set linestarty($p) [expr $canvy - $linespc]
+ set glines($p) [list $x $y]
set todo [lreplace $todo $level $level $p]
return 0
}
}
proc drawslants {} {
- global canv linestarty canvx0 canvy linespc
+ global canv glines canvx0 canvy linespc
global oldlevel oldtodo todo currentparents
global lthickness linespc canvy colormap
if {$i == $oldlevel} {
foreach p $currentparents {
set j [lsearch -exact $todo $p]
- if {$i == $j && ![info exists linestarty($p)]} {
- set linestarty($p) $y1
+ if {$i == $j && ![info exists glines($p)]} {
+ set glines($p) [list $xi $y1]
} else {
set xj [expr {$canvx0 + $j * $linespc}]
set coords [list $xi $y1]
lappend coords [expr $xj - $linespc] $y1
}
lappend coords $xj $y2
- set t [$canv create line $coords -width $lthickness \
- -fill $colormap($p)]
- $canv lower $t
- if {![info exists linestarty($p)]} {
- set linestarty($p) $y2
+ if {![info exists glines($p)]} {
+ set glines($p) $coords
+ } else {
+ set t [$canv create line $coords -width $lthickness \
+ -fill $colormap($p)]
+ $canv lower $t
+ $canv bind $t <Button-3> "linemenu %X %Y $p"
+ $canv bind $t <Enter> "lineenter %x %y $p"
+ $canv bind $t <Motion> "linemotion %x %y $p"
+ $canv bind $t <Leave> "lineleave $p"
}
}
}
} elseif {[lindex $todo $i] != $id} {
set j [lsearch -exact $todo $id]
set xj [expr {$canvx0 + $j * $linespc}]
- set coords {}
- if {[info exists linestarty($id)] && $linestarty($id) < $y1} {
- lappend coords $xi $linestarty($id)
- }
- lappend coords $xi $y1 $xj $y2
- set t [$canv create line $coords -width $lthickness \
- -fill $colormap($id)]
- $canv lower $t
- set linestarty($id) $y2
+ lappend glines($id) $xi $y1 $xj $y2
}
}
}
}
set phase {}
set drawmsecs [expr [clock clicks -milliseconds] - $startmsecs]
- puts "overall $drawmsecs ms for $numcommits commits"
+ #puts "overall $drawmsecs ms for $numcommits commits"
if {$redisplaying} {
if {$stopped == 0 && [info exists selectedline]} {
selectline $selectedline
global canvy0 linespc nparents treepending
global cflist treediffs currentid sha1entry
global commentend seenfile idtags
+ $canv delete hover
if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
$canv delete secsel
set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
error_popup "$type $sha1string is not known"
}
+proc linemenu {x y id} {
+ global linectxmenu linemenuid
+ set linemenuid $id
+ $linectxmenu post $x $y
+}
+
+proc lineselect {} {
+ global linemenuid idline
+ if {[info exists linemenuid] && [info exists idline($linemenuid)]} {
+ selectline $idline($linemenuid)
+ }
+}
+
+proc lineenter {x y id} {
+ global hoverx hovery hoverid hovertimer
+ global commitinfo canv
+
+ if {![info exists commitinfo($id)]} return
+ set hoverx $x
+ set hovery $y
+ set hoverid $id
+ if {[info exists hovertimer]} {
+ after cancel $hovertimer
+ }
+ set hovertimer [after 500 linehover]
+ $canv delete hover
+}
+
+proc linemotion {x y id} {
+ global hoverx hovery hoverid hovertimer
+
+ if {[info exists hoverid] && $id == $hoverid} {
+ set hoverx $x
+ set hovery $y
+ if {[info exists hovertimer]} {
+ after cancel $hovertimer
+ }
+ set hovertimer [after 500 linehover]
+ }
+}
+
+proc lineleave {id} {
+ global hoverid hovertimer canv
+
+ if {[info exists hoverid] && $id == $hoverid} {
+ $canv delete hover
+ if {[info exists hovertimer]} {
+ after cancel $hovertimer
+ unset hovertimer
+ }
+ unset hoverid
+ }
+}
+
+proc linehover {} {
+ global hoverx hovery hoverid hovertimer
+ global canv linespc lthickness
+ global commitinfo mainfont
+
+ set text [lindex $commitinfo($hoverid) 0]
+ set ymax [lindex [$canv cget -scrollregion] 3]
+ if {$ymax == {}} return
+ set yfrac [lindex [$canv yview] 0]
+ set x [expr {$hoverx + 2 * $linespc}]
+ set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
+ set x0 [expr {$x - 2 * $lthickness}]
+ set y0 [expr {$y - 2 * $lthickness}]
+ set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
+ set y1 [expr {$y + $linespc + 2 * $lthickness}]
+ set t [$canv create rectangle $x0 $y0 $x1 $y1 \
+ -fill \#ffff80 -outline black -width 1 -tags hover]
+ $canv raise $t
+ set t [$canv create text $x $y -anchor nw -text $text -tags hover]
+ $canv raise $t
+}
+
proc doquit {} {
global stopped
set stopped 100