X-Git-Url: https://git.octo.it/?a=blobdiff_plain;f=gitk;h=fa1e83c494ea6da8ba397d7c0314abd250ef3487;hb=ec26b4d6b004b6529c79e995a543945076c683aa;hp=8d7b25870c9a2bda04358a6343216c717c673cfb;hpb=8ed164841564802cc0b063a6b365fb19e9a513d1;p=git.git diff --git a/gitk b/gitk index 8d7b2587..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)]} { @@ -338,6 +341,7 @@ proc error_popup msg { button $w.ok -text OK -command "destroy $w" pack $w.ok -side bottom -fill x bind $w "grab $w; focus $w" + bind $w "destroy $w" tkwait window $w } @@ -508,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" @@ -564,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 @@ -829,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 @@ -842,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 {} { @@ -883,7 +910,6 @@ proc layoutmore {} { proc showstuff {canshow} { global numcommits - global canvy0 linespc global linesegends idrowranges idrangedrawn if {$numcommits == 0} { @@ -893,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] @@ -906,7 +931,7 @@ proc showstuff {canshow} { 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 } } @@ -957,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 } @@ -987,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 @@ -1043,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] @@ -1052,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] @@ -1066,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 {} @@ -1084,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] @@ -1140,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] @@ -1147,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 @@ -1183,9 +1230,20 @@ proc yc {row} { 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 displayorder + global canv colormap linespc set startrow [lindex $idrowranges($id) [expr {2 * $i}]] set row [lindex $idrowranges($id) [expr {2 * $i + 1}]] @@ -1212,22 +1270,57 @@ proc drawlineseg {id i wid} { 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 + 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 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 idrowranges set row2 [expr {$row + 1}] set x [xc $row $col] @@ -1236,13 +1329,22 @@ proc drawparentlinks {id row col olds wid} { 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 + } + 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] @@ -1251,12 +1353,8 @@ proc drawparentlinks {id row col olds wid} { } 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 @@ -1264,17 +1362,16 @@ proc drawparentlinks {id row col olds wid} { 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)]} { @@ -1283,7 +1380,7 @@ proc drawlines {id xtra} { 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] } } } @@ -1295,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] @@ -1327,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] { @@ -1345,7 +1446,7 @@ proc drawcmitrow {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 @@ -1361,12 +1462,12 @@ 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)] && $parents($id) ne {}} { - set rmx [drawparentlinks $id $row $col $parents($id) 1] + set rmx [drawparentlinks $id $row $col $parents($id)] } else { set rmx 0 } @@ -1619,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 @@ -1627,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 {} } @@ -1644,7 +1748,6 @@ proc settextcursor {c} { } proc drawrest {} { - global phase global numcommits global startmsecs global canvy0 numcommits linespc @@ -1656,7 +1759,6 @@ proc drawrest {} { optimize_rows $row 0 $commitidx showstuff $commitidx - set phase {} set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}] #puts "overall $drawmsecs ms for $numcommits commits" } @@ -1717,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] @@ -1727,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 @@ -2315,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 } } @@ -2389,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 @@ -2408,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} { @@ -2417,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 @@ -2527,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 } @@ -2609,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]} { @@ -2684,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]} { @@ -2884,8 +2987,8 @@ proc lineclick {x y id isnew} { 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 @@ -2939,8 +3042,9 @@ proc lineclick {x y id isnew} { proc normalline {} { global thickerline if {[info exists thickerline]} { - drawlines $thickerline 0 + set id $thickerline unset thickerline + drawlines $id } }