Browse Source

Draw graph lines as one continuous line where possible

Added context menu on lines
Added headline display when the mouse hovers over a line
Removed some debug messages
maint
Paul Mackerras 20 years ago
parent
commit
84ba734580
  1. 152
      gitk

152
gitk

@ -7,12 +7,12 @@ exec wish "$0" -- "${1+$@}"
# and distributed under the terms of the GNU General Public Licence, # and distributed under the terms of the GNU General Public Licence,
# either version 2, or (at your option) any later version. # either version 2, or (at your option) any later version.


# CVS $Revision: 1.23 $ # CVS $Revision: 1.24 $


proc getcommits {rargs} { proc getcommits {rargs} {
global commits commfd phase canv mainfont global commits commfd phase canv mainfont
global startmsecs nextupdate global startmsecs nextupdate
global ctext maincursor textcursor global ctext maincursor textcursor nlines


if {$rargs == {}} { if {$rargs == {}} {
set rargs HEAD set rargs HEAD
@ -25,6 +25,7 @@ proc getcommits {rargs} {
puts stderr "Error executing git-rev-list: $err" puts stderr "Error executing git-rev-list: $err"
exit 1 exit 1
} }
set nlines 0
fconfigure $commfd -blocking 0 fconfigure $commfd -blocking 0
fileevent $commfd readable "getcommitline $commfd" fileevent $commfd readable "getcommitline $commfd"
$canv delete all $canv delete all
@ -37,7 +38,7 @@ proc getcommits {rargs} {
proc getcommitline {commfd} { proc getcommitline {commfd} {
global commits parents cdate children nchildren ncleft global commits parents cdate children nchildren ncleft
global commitlisted phase commitinfo nextupdate global commitlisted phase commitinfo nextupdate
global stopped redisplaying global stopped redisplaying nlines


set n [gets $commfd line] set n [gets $commfd line]
if {$n < 0} { if {$n < 0} {
@ -59,6 +60,7 @@ to allow selection of commits to be displayed.)}
error_popup $err error_popup $err
exit 1 exit 1
} }
incr nlines
if {![regexp {^[0-9a-f]{40}$} $line id]} { if {![regexp {^[0-9a-f]{40}$} $line id]} {
error_popup "Can't parse git-rev-list output: {$line}" error_popup "Can't parse git-rev-list output: {$line}"
exit 1 exit 1
@ -242,6 +244,7 @@ proc makewindow {} {
global findtype findloc findstring fstring geometry global findtype findloc findstring fstring geometry
global entries sha1entry sha1string sha1but global entries sha1entry sha1string sha1but
global maincursor textcursor global maincursor textcursor
global linectxmenu


menu .bar menu .bar
.bar add cascade -label "File" -menu .bar.file .bar add cascade -label "File" -menu .bar.file
@ -384,6 +387,10 @@ proc makewindow {} {


set maincursor [. cget -cursor] set maincursor [. cget -cursor]
set textcursor [$ctext 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 # when we make a key binding for the toplevel, make sure
@ -519,7 +526,7 @@ Copyright


Use and redistribute under the terms of the GNU General Public License Use and redistribute under the terms of the GNU General Public License


(CVS $Revision: 1.23 $)} \ (CVS $Revision: 1.24 $)} \
-justify center -aspect 400 -justify center -aspect 400
pack $w.m -side top -fill x -padx 20 -pady 20 pack $w.m -side top -fill x -padx 20 -pady 20
button $w.ok -text Close -command "destroy $w" button $w.ok -text Close -command "destroy $w"
@ -569,7 +576,7 @@ proc assigncolor {id} {


proc initgraph {} { proc initgraph {} {
global canvy canvy0 lineno numcommits lthickness nextcolor linespc global canvy canvy0 lineno numcommits lthickness nextcolor linespc
global linestarty global glines
global nchildren ncleft global nchildren ncleft


allcanvs delete all allcanvs delete all
@ -578,7 +585,7 @@ proc initgraph {} {
set lineno -1 set lineno -1
set numcommits 0 set numcommits 0
set lthickness [expr {int($linespc / 9) + 1}] set lthickness [expr {int($linespc / 9) + 1}]
catch {unset linestarty} catch {unset glines}
foreach id [array names nchildren] { foreach id [array names nchildren] {
set ncleft($id) $nchildren($id) set ncleft($id) $nchildren($id)
} }
@ -592,7 +599,7 @@ proc drawcommitline {level} {
global colormap numcommits currentparents global colormap numcommits currentparents
global oldlevel oldnlines oldtodo global oldlevel oldnlines oldtodo
global idtags idline idheads global idtags idline idheads
global lineno lthickness linestarty global lineno lthickness glines
global commitlisted global commitlisted


incr numcommits incr numcommits
@ -617,10 +624,15 @@ proc drawcommitline {level} {
set canvy [expr $canvy + $linespc] set canvy [expr $canvy + $linespc]
allcanvs conf -scrollregion \ allcanvs conf -scrollregion \
[list 0 0 0 [expr $y1 + 0.5 * $linespc + 2]] [list 0 0 0 [expr $y1 + 0.5 * $linespc + 2]]
if {[info exists linestarty($id)] && $linestarty($id) < $y1} { if {[info exists glines($id)]} {
set t [$canv create line $x $linestarty($id) $x $y1 \ lappend glines($id) $x $y1
set t [$canv create line $glines($id) \
-width $lthickness -fill $colormap($id)] -width $lthickness -fill $colormap($id)]
$canv lower $t $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 orad [expr {$linespc / 3}]
set t [$canv create oval [expr $x - $orad] [expr $y1 - $orad] \ set t [$canv create oval [expr $x - $orad] [expr $y1 - $orad] \
@ -655,6 +667,10 @@ proc drawcommitline {level} {
set t [$canv create line $x $y1 [lindex $xvals end] $y1 \ set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
-width $lthickness -fill black] -width $lthickness -fill black]
$canv lower $t $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 { foreach tag $marks x $xvals wid $wvals {
set xl [expr $x + $delta] set xl [expr $x + $delta]
set xr [expr $x + $delta + $wid + $lthickness] set xr [expr $x + $delta + $wid + $lthickness]
@ -686,8 +702,8 @@ proc drawcommitline {level} {


proc updatetodo {level noshortcut} { proc updatetodo {level noshortcut} {
global datemode currentparents ncleft todo global datemode currentparents ncleft todo
global linestarty oldlevel oldtodo oldnlines global glines oldlevel oldtodo oldnlines
global canvy linespc global canvx0 canvy linespc glines
global commitinfo global commitinfo


foreach p $currentparents { foreach p $currentparents {
@ -695,11 +711,13 @@ proc updatetodo {level noshortcut} {
readcommit $p readcommit $p
} }
} }
set x [expr $canvx0 + $level * $linespc]
set y [expr $canvy - $linespc]
if {!$noshortcut && [llength $currentparents] == 1} { if {!$noshortcut && [llength $currentparents] == 1} {
set p [lindex $currentparents 0] set p [lindex $currentparents 0]
if {$ncleft($p) == 0 && [lsearch -exact $todo $p] < 0} { if {$ncleft($p) == 0 && [lsearch -exact $todo $p] < 0} {
assigncolor $p assigncolor $p
set linestarty($p) [expr $canvy - $linespc] set glines($p) [list $x $y]
set todo [lreplace $todo $level $level $p] set todo [lreplace $todo $level $level $p]
return 0 return 0
} }
@ -723,7 +741,7 @@ proc updatetodo {level noshortcut} {
} }


proc drawslants {} { proc drawslants {} {
global canv linestarty canvx0 canvy linespc global canv glines canvx0 canvy linespc
global oldlevel oldtodo todo currentparents global oldlevel oldtodo todo currentparents
global lthickness linespc canvy colormap global lthickness linespc canvy colormap


@ -737,8 +755,8 @@ proc drawslants {} {
if {$i == $oldlevel} { if {$i == $oldlevel} {
foreach p $currentparents { foreach p $currentparents {
set j [lsearch -exact $todo $p] set j [lsearch -exact $todo $p]
if {$i == $j && ![info exists linestarty($p)]} { if {$i == $j && ![info exists glines($p)]} {
set linestarty($p) $y1 set glines($p) [list $xi $y1]
} else { } else {
set xj [expr {$canvx0 + $j * $linespc}] set xj [expr {$canvx0 + $j * $linespc}]
set coords [list $xi $y1] set coords [list $xi $y1]
@ -748,26 +766,23 @@ proc drawslants {} {
lappend coords [expr $xj - $linespc] $y1 lappend coords [expr $xj - $linespc] $y1
} }
lappend coords $xj $y2 lappend coords $xj $y2
set t [$canv create line $coords -width $lthickness \ if {![info exists glines($p)]} {
-fill $colormap($p)] set glines($p) $coords
$canv lower $t } else {
if {![info exists linestarty($p)]} { set t [$canv create line $coords -width $lthickness \
set linestarty($p) $y2 -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} { } elseif {[lindex $todo $i] != $id} {
set j [lsearch -exact $todo $id] set j [lsearch -exact $todo $id]
set xj [expr {$canvx0 + $j * $linespc}] set xj [expr {$canvx0 + $j * $linespc}]
set coords {} lappend glines($id) $xi $y1 $xj $y2
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
} }
} }
} }
@ -946,7 +961,7 @@ proc drawrest {level startix} {
} }
set phase {} set phase {}
set drawmsecs [expr [clock clicks -milliseconds] - $startmsecs] set drawmsecs [expr [clock clicks -milliseconds] - $startmsecs]
puts "overall $drawmsecs ms for $numcommits commits" #puts "overall $drawmsecs ms for $numcommits commits"
if {$redisplaying} { if {$redisplaying} {
if {$stopped == 0 && [info exists selectedline]} { if {$stopped == 0 && [info exists selectedline]} {
selectline $selectedline selectline $selectedline
@ -1131,6 +1146,7 @@ proc selectline {l} {
global canvy0 linespc nparents treepending global canvy0 linespc nparents treepending
global cflist treediffs currentid sha1entry global cflist treediffs currentid sha1entry
global commentend seenfile idtags global commentend seenfile idtags
$canv delete hover
if {![info exists lineid($l)] || ![info exists linehtag($l)]} return if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
$canv delete secsel $canv delete secsel
set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \ set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
@ -1481,6 +1497,82 @@ proc gotocommit {} {
error_popup "$type $sha1string is not known" 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 {} { proc doquit {} {
global stopped global stopped
set stopped 100 set stopped 100

Loading…
Cancel
Save