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}]
}
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
}
set leftover {}
- set commitdata {}
fconfigure $commfd -blocking 0 -translation lf
if {$tclencoding != {}} {
fconfigure $commfd -encoding $tclencoding
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 {[string length $id] != 40} {
exit 1
}
set id [lindex $ids 0]
- set olds [lrange $ids 1 end]
- set commitlisted($id) 1
- updatechildren $id [lrange $ids 1 end]
- lappend commitdata [string range $cmit [expr {$j + 1}] end]
+ if {$listed} {
+ set olds [lrange $ids 1 end]
+ set commitlisted($id) 1
+ } else {
+ set olds {}
+ }
+ updatechildren $id $olds
+ set commitdata($id) [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
+proc getcommit {id} {
+ global commitdata 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
+ if {[info exists commitdata($id)]} {
+ parsecommit $id $commitdata($id) 1
} else {
readcommit $id
if {![info exists commitinfo($id)]} {
#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
global rowidlist rowoffsets displayorder
global rowlaidout rowoptim
global idinlist rowchk
- global commitidx numcommits
+ global commitidx numcommits canvxmax canv
global nextcolor
set commitidx 0
catch {unset rowchk}
set rowlaidout 0
set rowoptim 0
+ set canvxmax [$canv cget -width]
+}
+
+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 {} {
proc showstuff {canshow} {
global numcommits
- global canvy0 linespc
global linesegends idrowranges idrangedrawn
if {$numcommits == 0} {
}
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 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
}
unset idinlist($id)
}
if {[info exists idrowranges($id)]} {
- lappend linesegends($row) $id
lappend idrowranges($id) $row
}
incr row
proc layouttail {} {
global rowidlist rowoffsets idinlist commitidx
- global idrowranges linesegends
+ global idrowranges
set row $commitidx
set idlist [lindex $rowidlist $row]
set id [lindex $idlist $col]
addextraid $id $row
unset idinlist($id)
- lappend linesegends($row) $id
lappend idrowranges($id) $row
incr row
set offs [ntimes $col 0]
lset rowidlist $row [list $id]
lset rowoffsets $row 0
makeuparrow $id 0 $row 0
- lappend linesegends($row) $id
lappend idrowranges($id) $row
incr row
lappend rowidlist {}
}
proc optimize_rows {row col endrow} {
- global rowidlist rowoffsets idrowranges
+ global rowidlist rowoffsets idrowranges linesegends displayorder
for {} {$row < $endrow} {incr row} {
set idlist [lindex $rowidlist $row]
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 [lindex $rowoffsets $y1]
set x1 -1
proc drawlineseg {id i} {
global rowoffsets rowidlist idrowranges
- global canv colormap
+ global displayorder
+ global canv colormap linespc
set startrow [lindex $idrowranges($id) [expr {2 * $i}]]
set row [lindex $idrowranges($id) [expr {2 * $i + 1}]]
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 x [xc $row $col]
set y [yc $row]
lappend coords $x $y
+ 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
+ set last [expr {[llength $idrowranges($id)] / 2 - 1}]
+ if {$i < $last} {
+ # 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) + ($i < $last)}]
+ 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
}
proc drawparentlinks {id row col olds} {
- global rowidlist canv colormap
+ global rowidlist canv colormap idrowranges
set row2 [expr {$row + 1}]
set x [xc $row $col]
puts "oops, parent $p of $id not in list"
continue
}
+ set x2 [xc $row2 $i]
+ if {$x2 > $rmx} {
+ set rmx $x2
+ }
+ if {[info exists idrowranges($p)] &&
+ $row2 == [lindex $idrowranges($p) 0] &&
+ $row2 < [lindex $idrowranges($p) 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 [linewidth $p] \
-fill $colormap($p) -tags lines.$p]
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 x [xc $row $col]
-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
global idrowranges idrangedrawn iddrawn
global commitinfo commitlisted parents numcommits
- global commitdata
if {$row >= $numcommits} return
foreach id [lindex $rowidlist $row] {
return
}
if {![info exists commitinfo($id)]} {
- getcommit $id $row
+ getcommit $id
}
assigncolor $id
if {[info exists commitlisted($id)] && [info exists parents($id)]
proc finishcommits {} {
global commitidx phase
global canv mainfont ctext maincursor textcursor
+ global findinprogress
if {$commitidx > 0} {
drawrest
$canv create text 3 3 -anchor nw -text "No commits selected" \
-font $mainfont -tags textitems
}
- . config -cursor $maincursor
- settextcursor $textcursor
+ if {![info exists findinprogress]} {
+ . config -cursor $maincursor
+ settextcursor $textcursor
+ }
set phase {}
}
set didsel 0
set fldtypes {Headline Author Date Committer CDate Comment}
set l -1
- foreach d $commitdata {
+ foreach id $displayorder {
+ set d $commitdata($id)
incr l
if {$findtype == "Regexp"} {
set doesmatch [regexp $foundstring $d]
set doesmatch [string match $matchstring $d]
}
if {!$doesmatch} continue
- set id [lindex $displayorder $l]
if {![info exists commitinfo($id)]} {
- getcommit $id $l
+ getcommit $id
}
set info $commitinfo($id)
set doesmatch 0
$cflist delete 0 end
$cflist insert end "Comments"
- if {$nparents($id) == 1} {
+ if {$nparents($id) <= 1} {
startdiff $id
- } elseif {$nparents($id) > 1} {
+ } else {
mergediff $id
}
}
proc mergediff {id} {
global parents diffmergeid diffopts mdifffd
- global difffilestart
+ global difffilestart diffids
set diffmergeid $id
+ set diffids $id
catch {unset difffilestart}
# this doesn't seem to actually affect anything...
set env(GIT_DIFF_OPTS) $diffopts
proc getmergediffline {mdf id} {
global diffmergeid ctext cflist nextupdate nparents mergemax
- global difffilestart
+ 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
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]} {
projects / git.git / blobdiff