X-Git-Url: https://git.octo.it/?a=blobdiff_plain;f=gitk;h=87e71629afd4b2eca8d1c768bea0a20815405b2b;hb=dbd0f7d3221fbf8e9943a114c11e5b5e5fc0c201;hp=8d7b25870c9a2bda04358a6343216c717c673cfb;hpb=8ed164841564802cc0b063a6b365fb19e9a513d1;p=git.git diff --git a/gitk b/gitk index 8d7b2587..87e71629 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 @@ -77,6 +75,7 @@ proc getcommitlines {commfd} { global commitlisted nextupdate global leftover global displayorder commitidx commitrow commitdata + global parentlist childlist children set stuff [read $commfd] if {$stuff == {}} { @@ -116,8 +115,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 +139,28 @@ 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] + if {[llength $olds] > 1} { + set olds [lsort -unique $olds] + } + foreach p $olds { + lappend children($p) $id + } + } 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} { @@ -174,14 +193,12 @@ proc doupdate {reading} { proc readcommit {id} { if {[catch {set contents [exec git-cat-file commit $id]}]} return - updatechildren $id {} parsecommit $id $contents 0 } proc updatecommits {rargs} { stopfindproc - foreach v {children nchildren parents nparents commitlisted - colormap selectedline matchinglines treediffs + foreach v {colormap selectedline matchinglines treediffs mergefilelist currentid rowtextx commitrow rowidlist rowoffsets idrowranges idrangedrawn iddrawn linesegends crossings cornercrossings} { @@ -193,26 +210,6 @@ proc updatecommits {rargs} { getcommits $rargs } -proc updatechildren {id olds} { - global children nchildren parents nparents - - 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) - } - } -} - proc parsecommit {id contents listed} { global commitinfo cdate @@ -266,20 +263,15 @@ proc parsecommit {id contents listed} { $comname $comdate $comment] } -proc getcommit {id {row {}}} { - global commitdata commitrow commitinfo nparents +proc getcommit {id} { + global commitdata commitinfo - 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)]} { set commitinfo($id) {"No commit information available"} - set nparents($id) 0 } } return 1 @@ -292,7 +284,7 @@ proc readrefs {} { foreach v {tagids idtags headids idheads otherrefids idotherrefs} { catch {unset $v} } - set refd [open [list | git-ls-remote [gitdir]] r] + set refd [open [list | git ls-remote [gitdir]] r] while {0 <= [set n [gets $refd line]]} { if {![regexp {^([0-9a-f]{40}) refs/([^^]*)$} $line \ match id path]} { @@ -338,11 +330,12 @@ 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 } proc makewindow {rargs} { - global canv canv2 canv3 linespc charspc ctext cflist textfont + global canv canv2 canv3 linespc charspc ctext cflist textfont mainfont uifont global findtype findtypemenu findloc findstring fstring geometry global entries sha1entry sha1string sha1but global maincursor textcursor curtextcursor @@ -350,16 +343,21 @@ proc makewindow {rargs} { menu .bar .bar add cascade -label "File" -menu .bar.file + .bar configure -font $uifont menu .bar.file .bar.file add command -label "Update" -command [list updatecommits $rargs] .bar.file add command -label "Reread references" -command rereadrefs .bar.file add command -label "Quit" -command doquit + .bar.file configure -font $uifont menu .bar.edit .bar add cascade -label "Edit" -menu .bar.edit .bar.edit add command -label "Preferences" -command doprefs + .bar.edit configure -font $uifont menu .bar.help .bar add cascade -label "Help" -menu .bar.help .bar.help add command -label "About gitk" -command about + .bar.help add command -label "Key bindings" -command keys + .bar.help configure -font $uifont . configure -menu .bar if {![info exists geometry(canv1)]} { @@ -406,7 +404,7 @@ proc makewindow {rargs} { set entries $sha1entry set sha1but .ctop.top.bar.sha1label button $sha1but -text "SHA1 ID: " -state disabled -relief flat \ - -command gotocommit -width 8 + -command gotocommit -width 8 -font $uifont $sha1but conf -disabledforeground [$sha1but cget -foreground] pack .ctop.top.bar.sha1label -side left entry $sha1entry -width 40 -font $textfont -textvariable sha1string @@ -436,19 +434,24 @@ proc makewindow {rargs} { -state disabled -width 26 pack .ctop.top.bar.rightbut -side left -fill y - button .ctop.top.bar.findbut -text "Find" -command dofind + button .ctop.top.bar.findbut -text "Find" -command dofind -font $uifont pack .ctop.top.bar.findbut -side left set findstring {} set fstring .ctop.top.bar.findstring lappend entries $fstring - entry $fstring -width 30 -font $textfont -textvariable findstring + entry $fstring -width 30 -font $textfont -textvariable findstring -font $textfont pack $fstring -side left -expand 1 -fill x set findtype Exact set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \ findtype Exact IgnCase Regexp] + .ctop.top.bar.findtype configure -font $uifont + .ctop.top.bar.findtype.menu configure -font $uifont set findloc "All fields" tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \ Comments Author Committer Files Pickaxe + .ctop.top.bar.findloc configure -font $uifont + .ctop.top.bar.findloc.menu configure -font $uifont + pack .ctop.top.bar.findloc -side right pack .ctop.top.bar.findtype -side right # for making sure type==Exact whenever loc==Pickaxe @@ -495,7 +498,7 @@ proc makewindow {rargs} { frame .ctop.cdet.right set cflist .ctop.cdet.right.cfiles listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \ - -yscrollcommand ".ctop.cdet.right.sb set" + -yscrollcommand ".ctop.cdet.right.sb set" -font $mainfont scrollbar .ctop.cdet.right.sb -command "$cflist yview" pack .ctop.cdet.right.sb -side right -fill y pack $cflist -side left -fill both -expand 1 @@ -508,14 +511,22 @@ 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" + bindkey selfirstline + bindkey sellastline bind . "selnextline -1" bind . "selnextline 1" - bind . "goforw" - bind . "goback" - bind . "allcanvs yview scroll -1 pages" - bind . "allcanvs yview scroll 1 pages" + bindkey "goforw" + bindkey "goback" + bind . "selnextpage -1" + bind . "selnextpage 1" + bind . "allcanvs yview moveto 0.0" + bind . "allcanvs yview moveto 1.0" + bind . "allcanvs yview scroll -1 units" + bind . "allcanvs yview scroll 1 units" + bind . "allcanvs yview scroll -1 pages" + bind . "allcanvs yview scroll 1 pages" bindkey "$ctext yview scroll -1 pages" bindkey "$ctext yview scroll -1 pages" bindkey "$ctext yview scroll 1 pages" @@ -564,6 +575,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 @@ -595,7 +619,7 @@ proc click {w} { } proc savestuff {w} { - global canv canv2 canv3 ctext cflist mainfont textfont + global canv canv2 canv3 ctext cflist mainfont textfont uifont global stuffsaved findmergefiles maxgraphpct global maxwidth @@ -605,6 +629,7 @@ proc savestuff {w} { set f [open "~/.gitk-new" w] puts $f [list set mainfont $mainfont] puts $f [list set textfont $textfont] + puts $f [list set uifont $uifont] puts $f [list set findmergefiles $findmergefiles] puts $f [list set maxgraphpct $maxgraphpct] puts $f [list set maxwidth $maxwidth] @@ -712,6 +737,55 @@ Use and redistribute under the terms of the GNU General Public License} \ pack $w.ok -side bottom } +proc keys {} { + set w .keys + if {[winfo exists $w]} { + raise $w + return + } + toplevel $w + wm title $w "Gitk key bindings" + message $w.m -text { +Gitk key bindings: + + Quit + Move to first commit + Move to last commit +, p, i Move up one commit +, n, k Move down one commit +, z, j Go back in history list +, x, l Go forward in history list + Move up one page in commit list + Move down one page in commit list + Scroll to top of commit list + Scroll to bottom of commit list + Scroll commit list up one line + Scroll commit list down one line + Scroll commit list up one page + Scroll commit list down one page +, b Scroll diff view up one page + Scroll diff view up one page + Scroll diff view down one page +u Scroll diff view up 18 lines +d Scroll diff view down 18 lines + Find + Move to next find hit + Move to previous find hit + Move to next find hit +/ Move to next find hit, or redo find +? Move to previous find hit +f Scroll diff view to next file + Increase font size + Increase font size + Decrease font size + Decrease font size +} \ + -justify left -bg white -border 2 -relief sunken + pack $w.m -side top -fill both + button $w.ok -text Close -command "destroy $w" + pack $w.ok -side bottom +} + proc shortids {ids} { set res {} foreach id $ids { @@ -826,15 +900,20 @@ proc makeuparrow {oid x y z} { } proc initlayout {} { - global rowidlist rowoffsets displayorder + global rowidlist rowoffsets displayorder commitlisted global rowlaidout rowoptim global idinlist rowchk - global commitidx numcommits + global commitidx numcommits canvxmax canv global nextcolor + global parentlist childlist children set commitidx 0 set numcommits 0 set displayorder {} + set commitlisted {} + set parentlist {} + set childlist {} + catch {unset children} set nextcolor 0 set rowidlist {{}} set rowoffsets {{}} @@ -842,6 +921,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 +972,6 @@ proc layoutmore {} { proc showstuff {canshow} { global numcommits - global canvy0 linespc global linesegends idrowranges idrangedrawn if {$numcommits == 0} { @@ -893,8 +981,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 +993,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 } } @@ -925,7 +1012,7 @@ proc showstuff {canshow} { 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 @@ -936,7 +1023,7 @@ proc layoutrows {row endrow last} { 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)} { @@ -957,8 +1044,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 } @@ -974,7 +1062,7 @@ proc layoutrows {row endrow last} { lappend idlist $id lset rowidlist $row $idlist set z {} - if {$nchildren($id) > 0} { + if {[lindex $childlist $row] ne {}} { set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}] unset idinlist($id) } @@ -987,7 +1075,6 @@ proc layoutrows {row endrow last} { unset idinlist($id) } if {[info exists idrowranges($id)]} { - lappend linesegends($row) $id lappend idrowranges($id) $row } incr row @@ -1028,22 +1115,29 @@ proc layoutrows {row endrow last} { } proc addextraid {id row} { - global displayorder commitrow commitinfo nparents - global commitidx + global displayorder commitrow commitinfo + global commitidx commitlisted + global parentlist childlist children incr commitidx lappend displayorder $id + lappend commitlisted 0 + lappend parentlist {} set commitrow($id) $row 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 set row $commitidx set idlist [lindex $rowidlist $row] @@ -1052,7 +1146,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 +1159,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 +1176,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 +1232,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 +1248,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 +1299,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 +1339,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 +1398,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 +1422,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,27 +1431,24 @@ 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 + global childlist 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)]} { - foreach child $children($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] $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] } } } @@ -1295,9 +1459,9 @@ 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 ofill [expr {[lindex $commitlisted $row]? "blue": "white"}] set x [xc $row $col] set y [yc $row] set orad [expr {$linespc / 3}] @@ -1327,13 +1491,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 + global commitinfo parentlist numcommits if {$row >= $numcommits} return foreach id [lindex $rowidlist $row] { @@ -1345,7 +1513,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 +1529,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 olds [lindex $parentlist $row] + if {$olds ne {}} { + set rmx [drawparentlinks $id $row $col $olds] } else { set rmx 0 } @@ -1410,15 +1578,22 @@ proc clear_display {} { proc assigncolor {id} { global colormap colors nextcolor - global parents nparents children nchildren + global commitrow parentlist children childlist global cornercrossings crossings 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 } @@ -1451,17 +1626,15 @@ proc assigncolor {id} { 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) } } } @@ -1556,14 +1729,14 @@ proc drawtags {id x xt y1} { } proc checkcrossings {row endrow} { - global displayorder parents rowidlist + global displayorder parentlist rowidlist for {} {$row < $endrow} {incr row} { set id [lindex $displayorder $row] set i [lsearch -exact [lindex $rowidlist $row] $id] if {$i < 0} continue set idlist [lindex $rowidlist [expr {$row+1}]] - foreach p $parents($id) { + foreach p [lindex $parentlist $row] { set j [lsearch -exact $idlist $p] if {$j > 0} { if {$j < $i - 1} { @@ -1619,6 +1792,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 +1801,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 +1820,6 @@ proc settextcursor {c} { } proc drawrest {} { - global phase global numcommits global startmsecs global canvy0 numcommits linespc @@ -1656,7 +1831,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 +1891,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 +1902,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 @@ -1944,7 +2118,7 @@ proc insertmatch {l id} { proc findfiles {} { global selectedline numcommits displayorder ctext - global ffileline finddidsel parents nparents + global ffileline finddidsel parentlist global findinprogress findstartline findinsertpos global treediffs fdiffid fdiffsneeded fdiffpos global findmergefiles @@ -1962,7 +2136,7 @@ proc findfiles {} { set fdiffsneeded {} while 1 { set id [lindex $displayorder $l] - if {$findmergefiles || $nparents($id) == 1} { + if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} { if {![info exists treediffs($id)]} { append diffsneeded "$id\n" lappend fdiffsneeded $id @@ -1994,7 +2168,7 @@ proc findfiles {} { . config -cursor watch settextcursor watch set findinprogress 1 - findcont $id + findcont update } @@ -2041,7 +2215,7 @@ proc donefilediff {} { set treediffs($nullid) {} if {[info exists findid] && $nullid eq $findid} { unset findid - findcont $nullid + findcont } incr fdiffpos } @@ -2052,20 +2226,21 @@ proc donefilediff {} { } 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 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 @@ -2087,7 +2262,6 @@ proc findcont {id} { set l 0 } if {$l == $findstartline} break - set id [lindex $displayorder $l] } stopfindproc if {!$finddidsel} { @@ -2184,10 +2358,26 @@ proc appendwithlinks {text} { $ctext tag bind link { %W configure -cursor $curtextcursor } } +proc viewnextline {dir} { + global canv linespc + + $canv delete hover + set ymax [lindex [$canv cget -scrollregion] 3] + set wnow [$canv yview] + set wtop [expr {[lindex $wnow 0] * $ymax}] + set newtop [expr {$wtop + $dir * $linespc}] + if {$newtop < 0} { + set newtop 0 + } elseif {$newtop > $ymax} { + set newtop $ymax + } + allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}] +} + proc selectline {l isnew} { global canv canv2 canv3 ctext commitinfo selectedline global displayorder linehtag linentag linedtag - global canvy0 linespc parents nparents children + global canvy0 linespc parentlist childlist global cflist currentid sha1entry global commentend idtags linknum global mergemax numcommits @@ -2277,9 +2467,10 @@ proc selectline {l isnew} { } 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 { @@ -2290,17 +2481,13 @@ proc selectline {l isnew} { 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] @@ -2315,13 +2502,25 @@ proc selectline {l isnew} { $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 selfirstline {} { + unmarkmatches + selectline 0 1 +} + +proc sellastline {} { + global numcommits + unmarkmatches + set l [expr {$numcommits - 1}] + selectline $l 1 +} + proc selnextline {dir} { global selectedline if {![info exists selectedline]} return @@ -2330,6 +2529,25 @@ proc selnextline {dir} { selectline $l 1 } +proc selnextpage {dir} { + global canv linespc selectedline numcommits + + set lpp [expr {([winfo height $canv] - 2) / $linespc}] + if {$lpp < 1} { + set lpp 1 + } + allcanvs yview scroll [expr {$dir * $lpp}] units + if {![info exists selectedline]} return + set l [expr {$selectedline + $dir * $lpp}] + if {$l < 0} { + set l 0 + } elseif {$l >= $numcommits} { + set l [expr $numcommits - 1] + } + unmarkmatches + selectline $l 1 +} + proc unselectline {} { global selectedline @@ -2387,11 +2605,13 @@ proc goforw {} { } } -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 @@ -2402,13 +2622,14 @@ proc mergediff {id} { } 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} { @@ -2417,7 +2638,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 @@ -2439,7 +2661,6 @@ proc getmergediffline {mdf id} { # do nothing } else { # parse the prefix - one ' ', '-' or '+' for each parent - set np $nparents($id) set spaces {} set minuses {} set pluses {} @@ -2480,7 +2701,7 @@ proc getmergediffline {mdf id} { incr nextupdate 100 fileevent $mdf readable {} update - fileevent $mdf readable [list getmergediffline $mdf $id] + fileevent $mdf readable [list getmergediffline $mdf $id $np] } } @@ -2507,7 +2728,7 @@ proc addtocflist {ids} { } proc gettreediffs {ids} { - global treediff parents treepending + global treediff treepending set treepending $ids set treediff {} if {[catch \ @@ -2527,13 +2748,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 +2828,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 +2905,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]} { @@ -2743,13 +2963,15 @@ proc sha1change {n1 n2 op} { } proc gotocommit {} { - global sha1string currentid commitrow tagids + global sha1string currentid commitrow tagids headids global displayorder numcommits if {$sha1string == {} || ([info exists currentid] && $sha1string == $currentid)} return if {[info exists tagids($sha1string)]} { set id $tagids($sha1string) + } elseif {[info exists headids($sha1string)]} { + set id $headids($sha1string) } else { set id [string tolower $sha1string] if {[regexp {^[0-9a-f]{4,39}$} $id]} { @@ -2775,7 +2997,7 @@ proc gotocommit {} { if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} { set type "SHA1 id" } else { - set type "Tag" + set type "Tag/Head" } error_popup "$type $sha1string is not known" } @@ -2876,7 +3098,7 @@ proc arrowjump {id n y} { } 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 @@ -2884,8 +3106,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 @@ -2915,10 +3137,11 @@ proc lineclick {x y id isnew} { $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) @@ -2939,8 +3162,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 } } @@ -3264,7 +3488,6 @@ proc listrefs {id} { proc rereadrefs {} { global idtags idheads idotherrefs - global tagids headids otherrefids set refids [concat [array names idtags] \ [array names idheads] [array names idotherrefs]] @@ -3673,6 +3896,7 @@ if {$tclencoding == {}} { set mainfont {Helvetica 9} set textfont {Courier 9} +set uifont {Helvetica 9 bold} set findmergefiles 0 set maxgraphpct 50 set maxwidth 16