X-Git-Url: https://git.octo.it/?a=blobdiff_plain;f=gitk;h=fa1e83c494ea6da8ba397d7c0314abd250ef3487;hb=2a0925be3512451834ec9a3e023f4cff23c1cfb7;hp=cca9d355f6febbac4c07525e4c2cbdec9553b950;hpb=8f7d0cecf4b4999f71e0c5346de2f24beebd67dd;p=git.git diff --git a/gitk b/gitk index cca9d355..fa1e83c4 100755 --- a/gitk +++ b/gitk @@ -46,7 +46,7 @@ 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 @@ -72,11 +72,9 @@ proc getcommits {rargs} { } proc getcommitlines {commfd} { - global parents cdate children nchildren - global commitlisted commitinfo phase nextupdate - global stopped leftover - global canv - global displayorder commitidx commitrow + global commitlisted nextupdate + global leftover + global displayorder commitidx commitrow commitdata set stuff [read $commfd] if {$stuff == {}} { @@ -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,13 +138,14 @@ proc getcommitlines {commfd} { 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 - updatechildren $id [lrange $ids 1 end] - if {![info exists commitinfo($id)]} { - parsecommit $id $cmit 1 + 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 @@ -269,6 +273,21 @@ proc parsecommit {id contents listed} { $comname $comdate $comment] } +proc getcommit {id} { + global commitdata commitinfo nparents + + 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"} + set nparents($id) 0 + } + } + return 1 +} + proc readrefs {} { global tagids idtags headids idheads tagcontents global otherrefids idotherrefs @@ -322,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 } @@ -492,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" @@ -548,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 @@ -813,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 @@ -826,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 {} { @@ -867,7 +910,6 @@ proc layoutmore {} { proc showstuff {canshow} { global numcommits - global canvy0 linespc global linesegends idrowranges idrangedrawn if {$numcommits == 0} { @@ -877,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] @@ -890,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 } } @@ -941,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 } @@ -971,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 @@ -1027,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] @@ -1036,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] @@ -1050,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 {} @@ -1068,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] @@ -1124,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] @@ -1131,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 @@ -1167,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}]] @@ -1196,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] @@ -1220,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] @@ -1235,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 @@ -1248,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)]} { @@ -1267,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] } } } @@ -1279,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] @@ -1311,6 +1424,11 @@ 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} { @@ -1328,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 @@ -1344,16 +1462,12 @@ proc drawcmitrow {row} { 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 rmx [drawparentlinks $id $row $col $parents($id)] } else { set rmx 0 } @@ -1604,19 +1718,22 @@ proc xcoord {i level ln} { } 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, @@ -1631,7 +1748,6 @@ proc settextcursor {c} { } proc drawrest {} { - global phase global numcommits global startmsecs global canvy0 numcommits linespc @@ -1643,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" } @@ -1672,7 +1787,8 @@ proc dofind {} { global findtype findloc findstring markedmatches commitinfo global numcommits displayorder linehtag linentag linedtag global mainfont namefont canv canv2 canv3 selectedline - global matchinglines foundstring foundstrlen + global matchinglines foundstring foundstrlen matchstring + global commitdata stopfindproc unmarkmatches @@ -1689,6 +1805,8 @@ proc dofind {} { } set foundstrlen [string length $findstring] if {$foundstrlen == 0} return + regsub -all {[*?\[\\]} $foundstring {\\&} matchstring + set matchstring "*$matchstring*" if {$findloc == "Files"} { findfiles return @@ -1700,8 +1818,21 @@ proc dofind {} { } set didsel 0 set fldtypes {Headline Author Date Committer CDate Comment} - for {set l 0} {$l < $numcommits} {incr l} { - set id [lindex $displayorder $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 { @@ -2069,7 +2200,7 @@ proc findcont {id} { # 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)] @@ -2286,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 } } @@ -2360,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 @@ -2379,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} { @@ -2388,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 @@ -2498,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 } @@ -2580,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]} { @@ -2655,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]} { @@ -2725,9 +2857,9 @@ proc gotocommit {} { set id [string tolower $sha1string] if {[regexp {^[0-9a-f]{4,39}$} $id]} { set matches {} - for {set l 0} {$l < $numcommits} {incr l} { - if {[string match $id* [lindex $displayorder $l]]} { - lappend matches [lindex $displayorder $l] + foreach i $displayorder { + if {[string match $id* $i]} { + lappend matches $i } } if {$matches ne {}} { @@ -2755,7 +2887,7 @@ proc lineenter {x y id} { 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 @@ -2849,13 +2981,14 @@ proc arrowjump {id n y} { proc lineclick {x y id isnew} { global ctext commitinfo children cflist canv thickerline + if {![info exists commitinfo($id)] && ![getcommit $id]} return unmarkmatches unselectline normalline $canv delete hover # draw this line thicker than normal - drawlines $id 1 set thickerline $id + drawlines $id if {$isnew} { set ymax [lindex [$canv cget -scrollregion] 3] if {$ymax eq {}} return @@ -2890,6 +3023,7 @@ proc lineclick {x y id isnew} { set i 0 foreach child $children($id) { incr i + if {![info exists commitinfo($child)] && ![getcommit $child]} continue set info $commitinfo($child) $ctext insert end "\n\t" $ctext insert end $child [list link link$i] @@ -2908,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 } }