X-Git-Url: https://git.octo.it/?a=blobdiff_plain;f=gitk;h=fa1e83c494ea6da8ba397d7c0314abd250ef3487;hb=5f2f4240022418e9a75505f11298db54a5da12d2;hp=36e8647b336a38a9dfcc2e186e41740fd57bb521;hpb=9f841cf1fbe4150a78555a45fd8a7794010975d4;p=git.git diff --git a/gitk b/gitk index 36e8647b..fa1e83c4 100755 --- a/gitk +++ b/gitk @@ -35,7 +35,6 @@ proc parse_args {rargs} { 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}] @@ -47,13 +46,12 @@ proc start_rev_list {rlargs} { } 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 @@ -116,8 +114,13 @@ proc getcommitlines {commfd} { 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} { @@ -135,10 +138,14 @@ proc getcommitlines {commfd} { 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 @@ -266,15 +273,11 @@ proc parsecommit {id contents listed} { $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)]} { @@ -509,8 +512,8 @@ proc makewindow {rargs} { #bindall {selcanvline %W %x %y} bindall "allcanvs yview scroll -5 units" bindall "allcanvs yview scroll 5 units" - bindall <2> "allcanvs scan mark 0 %y" - bindall "allcanvs scan dragto 0 %y" + bindall <2> "canvscan mark %W %x %y" + bindall "canvscan dragto %W %x %y" bind . "selnextline -1" bind . "selnextline 1" bind . "goforw" @@ -565,6 +568,19 @@ proc makewindow {rargs} { $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 @@ -830,7 +846,7 @@ proc initlayout {} { global rowidlist rowoffsets displayorder global rowlaidout rowoptim global idinlist rowchk - global commitidx numcommits + global commitidx numcommits canvxmax canv global nextcolor set commitidx 0 @@ -843,6 +859,16 @@ proc initlayout {} { 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 {} { @@ -884,7 +910,6 @@ proc layoutmore {} { proc showstuff {canshow} { global numcommits - global canvy0 linespc global linesegends idrowranges idrangedrawn if {$numcommits == 0} { @@ -894,8 +919,7 @@ proc showstuff {canshow} { } 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] @@ -958,8 +982,9 @@ proc layoutrows {row endrow last} { 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 } @@ -988,7 +1013,6 @@ proc layoutrows {row endrow last} { unset idinlist($id) } if {[info exists idrowranges($id)]} { - lappend linesegends($row) $id lappend idrowranges($id) $row } incr row @@ -1044,7 +1068,7 @@ proc addextraid {id row} { proc layouttail {} { global rowidlist rowoffsets idinlist commitidx - global idrowranges linesegends + global idrowranges set row $commitidx set idlist [lindex $rowidlist $row] @@ -1053,7 +1077,6 @@ proc layouttail {} { 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] @@ -1067,7 +1090,6 @@ proc layouttail {} { 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 {} @@ -1085,7 +1107,7 @@ proc insert_pad {row col npad} { } 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] @@ -1141,6 +1163,15 @@ proc optimize_rows {row col endrow} { 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] @@ -1148,11 +1179,26 @@ proc optimize_rows {row col endrow} { } } 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 @@ -1196,7 +1242,8 @@ proc linewidth {id} { 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}]] @@ -1223,13 +1270,49 @@ proc drawlineseg {id i} { 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 @@ -1237,7 +1320,7 @@ proc drawlineseg {id i} { } 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] @@ -1252,6 +1335,16 @@ proc drawparentlinks {id row col olds} { 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] @@ -1260,10 +1353,6 @@ proc drawparentlinks {id row col olds} { } 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] @@ -1303,7 +1392,7 @@ proc drawcmittext {id row col rmx} { 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] @@ -1335,13 +1424,17 @@ proc drawcmittext {id row col 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 global idrowranges idrangedrawn iddrawn global commitinfo commitlisted parents numcommits - global commitdata if {$row >= $numcommits} return foreach id [lindex $rowidlist $row] { @@ -1369,7 +1462,7 @@ proc drawcmitrow {row} { return } if {![info exists commitinfo($id)]} { - getcommit $id $row + getcommit $id } assigncolor $id if {[info exists commitlisted($id)] && [info exists parents($id)] @@ -1627,6 +1720,7 @@ proc xcoord {i level ln} { proc finishcommits {} { global commitidx phase global canv mainfont ctext maincursor textcursor + global findinprogress if {$commitidx > 0} { drawrest @@ -1635,8 +1729,10 @@ proc finishcommits {} { $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 {} } @@ -1723,7 +1819,8 @@ proc dofind {} { 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] @@ -1733,9 +1830,8 @@ proc dofind {} { 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 @@ -2321,9 +2417,9 @@ proc selectline {l isnew} { $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 } } @@ -2395,9 +2491,10 @@ proc goforw {} { 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 @@ -2414,7 +2511,7 @@ proc mergediff {id} { proc getmergediffline {mdf id} { global diffmergeid ctext cflist nextupdate nparents mergemax - global difffilestart + global difffilestart mdifffd set n [gets $mdf line] if {$n < 0} { @@ -2423,7 +2520,8 @@ proc getmergediffline {mdf id} { } return } - if {![info exists diffmergeid] || $id != $diffmergeid} { + if {![info exists diffmergeid] || $id != $diffmergeid + || $mdf != $mdifffd($id)} { return } $ctext conf -state normal @@ -2533,13 +2631,11 @@ proc gettreediffline {gdtf ids} { 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 } @@ -2615,7 +2711,9 @@ proc getblobdiffline {bdf ids} { 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]} { @@ -2690,15 +2788,14 @@ proc setcoords {} { } 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]} {