}
proc parse_args {rargs} {
- global parsed_args
+ global parsed_args cmdline_files
+ set parsed_args {}
+ set cmdline_files {}
if {[catch {
- set parse_args [concat --default HEAD $rargs]
- set parsed_args [split [eval exec git-rev-parse $parse_args] "\n"]
+ set args [concat --default HEAD $rargs]
+ set args [split [eval exec git-rev-parse $args] "\n"]
+ set i 0
+ foreach arg $args {
+ if {![regexp {^[0-9a-f]{40}$} $arg]} {
+ if {$arg eq "--"} {
+ incr i
+ }
+ set cmdline_files [lrange $args $i end]
+ break
+ }
+ lappend parsed_args $arg
+ incr i
+ }
}]} {
# if git-rev-parse failed for some reason...
+ set i [lsearch -exact $rargs "--"]
+ if {$i >= 0} {
+ set cmdline_files [lrange $rargs [expr {$i+1}] end]
+ set rargs [lrange $rargs 0 [expr {$i-1}]]
+ }
if {$rargs == {}} {
- set rargs HEAD
+ set parsed_args HEAD
+ } else {
+ set parsed_args $rargs
}
- set parsed_args $rargs
}
- return $parsed_args
}
proc start_rev_list {rlargs} {
set startmsecs [clock clicks -milliseconds]
set nextupdate [expr {$startmsecs + 100}]
set ncmupdate 1
+ initlayout
set order "--topo-order"
if {$datemode} {
set order "--date-order"
}
if {[catch {
set commfd [open [concat | git-rev-list --header $order \
- --parents $rlargs] r]
+ --parents --boundary $rlargs] r]
} err]} {
puts stderr "Error executing git-rev-list: $err"
exit 1
global phase canv mainfont
set phase getcommits
- start_rev_list [parse_args $rargs]
+ start_rev_list $rargs
$canv delete all
$canv create text 3 3 -anchor nw -text "Reading commits..." \
-font $mainfont -tags textitems
}
proc getcommitlines {commfd} {
- global parents cdate children nchildren
global commitlisted nextupdate
- global stopped leftover
- global canv
+ global leftover
+ global displayorder commitidx commitrow commitdata
+ global parentlist childlist children
set stuff [read $commfd]
if {$stuff == {}} {
exit 1
}
set start 0
+ set gotsome 0
while 1 {
set i [string first "\0" $stuff $start]
if {$i < 0} {
append leftover [string range $stuff $start end]
break
}
- set cmit [string range $stuff $start [expr {$i - 1}]]
if {$start == 0} {
- set cmit "$leftover$cmit"
+ set cmit $leftover
+ append cmit [string range $stuff 0 [expr {$i - 1}]]
set leftover {}
+ } else {
+ set cmit [string range $stuff $start [expr {$i - 1}]]
}
set start [expr {$i + 1}]
set j [string first "\n" $cmit]
set ok 0
+ set listed 1
if {$j >= 0} {
set ids [string range $cmit 0 [expr {$j - 1}]]
+ if {[string range $ids 0 0] == "-"} {
+ set listed 0
+ set ids [string range $ids 1 end]
+ }
set ok 1
foreach id $ids {
- if {![regexp {^[0-9a-f]{40}$} $id]} {
+ if {[string length $id] != 40} {
set ok 0
break
}
exit 1
}
set id [lindex $ids 0]
- set olds [lrange $ids 1 end]
- set cmit [string range $cmit [expr {$j + 1}] end]
- set commitlisted($id) 1
- parsecommit $id $cmit 1 [lrange $ids 1 end]
- drawcommit $id 1
+ if {$listed} {
+ set olds [lrange $ids 1 end]
+ set i 0
+ foreach p $olds {
+ if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
+ lappend children($p) $id
+ }
+ incr i
+ }
+ } else {
+ set olds {}
+ }
+ lappend parentlist $olds
+ if {[info exists children($id)]} {
+ lappend childlist $children($id)
+ } else {
+ lappend childlist {}
+ }
+ set commitdata($id) [string range $cmit [expr {$j + 1}] end]
+ set commitrow($id) $commitidx
+ incr commitidx
+ lappend displayorder $id
+ lappend commitlisted $listed
+ set gotsome 1
+ }
+ if {$gotsome} {
+ layoutmore
}
- layoutmore
if {[clock clicks -milliseconds] >= $nextupdate} {
doupdate 1
}
proc readcommit {id} {
if {[catch {set contents [exec git-cat-file commit $id]}]} return
- parsecommit $id $contents 0 {}
+ parsecommit $id $contents 0
}
-proc updatecommits {rargs} {
- stopfindproc
- foreach v {children nchildren parents nparents commitlisted
- commitinfo colormap selectedline matchinglines treediffs
- mergefilelist currentid rowtextx commitrow lineid
- rowidlist rowoffsets idrowranges idrangedrawn iddrawn
- linesegends crossings cornercrossings} {
- global $v
- catch {unset $v}
- }
- allcanvs delete all
- readrefs
- getcommits $rargs
-}
-
-proc updatechildren {id olds} {
- global children nchildren parents nparents
+proc updatecommits {} {
+ global viewdata curview revtreeargs
- if {![info exists nchildren($id)]} {
- set children($id) {}
- set nchildren($id) 0
- }
- set parents($id) $olds
- set nparents($id) [llength $olds]
- foreach p $olds {
- if {![info exists nchildren($p)]} {
- set children($p) [list $id]
- set nchildren($p) 1
- } elseif {[lsearch -exact $children($p) $id] < 0} {
- lappend children($p) $id
- incr nchildren($p)
- }
- }
+ set n $curview
+ set curview -1
+ catch {unset viewdata($n)}
+ parse_args $revtreeargs
+ showview $n
}
-proc parsecommit {id contents listed olds} {
+proc parsecommit {id contents listed} {
global commitinfo cdate
set inhdr 1
set audate {}
set comname {}
set comdate {}
- updatechildren $id $olds
set hdrend [string first "\n\n" $contents]
if {$hdrend < 0} {
# should never happen...
$comname $comdate $comment]
}
+proc getcommit {id} {
+ global commitdata commitinfo
+
+ if {[info exists commitdata($id)]} {
+ parsecommit $id $commitdata($id) 1
+ } else {
+ readcommit $id
+ if {![info exists commitinfo($id)]} {
+ set commitinfo($id) {"No commit information available"}
+ }
+ }
+ return 1
+}
+
proc readrefs {} {
global tagids idtags headids idheads tagcontents
global otherrefids idotherrefs
button $w.ok -text OK -command "destroy $w"
pack $w.ok -side bottom -fill x
bind $w <Visibility> "grab $w; focus $w"
+ bind $w <Key-Return> "destroy $w"
tkwait window $w
}
-proc makewindow {rargs} {
+proc makewindow {} {
global canv canv2 canv3 linespc charspc ctext cflist textfont
global findtype findtypemenu findloc findstring fstring geometry
global entries sha1entry sha1string sha1but
menu .bar
.bar add cascade -label "File" -menu .bar.file
menu .bar.file
- .bar.file add command -label "Update" -command [list updatecommits $rargs]
+ .bar.file add command -label "Update" -command updatecommits
.bar.file add command -label "Reread references" -command rereadrefs
.bar.file add command -label "Quit" -command doquit
menu .bar.edit
.bar add cascade -label "Edit" -menu .bar.edit
.bar.edit add command -label "Preferences" -command doprefs
+ menu .bar.view
+ .bar add cascade -label "View" -menu .bar.view
+ .bar.view add command -label "New view..." -command newview
+ .bar.view add command -label "Delete view" -command delview -state disabled
+ .bar.view add separator
+ .bar.view add command -label "All files" -command {showview 0}
menu .bar.help
.bar add cascade -label "Help" -menu .bar.help
.bar.help add command -label "About gitk" -command about
#bindall <B1-Motion> {selcanvline %W %x %y}
bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
- bindall <2> "allcanvs scan mark 0 %y"
- bindall <B2-Motion> "allcanvs scan dragto 0 %y"
+ bindall <2> "canvscan mark %W %x %y"
+ bindall <B2-Motion> "canvscan dragto %W %x %y"
bind . <Key-Up> "selnextline -1"
bind . <Key-Down> "selnextline 1"
bind . <Key-Right> "goforw"
$rowctxmenu add command -label "Write commit to file" -command writecommit
}
+# mouse-2 makes all windows scan vertically, but only the one
+# the cursor is in scans horizontally
+proc canvscan {op w x y} {
+ global canv canv2 canv3
+ foreach c [list $canv $canv2 $canv3] {
+ if {$c == $w} {
+ $c scan $op $x $y
+ } else {
+ $c scan $op 0 $y
+ }
+ }
+}
+
proc scrollcanv {cscroll f0 f1} {
$cscroll set $f0 $f1
drawfrac $f0 $f1
pack $w.ok -side bottom
}
+proc newview {} {
+ global newviewname nextviewnum newviewtop
+
+ set top .gitkview
+ if {[winfo exists $top]} {
+ raise $top
+ return
+ }
+ set newviewtop $top
+ toplevel $top
+ wm title $top "Gitk view definition"
+ label $top.nl -text "Name"
+ entry $top.name -width 20 -textvariable newviewname
+ set newviewname "View $nextviewnum"
+ grid $top.nl $top.name -sticky w
+ label $top.l -text "Files and directories to include:"
+ grid $top.l - -sticky w -pady 10
+ text $top.t -width 30 -height 10
+ grid $top.t - -sticky w
+ frame $top.buts
+ button $top.buts.ok -text "OK" -command newviewok
+ button $top.buts.can -text "Cancel" -command newviewcan
+ grid $top.buts.ok $top.buts.can
+ grid columnconfigure $top.buts 0 -weight 1 -uniform a
+ grid columnconfigure $top.buts 1 -weight 1 -uniform a
+ grid $top.buts - -pady 10 -sticky ew
+ focus $top.t
+}
+
+proc newviewok {} {
+ global newviewtop nextviewnum
+ global viewname viewfiles
+
+ set n $nextviewnum
+ incr nextviewnum
+ set viewname($n) [$newviewtop.name get]
+ set files {}
+ foreach f [split [$newviewtop.t get 0.0 end] "\n"] {
+ set ft [string trim $f]
+ if {$ft ne {}} {
+ lappend files $ft
+ }
+ }
+ set viewfiles($n) $files
+ catch {destroy $newviewtop}
+ unset newviewtop
+ .bar.view add command -label $viewname($n) -command [list showview $n]
+ after idle showview $n
+}
+
+proc newviewcan {} {
+ global newviewtop
+
+ catch {destroy $newviewtop}
+ unset newviewtop
+}
+
+proc delview {} {
+ global curview viewdata
+
+ if {$curview == 0} return
+ set nmenu [.bar.view index end]
+ set targetcmd [list showview $curview]
+ for {set i 5} {$i <= $nmenu} {incr i} {
+ if {[.bar.view entrycget $i -command] eq $targetcmd} {
+ .bar.view delete $i
+ break
+ }
+ }
+ set viewdata($curview) {}
+ showview 0
+}
+
+proc showview {n} {
+ global curview viewdata viewfiles
+ global displayorder parentlist childlist rowidlist rowoffsets
+ global colormap rowtextx commitrow
+ global numcommits rowrangelist commitlisted idrowranges
+ global selectedline currentid canv canvy0
+ global matchinglines treediffs
+ global parsed_args
+ global pending_select phase
+
+ if {$n == $curview} return
+ set selid {}
+ if {[info exists selectedline]} {
+ set selid $currentid
+ set y [yc $selectedline]
+ set ymax [lindex [$canv cget -scrollregion] 3]
+ set span [$canv yview]
+ set ytop [expr {[lindex $span 0] * $ymax}]
+ set ybot [expr {[lindex $span 1] * $ymax}]
+ if {$ytop < $y && $y < $ybot} {
+ set yscreen [expr {$y - $ytop}]
+ } else {
+ set yscreen [expr {($ybot - $ytop) / 2}]
+ }
+ }
+ unselectline
+ stopfindproc
+ if {$curview >= 0 && $phase eq {} && ![info exists viewdata($curview)]} {
+ set viewdata($curview) \
+ [list $displayorder $parentlist $childlist $rowidlist \
+ $rowoffsets $rowrangelist $commitlisted]
+ }
+ catch {unset matchinglines}
+ catch {unset treediffs}
+ clear_display
+ readrefs
+
+ set curview $n
+ .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
+
+ if {![info exists viewdata($n)]} {
+ set args $parsed_args
+ if {$viewfiles($n) ne {}} {
+ set args [concat $args "--" $viewfiles($n)]
+ }
+ set pending_select $selid
+ getcommits $args
+ return
+ }
+
+ set displayorder [lindex $viewdata($n) 0]
+ set parentlist [lindex $viewdata($n) 1]
+ set childlist [lindex $viewdata($n) 2]
+ set rowidlist [lindex $viewdata($n) 3]
+ set rowoffsets [lindex $viewdata($n) 4]
+ set rowrangelist [lindex $viewdata($n) 5]
+ set commitlisted [lindex $viewdata($n) 6]
+ set numcommits [llength $displayorder]
+ catch {unset colormap}
+ catch {unset rowtextx}
+ catch {unset commitrow}
+ catch {unset idrowranges}
+ set curview $n
+ set row 0
+ foreach id $displayorder {
+ set commitrow($id) $row
+ incr row
+ }
+ setcanvscroll
+ set yf 0
+ set row 0
+ if {$selid ne {} && [info exists commitrow($selid)]} {
+ set row $commitrow($selid)
+ # try to get the selected row in the same position on the screen
+ set ymax [lindex [$canv cget -scrollregion] 3]
+ set ytop [expr {[yc $row] - $yscreen}]
+ if {$ytop < 0} {
+ set ytop 0
+ }
+ set yf [expr {$ytop * 1.0 / $ymax}]
+ }
+ allcanvs yview moveto $yf
+ drawvisible
+ selectline $row 0
+}
+
proc shortids {ids} {
set res {}
foreach id $ids {
global rowidlist rowoffsets
set col -1
- set ids $rowidlist($row)
+ 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 $rowidlist($row)]}"
+ puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
}
- set o [lindex $rowoffsets($row) $col]
+ 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} {
+ 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 $rowidlist($i)]} offs={$rowoffsets($i)}"
+ puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
}
break
}
if {!$full} break
- set o [lindex $rowoffsets($y) $x]
+ set o [lindex $rowoffsets $y $x]
}
}
}
for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
incr y -1
incr x $z
- set off0 $rowoffsets($y)
+ set off0 [lindex $rowoffsets $y]
for {set x0 $x} {1} {incr x0} {
if {$x0 >= [llength $off0]} {
- set x0 [llength $rowoffsets([expr {$y-1}])]
+ set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
break
}
set z [lindex $off0 $x0]
}
}
set z [expr {$x0 - $x}]
- set rowidlist($y) [linsert $rowidlist($y) $x $oid]
- set rowoffsets($y) [linsert $rowoffsets($y) $x $z]
+ lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
+ lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
}
- set tmp [lreplace $rowoffsets($y) $x $x {}]
- set rowoffsets($y) [incrange $tmp [expr {$x+1}] -1]
+ set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
+ lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
lappend idrowranges($oid) $y
}
proc initlayout {} {
- global rowidlist rowoffsets displayorder
+ global rowidlist rowoffsets displayorder commitlisted
global rowlaidout rowoptim
- global idinlist rowchk
-
- set rowidlist(0) {}
- set rowoffsets(0) {}
+ global idinlist rowchk rowrangelist idrowranges
+ global commitidx numcommits canvxmax canv
+ global nextcolor
+ global parentlist childlist children
+ global colormap rowtextx commitrow
+ global linesegends
+
+ set commitidx 0
+ set numcommits 0
+ set displayorder {}
+ set commitlisted {}
+ set parentlist {}
+ set childlist {}
+ set rowrangelist {}
+ catch {unset children}
+ set nextcolor 0
+ set rowidlist {{}}
+ set rowoffsets {{}}
catch {unset idinlist}
catch {unset rowchk}
set rowlaidout 0
set rowoptim 0
+ set canvxmax [$canv cget -width]
+ catch {unset colormap}
+ catch {unset rowtextx}
+ catch {unset commitrow}
+ catch {unset idrowranges}
+ catch {unset linesegends}
+}
+
+proc setcanvscroll {} {
+ global canv canv2 canv3 numcommits linespc canvxmax canvy0
+
+ set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
+ $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
+ $canv2 conf -scrollregion [list 0 0 0 $ymax]
+ $canv3 conf -scrollregion [list 0 0 0 $ymax]
}
proc visiblerows {} {
set rowlaidout [layoutrows $row $commitidx 0]
set orow [expr {$rowlaidout - $uparrowlen - 1}]
if {$orow > $rowoptim} {
- checkcrossings $rowoptim $orow
optimize_rows $rowoptim 0 $orow
set rowoptim $orow
}
}
proc showstuff {canshow} {
- global numcommits
- global canvy0 linespc
+ global numcommits commitrow pending_select
global linesegends idrowranges idrangedrawn
+ if {$numcommits == 0} {
+ global phase
+ set phase "incrdraw"
+ allcanvs delete all
+ }
set row $numcommits
set numcommits $canshow
- allcanvs conf -scrollregion \
- [list 0 0 0 [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]]
+ setcanvscroll
set rows [visiblerows]
set r0 [lindex $rows 0]
set r1 [lindex $rows 1]
+ set selrow -1
for {set r $row} {$r < $canshow} {incr r} {
if {[info exists linesegends($r)]} {
foreach id $linesegends($r) {
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
}
}
drawcmitrow $row
incr row
}
+ if {[info exists pending_select] &&
+ [info exists commitrow($pending_select)] &&
+ $commitrow($pending_select) < $numcommits} {
+ selectline $commitrow($pending_select) 1
+ }
}
proc layoutrows {row endrow last} {
global rowidlist rowoffsets displayorder
global uparrowlen downarrowlen maxwidth mingaplen
- global nchildren parents nparents
+ global childlist parentlist
global idrowranges linesegends
global commitidx
- global idinlist rowchk
+ global idinlist rowchk rowrangelist
- set idlist $rowidlist($row)
- set offs $rowoffsets($row)
+ set idlist [lindex $rowidlist $row]
+ set offs [lindex $rowoffsets $row]
while {$row < $endrow} {
set id [lindex $displayorder $row]
set oldolds {}
set newolds {}
- foreach p $parents($id) {
+ foreach p [lindex $parentlist $row] {
if {![info exists idinlist($p)]} {
lappend newolds $p
} elseif {!$idinlist($p)} {
set offs [lreplace $offs $x $x]
set offs [incrange $offs $x 1]
set idinlist($i) 0
- lappend linesegends($row) $i
- lappend idrowranges($i) [expr {$row-1}]
+ set rm1 [expr {$row - 1}]
+ lappend linesegends($rm1) $i
+ lappend idrowranges($i) $rm1
if {[incr nev -1] <= 0} break
continue
}
set rowchk($id) [expr {$row + $r}]
}
}
- set rowidlist($row) $idlist
- set rowoffsets($row) $offs
+ lset rowidlist $row $idlist
+ lset rowoffsets $row $offs
}
set col [lsearch -exact $idlist $id]
if {$col < 0} {
set col [llength $idlist]
lappend idlist $id
- set rowidlist($row) $idlist
+ lset rowidlist $row $idlist
set z {}
- if {$nchildren($id) > 0} {
- set z [expr {[llength $rowidlist([expr {$row-1}])] - $col}]
+ if {[lindex $childlist $row] ne {}} {
+ set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
unset idinlist($id)
}
lappend offs $z
- set rowoffsets($row) $offs
+ lset rowoffsets $row $offs
if {$z ne {}} {
makeuparrow $id $col $row $z
}
} else {
unset idinlist($id)
}
+ set ranges {}
if {[info exists idrowranges($id)]} {
- lappend linesegends($row) $id
lappend idrowranges($id) $row
+ set ranges $idrowranges($id)
}
+ lappend rowrangelist $ranges
incr row
set offs [ntimes [llength $idlist] 0]
set l [llength $newolds]
makeuparrow $oid $col $row $o
incr col
}
- set rowidlist($row) $idlist
- set rowoffsets($row) $offs
+ lappend rowidlist $idlist
+ lappend rowoffsets $offs
}
return $row
}
proc addextraid {id row} {
- global displayorder commitrow lineid commitinfo nparents
+ global displayorder commitrow commitinfo
global commitidx
+ global parentlist childlist children
incr commitidx
lappend displayorder $id
+ lappend parentlist {}
set commitrow($id) $row
- set lineid($row) $id
readcommit $id
if {![info exists commitinfo($id)]} {
set commitinfo($id) {"No commit information available"}
- set nparents($id) 0
+ }
+ if {[info exists children($id)]} {
+ lappend childlist $children($id)
+ } else {
+ lappend childlist {}
}
}
proc layouttail {} {
global rowidlist rowoffsets idinlist commitidx
- global idrowranges linesegends
+ global idrowranges rowrangelist
set row $commitidx
- set idlist $rowidlist($row)
+ 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 linesegends($row) $id
lappend idrowranges($id) $row
+ lappend rowrangelist $idrowranges($id)
incr row
set offs [ntimes $col 0]
set idlist [lreplace $idlist $col $col]
- set rowidlist($row) $idlist
- set rowoffsets($row) $offs
+ lappend rowidlist $idlist
+ lappend rowoffsets $offs
}
foreach id [array names idinlist] {
addextraid $id $row
- set rowidlist($row) [list $id]
- set rowoffsets($row) 0
+ lset rowidlist $row [list $id]
+ lset rowoffsets $row 0
makeuparrow $id 0 $row 0
- lappend linesegends($row) $id
lappend idrowranges($id) $row
+ lappend rowrangelist $idrowranges($id)
incr row
+ lappend rowidlist {}
+ lappend rowoffsets {}
}
}
global rowidlist rowoffsets
set pad [ntimes $npad {}]
- set rowidlist($row) [eval linsert \$rowidlist($row) $col $pad]
- set tmp [eval linsert \$rowoffsets($row) $col $pad]
- set rowoffsets($row) [incrange $tmp [expr {$col + $npad}] [expr {-$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}]]
}
proc optimize_rows {row col endrow} {
- global rowidlist rowoffsets idrowranges
+ global rowidlist rowoffsets idrowranges displayorder
for {} {$row < $endrow} {incr row} {
- set idlist $rowidlist($row)
- set offs $rowoffsets($row)
+ set idlist [lindex $rowidlist $row]
+ set offs [lindex $rowoffsets $row]
set haspad 0
for {} {$col < [llength $offs]} {incr col} {
if {[lindex $idlist $col] eq {}} {
set isarrow 0
set x0 [expr {$col + $z}]
set y0 [expr {$row - 1}]
- set z0 [lindex $rowoffsets($y0) $x0]
+ set z0 [lindex $rowoffsets $y0 $x0]
if {$z0 eq {}} {
set id [lindex $idlist $col]
if {[info exists idrowranges($id)] &&
}
set z [lindex $offs $col]
set x0 [expr {$col + $z}]
- set z0 [lindex $rowoffsets($y0) $x0]
+ set z0 [lindex $rowoffsets $y0 $x0]
} elseif {$z > 1 || ($z > 0 && $isarrow)} {
set npad [expr {$z - 1 + $isarrow}]
set y1 [expr {$row + 1}]
- set offs2 $rowoffsets($y1)
+ set offs2 [lindex $rowoffsets $y1]
set x1 -1
foreach z $offs2 {
incr x1
if {$x1 + $z > $col} {
incr npad
}
- set rowoffsets($y1) [incrange $offs2 $x1 $npad]
+ lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
break
}
set pad [ntimes $npad {}]
set z [lindex $offs $col]
set haspad 1
}
+ if {$z0 eq {} && !$isarrow} {
+ # 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]
+ if {$xc >= 0} {
+ set z0 [expr {$xc - $x0}]
+ }
+ }
if {$z0 ne {} && $z < 0 && $z0 > 0} {
insert_pad $y0 $x0 1
set offs [incrange $offs $col 1]
}
}
if {!$haspad} {
+ set o {}
for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
set o [lindex $offs $col]
+ if {$o eq {}} {
+ # check if this is the link to the first child
+ set id [lindex $idlist $col]
+ if {[info exists idrowranges($id)] &&
+ $row == [lindex $idrowranges($id) 0]} {
+ # 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}]
+ }
+ }
+ }
if {$o eq {} || $o <= 0} break
}
- if {[incr col] < [llength $idlist]} {
+ if {$o ne {} && [incr col] < [llength $idlist]} {
set y1 [expr {$row + 1}]
- set offs2 $rowoffsets($y1)
+ set offs2 [lindex $rowoffsets $y1]
set x1 -1
foreach z $offs2 {
incr x1
if {$z eq {} || $x1 + $z < $col} continue
- set rowoffsets($y1) [incrange $offs2 $x1 1]
+ lset rowoffsets $y1 [incrange $offs2 $x1 1]
break
}
set idlist [linsert $idlist $col {}]
set offs [incrange $tmp $col -1]
}
}
- set rowidlist($row) $idlist
- set rowoffsets($row) $offs
+ lset rowidlist $row $idlist
+ lset rowoffsets $row $offs
set col 0
}
}
return [expr {$canvy0 + $row * $linespc}]
}
-proc drawlineseg {id i wid} {
- global rowoffsets rowidlist idrowranges
- global canv colormap lthickness
+proc linewidth {id} {
+ global thickerline lthickness
+
+ set wid $lthickness
+ if {[info exists thickerline] && $id eq $thickerline} {
+ set wid [expr {2 * $lthickness}]
+ }
+ return $wid
+}
+
+proc rowranges {id} {
+ global idrowranges commitrow numcommits rowrangelist
- set startrow [lindex $idrowranges($id) [expr {2 * $i}]]
- set row [lindex $idrowranges($id) [expr {2 * $i + 1}]]
+ set ranges {}
+ if {[info exists commitrow($id)] && $commitrow($id) < $numcommits} {
+ set ranges [lindex $rowrangelist $commitrow($id)]
+ } elseif {[info exists idrowranges($id)]} {
+ set ranges $idrowranges($id)
+ }
+ return $ranges
+}
+
+proc drawlineseg {id i} {
+ global rowoffsets rowidlist
+ global displayorder
+ global canv colormap linespc
+ global numcommits commitrow
+
+ set ranges [rowranges $id]
+ set downarrow 1
+ if {[info exists commitrow($id)] && $commitrow($id) < $numcommits} {
+ set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
+ } else {
+ set downarrow 1
+ }
+ set startrow [lindex $ranges [expr {2 * $i}]]
+ set row [lindex $ranges [expr {2 * $i + 1}]]
if {$startrow == $row} return
assigncolor $id
set coords {}
- set col [lsearch -exact $rowidlist($row) $id]
+ set col [lsearch -exact [lindex $rowidlist $row] $id]
if {$col < 0} {
puts "oops: drawline: id $id not on row $row"
return
set lasto {}
set ns 0
while {1} {
- set o [lindex $rowoffsets($row) $col]
+ set o [lindex $rowoffsets $row $col]
if {$o eq {}} break
if {$o ne $lasto} {
# changing direction
incr col $o
incr row -1
}
- if {$coords eq {}} return
- 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 \
+ if {$i == 0} {
+ # draw the link to the first child as part of this line
+ incr row -1
+ set child [lindex $displayorder $row]
+ set ccol [lsearch -exact [lindex $rowidlist $row] $child]
+ if {$ccol >= 0} {
+ set x [xc $row $ccol]
+ set y [yc $row]
+ if {$ccol < $col - 1} {
+ lappend coords [xc $row [expr {$col - 1}]] [yc $row]
+ } elseif {$ccol > $col + 1} {
+ lappend coords [xc $row [expr {$col + 1}]] [yc $row]
+ }
+ lappend coords $x $y
+ }
+ }
+ if {[llength $coords] < 4} return
+ if {$downarrow} {
+ # This line has an arrow at the lower end: check if the arrow is
+ # on a diagonal segment, and if so, work around the Tk 8.4
+ # refusal to draw arrows on diagonal lines.
+ 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]
+ }
+ }
+ }
+ set arrow [expr {2 * ($i > 0) + $downarrow}]
+ set arrow [lindex {none first last both} $arrow]
+ 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 rowoffsets 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 y [yc $row]
set y2 [yc $row2]
- set ids $rowidlist($row2)
- set offs $rowidlist($row2)
+ 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} {
puts "oops, parent $p of $id not in list"
continue
}
+ set x2 [xc $row2 $i]
+ if {$x2 > $rmx} {
+ set rmx $x2
+ }
+ set ranges [rowranges $p]
+ if {$ranges ne {} && $row2 == [lindex $ranges 0]
+ && $row2 < [lindex $ranges 1]} {
+ # drawlineseg will do this one for us
+ continue
+ }
assigncolor $p
# should handle duplicated parents here...
set coords [list $x $y]
} elseif {$i > $col + 1} {
lappend coords [xc $row [expr {$i - 1}]] $y
}
- set x2 [xc $row2 $i]
- if {$x2 > $rmx} {
- 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
+ global idrangedrawn
+ global childlist iddrawn commitrow rowidlist
$canv delete lines.$id
- set wid [expr {$xtra + 1}]
- set nr [expr {[llength $idrowranges($id)] / 2}]
+ set nr [expr {[llength [rowranges $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)]} {
- foreach child $children($id) {
- if {[info exists iddrawn($child)]} {
- set row $commitrow($child)
- set col [lsearch -exact $rowidlist($row) $child]
- if {$col >= 0} {
- drawparentlinks $child $row $col [list $id] $wid
- }
+ foreach child [lindex $childlist $commitrow($id)] {
+ if {[info exists iddrawn($child)]} {
+ set row $commitrow($child)
+ set col [lsearch -exact [lindex $rowidlist $row] $child]
+ if {$col >= 0} {
+ drawparentlinks $child $row $col [list $id]
}
}
}
global commitlisted commitinfo rowidlist
global rowtextx idpos idtags idheads idotherrefs
global linehtag linentag linedtag
- global mainfont namefont
+ global mainfont namefont canvxmax
- set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}]
+ set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
set x [xc $row $col]
set y [yc $row]
set orad [expr {$linespc / 3}]
-fill $ofill -outline black -width 1]
$canv raise $t
$canv bind $t <1> {selcanvline {} %x %y}
- set xt [xc $row [llength $rowidlist($row)]]
+ set xt [xc $row [llength [lindex $rowidlist $row]]]
if {$xt < $rmx} {
set xt $rmx
}
-text $name -font $namefont]
set linedtag($row) [$canv3 create text 3 $y -anchor w \
-text $date -font $mainfont]
+ set xr [expr {$xt + [font measure $mainfont $headline]}]
+ if {$xr > $canvxmax} {
+ set canvxmax $xr
+ setcanvscroll
+ }
}
proc drawcmitrow {row} {
- global displayorder rowidlist rowoffsets
- global idrowranges idrangedrawn iddrawn
- global commitinfo commitlisted parents numcommits
+ global displayorder rowidlist
+ global idrangedrawn iddrawn
+ global commitinfo commitlisted parentlist numcommits
- if {![info exists rowidlist($row)]} return
- foreach id $rowidlist($row) {
- if {![info exists idrowranges($id)]} continue
+ if {$row >= $numcommits} return
+ foreach id [lindex $rowidlist $row] {
set i -1
- foreach {s e} $idrowranges($id) {
+ foreach {s e} [rowranges $id] {
incr i
if {$row < $s} continue
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
set id [lindex $displayorder $row]
if {[info exists iddrawn($id)]} return
- set col [lsearch -exact $rowidlist($row) $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)]} {
- readcommit $id
- if {![info exists commitinfo($id)]} {
- set commitinfo($id) {"No commit information available"}
- set nparents($id) 0
- }
+ getcommit $id
}
assigncolor $id
- if {[info exists commitlisted($id)] && [info exists parents($id)]
- && $parents($id) ne {}} {
- set rmx [drawparentlinks $id $row $col $parents($id) 1]
+ set olds [lindex $parentlist $row]
+ if {$olds ne {}} {
+ set rmx [drawparentlinks $id $row $col $olds]
} else {
set rmx 0
}
catch {unset idrangedrawn}
}
+proc findcrossings {id} {
+ global rowidlist parentlist numcommits rowoffsets displayorder
+
+ set cross {}
+ set ccross {}
+ foreach {s e} [rowranges $id] {
+ if {$e >= $numcommits} {
+ 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 olds [lindex $parentlist $row]
+ set kid [lindex $displayorder $row]
+ set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
+ if {$kidx < 0} continue
+ set nextrow [lindex $rowidlist [expr {$row + 1}]]
+ foreach p $olds {
+ set px [lsearch -exact $nextrow $p]
+ if {$px < 0} continue
+ if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
+ if {[lsearch -exact $ccross $p] >= 0} continue
+ if {$x == $px + ($kidx < $px? -1: 1)} {
+ lappend ccross $p
+ } elseif {[lsearch -exact $cross $p] < 0} {
+ lappend cross $p
+ }
+ }
+ }
+ set inc [lindex $rowoffsets $row $x]
+ if {$inc eq {}} break
+ incr x $inc
+ }
+ }
+ return [concat $ccross {{}} $cross]
+}
+
proc assigncolor {id} {
global colormap colors nextcolor
- global parents nparents children nchildren
- global cornercrossings crossings
+ global commitrow parentlist children childlist
if {[info exists colormap($id)]} return
set ncolors [llength $colors]
- if {$nchildren($id) == 1} {
- set child [lindex $children($id) 0]
+ if {[info exists commitrow($id)]} {
+ set kids [lindex $childlist $commitrow($id)]
+ } elseif {[info exists children($id)]} {
+ set kids $children($id)
+ } else {
+ set kids {}
+ }
+ if {[llength $kids] == 1} {
+ set child [lindex $kids 0]
if {[info exists colormap($child)]
- && $nparents($child) == 1} {
+ && [llength [lindex $parentlist $commitrow($child)]] == 1} {
set colormap($id) $colormap($child)
return
}
}
set badcolors {}
- if {[info exists cornercrossings($id)]} {
- foreach x $cornercrossings($id) {
- if {[info exists colormap($x)]
- && [lsearch -exact $badcolors $colormap($x)] < 0} {
- lappend badcolors $colormap($x)
- }
+ set origbad {}
+ foreach x [findcrossings $id] {
+ if {$x eq {}} {
+ # delimiter between corner crossings and other crossings
+ if {[llength $badcolors] >= $ncolors - 1} break
+ set origbad $badcolors
}
- if {[llength $badcolors] >= $ncolors} {
- set badcolors {}
+ if {[info exists colormap($x)]
+ && [lsearch -exact $badcolors $colormap($x)] < 0} {
+ lappend badcolors $colormap($x)
}
}
- set origbad $badcolors
- if {[llength $badcolors] < $ncolors - 1} {
- if {[info exists crossings($id)]} {
- foreach x $crossings($id) {
- if {[info exists colormap($x)]
- && [lsearch -exact $badcolors $colormap($x)] < 0} {
- lappend badcolors $colormap($x)
- }
- }
- if {[llength $badcolors] >= $ncolors} {
- set badcolors $origbad
- }
- }
- set origbad $badcolors
+ if {[llength $badcolors] >= $ncolors} {
+ set badcolors $origbad
}
+ set origbad $badcolors
if {[llength $badcolors] < $ncolors - 1} {
- foreach child $children($id) {
+ foreach child $kids {
if {[info exists colormap($child)]
&& [lsearch -exact $badcolors $colormap($child)] < 0} {
lappend badcolors $colormap($child)
}
- if {[info exists parents($child)]} {
- foreach p $parents($child) {
- if {[info exists colormap($p)]
- && [lsearch -exact $badcolors $colormap($p)] < 0} {
- lappend badcolors $colormap($p)
- }
+ foreach p [lindex $parentlist $commitrow($child)] {
+ if {[info exists colormap($p)]
+ && [lsearch -exact $badcolors $colormap($p)] < 0} {
+ lappend badcolors $colormap($p)
}
}
}
set colormap($id) $c
}
-proc initgraph {} {
- global numcommits nextcolor linespc
- global nchildren
-
- allcanvs delete all
- set nextcolor 0
- set numcommits 0
-}
-
proc bindline {t id} {
global canv
return $xt
}
-proc checkcrossings {row endrow} {
- global displayorder parents rowidlist
-
- for {} {$row < $endrow} {incr row} {
- set id [lindex $displayorder $row]
- set i [lsearch -exact $rowidlist($row) $id]
- if {$i < 0} continue
- set idlist $rowidlist([expr {$row+1}])
- foreach p $parents($id) {
- set j [lsearch -exact $idlist $p]
- if {$j > 0} {
- if {$j < $i - 1} {
- notecrossings $row $p $j $i [expr {$j+1}]
- } elseif {$j > $i + 1} {
- notecrossings $row $p $i $j [expr {$j-1}]
- }
- }
- }
- }
-}
-
-proc notecrossings {row id lo hi corner} {
- global rowidlist crossings cornercrossings
-
- for {set i $lo} {[incr i] < $hi} {} {
- set p [lindex $rowidlist($row) $i]
- if {$p == {}} continue
- if {$i == $corner} {
- if {![info exists cornercrossings($id)]
- || [lsearch -exact $cornercrossings($id) $p] < 0} {
- lappend cornercrossings($id) $p
- }
- if {![info exists cornercrossings($p)]
- || [lsearch -exact $cornercrossings($p) $id] < 0} {
- lappend cornercrossings($p) $id
- }
- } else {
- if {![info exists crossings($id)]
- || [lsearch -exact $crossings($id) $p] < 0} {
- lappend crossings($id) $p
- }
- if {![info exists crossings($p)]
- || [lsearch -exact $crossings($p) $id] < 0} {
- lappend crossings($p) $id
- }
- }
- }
-}
-
proc xcoord {i level ln} {
global canvx0 xspc1 xspc2
return $x
}
-proc drawcommit {id reading} {
- global phase todo nchildren nextupdate
- global displayorder parents
- global commitrow commitidx lineid
-
- if {$phase != "incrdraw"} {
- set phase incrdraw
- set displayorder {}
- set todo {}
- set commitidx 0
- initlayout
- initgraph
- }
- set commitrow($id) $commitidx
- set lineid($commitidx) $id
- incr commitidx
- lappend displayorder $id
-}
-
proc finishcommits {} {
- global phase
+ global commitidx phase
global canv mainfont ctext maincursor textcursor
+ global findinprogress
- 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
+ if {![info exists findinprogress]} {
+ . 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"
}
proc dofind {} {
global findtype findloc findstring markedmatches commitinfo
- global numcommits lineid linehtag linentag linedtag
+ 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 id $lineid($l)
+ set l -1
+ foreach id $displayorder {
+ set d $commitdata($id)
+ 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
+ if {![info exists commitinfo($id)]} {
+ getcommit $id
+ }
set info $commitinfo($id)
set doesmatch 0
foreach f $info ty $fldtypes {
proc findpatches {} {
global findstring selectedline numcommits
global findprocpid findprocfile
- global finddidsel ctext lineid findinprogress
+ global finddidsel ctext displayorder findinprogress
global findinsertpos
if {$numcommits == 0} return
if {[incr l] >= $numcommits} {
set l 0
}
- append inputids $lineid($l) "\n"
+ append inputids [lindex $displayorder $l] "\n"
}
if {[catch {
}
proc findfiles {} {
- global selectedline numcommits lineid ctext
- global ffileline finddidsel parents nparents
+ global selectedline numcommits displayorder ctext
+ global ffileline finddidsel parentlist
global findinprogress findstartline findinsertpos
global treediffs fdiffid fdiffsneeded fdiffpos
global findmergefiles
set diffsneeded {}
set fdiffsneeded {}
while 1 {
- set id $lineid($l)
- if {$findmergefiles || $nparents($id) == 1} {
+ set id [lindex $displayorder $l]
+ if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
if {![info exists treediffs($id)]} {
append diffsneeded "$id\n"
lappend fdiffsneeded $id
set finddidsel 0
set findinsertpos end
- set id $lineid($l)
+ set id [lindex $displayorder $l]
. config -cursor watch
settextcursor watch
set findinprogress 1
- findcont $id
+ findcont
update
}
set treediffs($nullid) {}
if {[info exists findid] && $nullid eq $findid} {
unset findid
- findcont $nullid
+ findcont
}
incr fdiffpos
}
}
if {[info exists findid] && $fdiffid eq $findid} {
unset findid
- findcont $fdiffid
+ findcont
}
}
}
-proc findcont {id} {
- global findid treediffs parents nparents
+proc findcont {} {
+ global findid treediffs parentlist
global ffileline findstartline finddidsel
- global lineid numcommits matchinglines findinprogress
+ global displayorder numcommits matchinglines findinprogress
global findmergefiles
set l $ffileline
- while 1 {
- if {$findmergefiles || $nparents($id) == 1} {
+ while {1} {
+ set id [lindex $displayorder $l]
+ if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
if {![info exists treediffs($id)]} {
set findid $id
set ffileline $l
set l 0
}
if {$l == $findstartline} break
- set id $lineid($l)
}
stopfindproc
if {!$finddidsel} {
# 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)]
proc selectline {l isnew} {
global canv canv2 canv3 ctext commitinfo selectedline
- global lineid linehtag linentag linedtag
- global canvy0 linespc parents nparents children
+ global displayorder linehtag linentag linedtag
+ global canvy0 linespc parentlist childlist
global cflist currentid sha1entry
global commentend idtags linknum
- global mergemax
+ global mergemax numcommits pending_select
+ catch {unset pending_select}
$canv delete hover
normalline
- if {![info exists lineid($l)]} return
+ if {$l < 0 || $l >= $numcommits} return
set y [expr {$canvy0 + $l * $linespc}]
set ymax [lindex [$canv cget -scrollregion] 3]
set ytop [expr {$y - $linespc - 1}]
set selectedline $l
- set id $lineid($l)
+ set id [lindex $displayorder $l]
set currentid $id
$sha1entry delete 0 end
$sha1entry insert 0 $id
}
set comment {}
- if {$nparents($id) > 1} {
+ set olds [lindex $parentlist $l]
+ if {[llength $olds] > 1} {
set np 0
- foreach p $parents($id) {
+ foreach p $olds {
if {$np >= $mergemax} {
set tag mmax
} else {
incr np
}
} else {
- if {[info exists parents($id)]} {
- foreach p $parents($id) {
- append comment "Parent: [commit_descriptor $p]\n"
- }
+ foreach p $olds {
+ append comment "Parent: [commit_descriptor $p]\n"
}
}
- if {[info exists children($id)]} {
- foreach c $children($id) {
- append comment "Child: [commit_descriptor $c]\n"
- }
+ foreach c [lindex $childlist $l] {
+ append comment "Child: [commit_descriptor $c]\n"
}
append comment "\n"
append comment [lindex $info 5]
$cflist delete 0 end
$cflist insert end "Comments"
- if {$nparents($id) == 1} {
+ if {[llength $olds] <= 1} {
startdiff $id
- } elseif {$nparents($id) > 1} {
- mergediff $id
+ } else {
+ mergediff $id $l
}
}
}
proc unselectline {} {
- global selectedline
+ global selectedline currentid
catch {unset selectedline}
+ catch {unset currentid}
allcanvs delete secsel
}
}
}
-proc mergediff {id} {
- global parents diffmergeid diffopts mdifffd
- global difffilestart
+proc mergediff {id l} {
+ global diffmergeid diffopts mdifffd
+ global difffilestart diffids
+ global parentlist
set diffmergeid $id
+ set diffids $id
catch {unset difffilestart}
# this doesn't seem to actually affect anything...
set env(GIT_DIFF_OPTS) $diffopts
}
fconfigure $mdf -blocking 0
set mdifffd($id) $mdf
- fileevent $mdf readable [list getmergediffline $mdf $id]
+ set np [llength [lindex $parentlist $l]]
+ fileevent $mdf readable [list getmergediffline $mdf $id $np]
set nextupdate [expr {[clock clicks -milliseconds] + 100}]
}
-proc getmergediffline {mdf id} {
- global diffmergeid ctext cflist nextupdate nparents mergemax
- global difffilestart
+proc getmergediffline {mdf id np} {
+ global diffmergeid ctext cflist nextupdate mergemax
+ global difffilestart mdifffd
set n [gets $mdf line]
if {$n < 0} {
}
return
}
- if {![info exists diffmergeid] || $id != $diffmergeid} {
+ if {![info exists diffmergeid] || $id != $diffmergeid
+ || $mdf != $mdifffd($id)} {
return
}
$ctext conf -state normal
# do nothing
} else {
# parse the prefix - one ' ', '-' or '+' for each parent
- set np $nparents($id)
set spaces {}
set minuses {}
set pluses {}
incr nextupdate 100
fileevent $mdf readable {}
update
- fileevent $mdf readable [list getmergediffline $mdf $id]
+ fileevent $mdf readable [list getmergediffline $mdf $id $np]
}
}
}
proc gettreediffs {ids} {
- global treediff parents treepending
+ global treediff treepending
set treepending $ids
set treediff {}
if {[catch \
set treediffs($ids) $treediff
unset treepending
if {$ids != $diffids} {
- gettreediffs $diffids
- } else {
- if {[info exists diffmergeid]} {
- contmergediff $ids
- } else {
- addtocflist $ids
+ if {![info exists diffmergeid]} {
+ gettreediffs $diffids
}
+ } else {
+ addtocflist $ids
}
return
}
set pad [string range "----------------------------------------" 1 $l]
$ctext insert end "$pad $header $pad\n" filesep
set diffinhdr 1
- } elseif {[regexp {^(---|\+\+\+)} $line]} {
+ } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
+ # do nothing
+ } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
set diffinhdr 0
} elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
$line match f1l f1c f2l f2c rest]} {
}
proc redisplay {} {
- global canv canvy0 linespc numcommits
+ global canv
global selectedline
set ymax [lindex [$canv cget -scrollregion] 3]
if {$ymax eq {} || $ymax == 0} return
set span [$canv yview]
clear_display
- allcanvs conf -scrollregion \
- [list 0 0 0 [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]]
+ setcanvscroll
allcanvs yview moveto [lindex $span 0]
drawvisible
if {[info exists selectedline]} {
proc gotocommit {} {
global sha1string currentid commitrow tagids
- global lineid numcommits
+ global displayorder numcommits
if {$sha1string == {}
|| ([info exists currentid] && $sha1string == $currentid)} return
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* $lineid($l)]} {
- lappend matches $lineid($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 clickisonarrow {id y} {
- global lthickness idrowranges
+ global lthickness
+ set ranges [rowranges $id]
set thresh [expr {2 * $lthickness + 6}]
- set n [expr {[llength $idrowranges($id)] - 1}]
+ set n [expr {[llength $ranges] - 1}]
for {set i 1} {$i < $n} {incr i} {
- set row [lindex $idrowranges($id) $i]
+ set row [lindex $ranges $i]
if {abs([yc $row] - $y) < $thresh} {
return $i
}
}
proc arrowjump {id n y} {
- global idrowranges canv
+ global canv
# 1 <-> 2, 3 <-> 4, etc...
set n [expr {(($n - 1) ^ 1) + 1}]
- set row [lindex $idrowranges($id) $n]
+ set row [lindex [rowranges $id] $n]
set yt [yc $row]
set ymax [lindex [$canv cget -scrollregion] 3]
if {$ymax eq {} || $ymax <= 0} return
}
proc lineclick {x y id isnew} {
- global ctext commitinfo children cflist canv thickerline
+ global ctext commitinfo childlist commitrow 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
$ctext insert end "\tAuthor:\t[lindex $info 1]\n"
set date [formatdate [lindex $info 2]]
$ctext insert end "\tDate:\t$date\n"
- if {[info exists children($id)]} {
+ set kids [lindex $childlist $commitrow($id)]
+ if {$kids ne {}} {
$ctext insert end "\nChildren:"
set i 0
- foreach child $children($id) {
+ foreach child $kids {
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
}
}
}
proc diffvssel {dirn} {
- global rowmenuid selectedline lineid
+ global rowmenuid selectedline displayorder
if {![info exists selectedline]} return
if {$dirn} {
- set oldid $lineid($selectedline)
+ set oldid [lindex $displayorder $selectedline]
set newid $rowmenuid
} else {
set oldid $rowmenuid
- set newid $lineid($selectedline)
+ set newid [lindex $displayorder $selectedline]
}
addtohistory [list doseldiff $oldid $newid]
doseldiff $oldid $newid
set optim_delay 16
+set nextviewnum 1
+set curview 0
+set viewfiles(0) {}
+
set stopped 0
set stuffsaved 0
set patchnum 0
setcoords
-makewindow $revtreeargs
+makewindow
readrefs
-getcommits $revtreeargs
+parse_args $revtreeargs
+set args $parsed_args
+if {$cmdline_files ne {}} {
+ # create a view for the files/dirs specified on the command line
+ set curview 1
+ set nextviewnum 2
+ set viewname(1) "Command line"
+ set viewfiles(1) $cmdline_files
+ .bar.view add command -label $viewname(1) -command {showview 1}
+ .bar.view entryconf 2 -state normal
+ set args [concat $args "--" $cmdline_files]
+}
+getcommits $args