proc start_rev_list {rlargs} {
global startmsecs nextupdate ncmupdate
global commfd leftover tclencoding datemode
+ global commitdata
set startmsecs [clock clicks -milliseconds]
set nextupdate [expr {$startmsecs + 100}]
exit 1
}
set leftover {}
+ set commitdata {}
fconfigure $commfd -blocking 0 -translation lf
if {$tclencoding != {}} {
fconfigure $commfd -encoding $tclencoding
}
proc getcommitlines {commfd} {
- global parents cdate children nchildren
- global commitlisted commitinfo phase nextupdate
- global stopped leftover
- global canv
- global displayorder commitidx commitrow
+ global commitlisted nextupdate
+ global leftover
+ global displayorder commitidx commitrow commitdata
set stuff [read $commfd]
if {$stuff == {}} {
}
set id [lindex $ids 0]
set olds [lrange $ids 1 end]
- set cmit [string range $cmit [expr {$j + 1}] end]
set commitlisted($id) 1
updatechildren $id [lrange $ids 1 end]
- if {![info exists commitinfo($id)]} {
- parsecommit $id $cmit 1
- }
+ lappend commitdata [string range $cmit [expr {$j + 1}] end]
set commitrow($id) $commitidx
incr commitidx
lappend displayorder $id
$comname $comdate $comment]
}
+proc getcommit {id {row {}}} {
+ global commitdata commitrow commitinfo nparents
+
+ if {$row eq {}} {
+ if {![info exists commitrow($id)]} {return 0}
+ set row $commitrow($id)
+ }
+ if {$row < [llength $commitdata]} {
+ parsecommit $id [lindex $commitdata $row] 1
+ } else {
+ readcommit $id
+ if {![info exists commitinfo($id)]} {
+ set commitinfo($id) {"No commit information available"}
+ set nparents($id) 0
+ }
+ }
+ return 1
+}
+
proc readrefs {} {
global tagids idtags headids idheads tagcontents
global otherrefids idotherrefs
incr i
if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
&& ![info exists idrangedrawn($id,$i)]} {
- drawlineseg $id $i 1
+ drawlineseg $id $i
set idrangedrawn($id,$i) 1
}
}
return [expr {$canvy0 + $row * $linespc}]
}
-proc drawlineseg {id i wid} {
+proc linewidth {id} {
+ global thickerline lthickness
+
+ set wid $lthickness
+ if {[info exists thickerline] && $id eq $thickerline} {
+ set wid [expr {2 * $lthickness}]
+ }
+ return $wid
+}
+
+proc drawlineseg {id i} {
global rowoffsets rowidlist idrowranges
- global canv colormap lthickness
+ global canv colormap
set startrow [lindex $idrowranges($id) [expr {2 * $i}]]
set row [lindex $idrowranges($id) [expr {2 * $i + 1}]]
set last [expr {[llength $idrowranges($id)] / 2 - 1}]
set arrow [expr {2 * ($i > 0) + ($i < $last)}]
set arrow [lindex {none first last both} $arrow]
- set wid [expr {$wid * $lthickness}]
set x [xc $row $col]
set y [yc $row]
lappend coords $x $y
- set t [$canv create line $coords -width $wid \
+ set t [$canv create line $coords -width [linewidth $id] \
-fill $colormap($id) -tags lines.$id -arrow $arrow]
$canv lower $t
bindline $t $id
}
-proc drawparentlinks {id row col olds wid} {
- global rowidlist canv colormap lthickness
+proc drawparentlinks {id row col olds} {
+ global rowidlist canv colormap
set row2 [expr {$row + 1}]
set x [xc $row $col]
set ids [lindex $rowidlist $row2]
# rmx = right-most X coord used
set rmx 0
- set wid [expr {$wid * $lthickness}]
foreach p $olds {
set i [lsearch -exact $ids $p]
if {$i < 0} {
set rmx $x2
}
lappend coords $x2 $y2
- set t [$canv create line $coords -width $wid \
+ set t [$canv create line $coords -width [linewidth $p] \
-fill $colormap($p) -tags lines.$p]
$canv lower $t
bindline $t $p
return $rmx
}
-proc drawlines {id xtra} {
+proc drawlines {id} {
global colormap canv
global idrowranges idrangedrawn
global children iddrawn commitrow rowidlist
$canv delete lines.$id
- set wid [expr {$xtra + 1}]
set nr [expr {[llength $idrowranges($id)] / 2}]
for {set i 0} {$i < $nr} {incr i} {
if {[info exists idrangedrawn($id,$i)]} {
- drawlineseg $id $i $wid
+ drawlineseg $id $i
}
}
if {[info exists children($id)]} {
set row $commitrow($child)
set col [lsearch -exact [lindex $rowidlist $row] $child]
if {$col >= 0} {
- drawparentlinks $child $row $col [list $id] $wid
+ drawparentlinks $child $row $col [list $id]
}
}
}
global displayorder rowidlist
global idrowranges idrangedrawn iddrawn
global commitinfo commitlisted parents numcommits
+ global commitdata
if {$row >= $numcommits} return
foreach id [lindex $rowidlist $row] {
if {$e eq {}} break
if {$row <= $e} {
if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
- drawlineseg $id $i 1
+ drawlineseg $id $i
set idrangedrawn($id,$i) 1
}
break
return
}
if {![info exists commitinfo($id)]} {
- readcommit $id
- if {![info exists commitinfo($id)]} {
- set commitinfo($id) {"No commit information available"}
- set nparents($id) 0
- }
+ getcommit $id $row
}
assigncolor $id
if {[info exists commitlisted($id)] && [info exists parents($id)]
&& $parents($id) ne {}} {
- set rmx [drawparentlinks $id $row $col $parents($id) 1]
+ set rmx [drawparentlinks $id $row $col $parents($id)]
} else {
set rmx 0
}
}
proc finishcommits {} {
- global phase
+ global commitidx phase
global canv mainfont ctext maincursor textcursor
- if {$phase == "incrdraw"} {
+ if {$commitidx > 0} {
drawrest
} else {
$canv delete all
$canv create text 3 3 -anchor nw -text "No commits selected" \
-font $mainfont -tags textitems
- set phase {}
}
. config -cursor $maincursor
settextcursor $textcursor
+ set phase {}
}
# Don't change the text pane cursor if it is currently the hand cursor,
}
proc drawrest {} {
- global phase
global numcommits
global startmsecs
global canvy0 numcommits linespc
optimize_rows $row 0 $commitidx
showstuff $commitidx
- set phase {}
set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
#puts "overall $drawmsecs ms for $numcommits commits"
}
global findtype findloc findstring markedmatches commitinfo
global numcommits displayorder linehtag linentag linedtag
global mainfont namefont canv canv2 canv3 selectedline
- global matchinglines foundstring foundstrlen
+ global matchinglines foundstring foundstrlen matchstring
+ global commitdata
stopfindproc
unmarkmatches
}
set foundstrlen [string length $findstring]
if {$foundstrlen == 0} return
+ regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
+ set matchstring "*$matchstring*"
if {$findloc == "Files"} {
findfiles
return
}
set didsel 0
set fldtypes {Headline Author Date Committer CDate Comment}
- for {set l 0} {$l < $numcommits} {incr l} {
+ set l -1
+ foreach d $commitdata {
+ incr l
+ if {$findtype == "Regexp"} {
+ set doesmatch [regexp $foundstring $d]
+ } elseif {$findtype == "IgnCase"} {
+ set doesmatch [string match -nocase $matchstring $d]
+ } else {
+ set doesmatch [string match $matchstring $d]
+ }
+ if {!$doesmatch} continue
set id [lindex $displayorder $l]
+ if {![info exists commitinfo($id)]} {
+ getcommit $id $l
+ }
set info $commitinfo($id)
set doesmatch 0
foreach f $info ty $fldtypes {
# mark a commit as matching by putting a yellow background
# behind the headline
proc markheadline {l id} {
- global canv mainfont linehtag commitinfo
+ global canv mainfont linehtag
drawcmitrow $l
set bbox [$canv bbox $linehtag($l)]
set id [string tolower $sha1string]
if {[regexp {^[0-9a-f]{4,39}$} $id]} {
set matches {}
- for {set l 0} {$l < $numcommits} {incr l} {
- if {[string match $id* [lindex $displayorder $l]]} {
- lappend matches [lindex $displayorder $l]
+ foreach i $displayorder {
+ if {[string match $id* $i]} {
+ lappend matches $i
}
}
if {$matches ne {}} {
global hoverx hovery hoverid hovertimer
global commitinfo canv
- if {![info exists commitinfo($id)]} return
+ if {![info exists commitinfo($id)] && ![getcommit $id]} return
set hoverx $x
set hovery $y
set hoverid $id
proc lineclick {x y id isnew} {
global ctext commitinfo children cflist canv thickerline
+ if {![info exists commitinfo($id)] && ![getcommit $id]} return
unmarkmatches
unselectline
normalline
$canv delete hover
# draw this line thicker than normal
- drawlines $id 1
set thickerline $id
+ drawlines $id
if {$isnew} {
set ymax [lindex [$canv cget -scrollregion] 3]
if {$ymax eq {}} return
set i 0
foreach child $children($id) {
incr i
+ 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]
proc normalline {} {
global thickerline
if {[info exists thickerline]} {
- drawlines $thickerline 0
+ set id $thickerline
unset thickerline
+ drawlines $id
}
}