X-Git-Url: https://git.octo.it/?a=blobdiff_plain;f=gitk;h=87e71629afd4b2eca8d1c768bea0a20815405b2b;hb=e6bfaf3e33beba9431490a4f5c7a9753986554c4;hp=502f2665af64141b7fea7b40add1b880f19427fe;hpb=9f1afe05c3ab7228e21ba3666c6e35d693149b37;p=git.git diff --git a/gitk b/gitk index 502f2665..87e71629 100755 --- a/gitk +++ b/gitk @@ -39,13 +39,14 @@ proc start_rev_list {rlargs} { set startmsecs [clock clicks -milliseconds] set nextupdate [expr {$startmsecs + 100}] set ncmupdate 1 + initlayout set order "--topo-order" if {$datemode} { set order "--date-order" } 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 @@ -61,16 +62,8 @@ proc start_rev_list {rlargs} { } proc getcommits {rargs} { - global oldcommits commits phase canv mainfont env + global phase canv mainfont - # check that we can find a .git directory somewhere... - set gitdir [gitdir] - if {![file isdirectory $gitdir]} { - error_popup "Cannot find the git directory \"$gitdir\"." - exit 1 - } - set oldcommits {} - set commits {} set phase getcommits start_rev_list [parse_args $rargs] $canv delete all @@ -79,10 +72,10 @@ proc getcommits {rargs} { } proc getcommitlines {commfd} { - global oldcommits commits parents cdate children nchildren - global commitlisted phase nextupdate - global stopped leftover - global canv + global commitlisted nextupdate + global leftover + global displayorder commitidx commitrow commitdata + global parentlist childlist children set stuff [read $commfd] if {$stuff == {}} { @@ -105,25 +98,33 @@ proc getcommitlines {commfd} { exit 1 } set start 0 + set gotsome 0 while 1 { set i [string first "\0" $stuff $start] if {$i < 0} { append leftover [string range $stuff $start end] break } - set cmit [string range $stuff $start [expr {$i - 1}]] if {$start == 0} { - set cmit "$leftover$cmit" + set cmit $leftover + append cmit [string range $stuff 0 [expr {$i - 1}]] set leftover {} + } else { + set cmit [string range $stuff $start [expr {$i - 1}]] } 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 {![regexp {^[0-9a-f]{40}$} $id]} { + if {[string length $id] != 40} { set ok 0 break } @@ -138,14 +139,33 @@ 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] - lappend commits $id - set commitlisted($id) 1 - parsecommit $id $cmit 1 [lrange $ids 1 end] - drawcommit $id 1 - } - layoutmore + 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} { + layoutmore + } if {[clock clicks -milliseconds] >= $nextupdate} { doupdate 1 } @@ -173,120 +193,24 @@ proc doupdate {reading} { proc readcommit {id} { if {[catch {set contents [exec git-cat-file commit $id]}]} return - parsecommit $id $contents 0 {} + parsecommit $id $contents 0 } proc updatecommits {rargs} { - global commitlisted commfd phase - global startmsecs nextupdate ncmupdate - global idtags idheads idotherrefs - global leftover - global parsed_args - global canv mainfont - global oldcommits commits - global parents nchildren children - - set old_args $parsed_args - parse_args $rargs - - if {$phase == "getcommits" || $phase == "incrdraw"} { - # havent read all the old commits, just start again from scratch - stopfindproc - set oldcommits {} - set commits {} - foreach v {children nchildren parents commitlisted commitinfo - selectedline matchinglines treediffs - mergefilelist currentid rowtextx} { - global $v - catch {unset $v} - } - readrefs - if {$phase == "incrdraw"} { - allcanvs delete all - $canv create text 3 3 -anchor nw -text "Reading commits..." \ - -font $mainfont -tags textitems - set phase getcommits - } - start_rev_list $parsed_args - return - } - - foreach id $old_args { - if {![regexp {^[0-9a-f]{40}$} $id]} continue - if {[info exists oldref($id)]} continue - set oldref($id) $id - lappend ignoreold "^$id" - } - foreach id $parsed_args { - if {![regexp {^[0-9a-f]{40}$} $id]} continue - if {[info exists ref($id)]} continue - set ref($id) $id - lappend ignorenew "^$id" - } - - foreach a $old_args { - if {![info exists ref($a)]} { - lappend ignorenew $a - } - } - - set phase updatecommits - set oldcommits $commits - set commits {} - set removed_commits [split [eval exec git-rev-list $ignorenew] "\n" ] - if {[llength $removed_commits] > 0} { - allcanvs delete all - foreach c $removed_commits { - set i [lsearch -exact $oldcommits $c] - if {$i >= 0} { - set oldcommits [lreplace $oldcommits $i $i] - unset commitlisted($c) - foreach p $parents($c) { - if {[info exists nchildren($p)]} { - set j [lsearch -exact $children($p) $c] - if {$j >= 0} { - set children($p) [lreplace $children($p) $j $j] - incr nchildren($p) -1 - } - } - } - } - } - set phase removecommits - } - - set args {} - foreach a $parsed_args { - if {![info exists oldref($a)]} { - lappend args $a - } + stopfindproc + foreach v {colormap selectedline matchinglines treediffs + mergefilelist currentid rowtextx commitrow + rowidlist rowoffsets idrowranges idrangedrawn iddrawn + linesegends crossings cornercrossings} { + global $v + catch {unset $v} } - + allcanvs delete all readrefs - start_rev_list [concat $ignoreold $args] + 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 olds} { +proc parsecommit {id contents listed} { global commitinfo cdate set inhdr 1 @@ -296,7 +220,6 @@ proc parsecommit {id contents listed olds} { set audate {} set comname {} set comdate {} - updatechildren $id $olds set hdrend [string first "\n\n" $contents] if {$hdrend < 0} { # should never happen... @@ -340,6 +263,20 @@ proc parsecommit {id contents listed olds} { $comname $comdate $comment] } +proc getcommit {id} { + global commitdata commitinfo + + 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"} + } + } + return 1 +} + proc readrefs {} { global tagids idtags headids idheads tagcontents global otherrefids idotherrefs @@ -347,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]} { @@ -393,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 @@ -405,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)]} { @@ -461,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 @@ -491,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 @@ -550,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 @@ -563,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" @@ -619,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 @@ -650,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 @@ -660,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] @@ -767,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 { @@ -825,30 +844,30 @@ proc sanity {row {full 0}} { global rowidlist rowoffsets set col -1 - set ids $rowidlist($row) + set ids [lindex $rowidlist $row] foreach id $ids { incr col if {$id eq {}} continue if {$col < [llength $ids] - 1 && [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} { - puts "oops: [shortids $id] repeated in row $row col $col: {[shortids $rowidlist($row)]}" + puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}" } - set o [lindex $rowoffsets($row) $col] + set o [lindex $rowoffsets $row $col] set y $row set x $col while {$o ne {}} { incr y -1 incr x $o - if {[lindex $rowidlist($y) $x] != $id} { + if {[lindex $rowidlist $y $x] != $id} { puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]" puts " id=[shortids $id] check started at row $row" for {set i $row} {$i >= $y} {incr i -1} { - puts " row $i ids={[shortids $rowidlist($i)]} offs={$rowoffsets($i)}" + puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}" } break } if {!$full} break - set o [lindex $rowoffsets($y) $x] + set o [lindex $rowoffsets $y $x] } } } @@ -859,10 +878,10 @@ proc makeuparrow {oid x y z} { for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} { incr y -1 incr x $z - set off0 $rowoffsets($y) + set off0 [lindex $rowoffsets $y] for {set x0 $x} {1} {incr x0} { if {$x0 >= [llength $off0]} { - set x0 [llength $rowoffsets([expr {$y-1}])] + set x0 [llength [lindex $rowoffsets [expr {$y-1}]]] break } set z [lindex $off0 $x0] @@ -872,25 +891,46 @@ proc makeuparrow {oid x y z} { } } set z [expr {$x0 - $x}] - set rowidlist($y) [linsert $rowidlist($y) $x $oid] - set rowoffsets($y) [linsert $rowoffsets($y) $x $z] + lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid] + lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z] } - set tmp [lreplace $rowoffsets($y) $x $x {}] - set rowoffsets($y) [incrange $tmp [expr {$x+1}] -1] + set tmp [lreplace [lindex $rowoffsets $y] $x $x {}] + lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1] lappend idrowranges($oid) $y } proc initlayout {} { - global rowidlist rowoffsets displayorder + global rowidlist rowoffsets displayorder commitlisted global rowlaidout rowoptim global idinlist rowchk + global commitidx numcommits canvxmax canv + global nextcolor + global parentlist childlist children - set rowidlist(0) {} - set rowoffsets(0) {} + set commitidx 0 + set numcommits 0 + set displayorder {} + set commitlisted {} + set parentlist {} + set childlist {} + catch {unset children} + set nextcolor 0 + set rowidlist {{}} + set rowoffsets {{}} catch {unset idinlist} 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 {} { @@ -932,13 +972,16 @@ proc layoutmore {} { proc showstuff {canshow} { global numcommits - global canvy0 linespc global linesegends idrowranges idrangedrawn + if {$numcommits == 0} { + global phase + set phase "incrdraw" + allcanvs delete all + } 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] @@ -950,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 } } @@ -969,18 +1012,18 @@ 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 - set idlist $rowidlist($row) - set offs $rowoffsets($row) + set idlist [lindex $rowidlist $row] + set offs [lindex $rowoffsets $row] while {$row < $endrow} { 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)} { @@ -1001,29 +1044,30 @@ 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 } set rowchk($id) [expr {$row + $r}] } } - set rowidlist($row) $idlist - set rowoffsets($row) $offs + lset rowidlist $row $idlist + lset rowoffsets $row $offs } set col [lsearch -exact $idlist $id] if {$col < 0} { set col [llength $idlist] lappend idlist $id - set rowidlist($row) $idlist + lset rowidlist $row $idlist set z {} - if {$nchildren($id) > 0} { - set z [expr {[llength $rowidlist([expr {$row-1}])] - $col}] + if {[lindex $childlist $row] ne {}} { + set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}] unset idinlist($id) } lappend offs $z - set rowoffsets($row) $offs + lset rowoffsets $row $offs if {$z ne {}} { makeuparrow $id $col $row $z } @@ -1031,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 @@ -1065,55 +1108,61 @@ proc layoutrows {row endrow last} { makeuparrow $oid $col $row $o incr col } - set rowidlist($row) $idlist - set rowoffsets($row) $offs + lappend rowidlist $idlist + lappend rowoffsets $offs } return $row } proc addextraid {id row} { - global displayorder commitrow lineid 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 - set lineid($row) $id 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 $rowidlist($row) + set idlist [lindex $rowidlist $row] while {$idlist ne {}} { set col [expr {[llength $idlist] - 1}] 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] set idlist [lreplace $idlist $col $col] - set rowidlist($row) $idlist - set rowoffsets($row) $offs + lappend rowidlist $idlist + lappend rowoffsets $offs } foreach id [array names idinlist] { addextraid $id $row - set rowidlist($row) [list $id] - set rowoffsets($row) 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 {} + lappend rowoffsets {} } } @@ -1121,17 +1170,17 @@ proc insert_pad {row col npad} { global rowidlist rowoffsets set pad [ntimes $npad {}] - set rowidlist($row) [eval linsert \$rowidlist($row) $col $pad] - set tmp [eval linsert \$rowoffsets($row) $col $pad] - set rowoffsets($row) [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]] + lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad] + set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad] + lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]] } proc optimize_rows {row col endrow} { - global rowidlist rowoffsets idrowranges + global rowidlist rowoffsets idrowranges linesegends displayorder for {} {$row < $endrow} {incr row} { - set idlist $rowidlist($row) - set offs $rowoffsets($row) + set idlist [lindex $rowidlist $row] + set offs [lindex $rowoffsets $row] set haspad 0 for {} {$col < [llength $offs]} {incr col} { if {[lindex $idlist $col] eq {}} { @@ -1143,7 +1192,7 @@ proc optimize_rows {row col endrow} { set isarrow 0 set x0 [expr {$col + $z}] set y0 [expr {$row - 1}] - set z0 [lindex $rowoffsets($y0) $x0] + set z0 [lindex $rowoffsets $y0 $x0] if {$z0 eq {}} { set id [lindex $idlist $col] if {[info exists idrowranges($id)] && @@ -1160,11 +1209,11 @@ proc optimize_rows {row col endrow} { } set z [lindex $offs $col] set x0 [expr {$col + $z}] - set z0 [lindex $rowoffsets($y0) $x0] + set z0 [lindex $rowoffsets $y0 $x0] } elseif {$z > 1 || ($z > 0 && $isarrow)} { set npad [expr {$z - 1 + $isarrow}] set y1 [expr {$row + 1}] - set offs2 $rowoffsets($y1) + set offs2 [lindex $rowoffsets $y1] set x1 -1 foreach z $offs2 { incr x1 @@ -1172,7 +1221,7 @@ proc optimize_rows {row col endrow} { if {$x1 + $z > $col} { incr npad } - set rowoffsets($y1) [incrange $offs2 $x1 $npad] + lset rowoffsets $y1 [incrange $offs2 $x1 $npad] break } set pad [ntimes $npad {}] @@ -1183,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] @@ -1190,18 +1248,33 @@ 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 $rowoffsets($y1) + set offs2 [lindex $rowoffsets $y1] set x1 -1 foreach z $offs2 { incr x1 if {$z eq {} || $x1 + $z < $col} continue - set rowoffsets($y1) [incrange $offs2 $x1 1] + lset rowoffsets $y1 [incrange $offs2 $x1 1] break } set idlist [linsert $idlist $col {}] @@ -1210,8 +1283,8 @@ proc optimize_rows {row col endrow} { set offs [incrange $tmp $col -1] } } - set rowidlist($row) $idlist - set rowoffsets($row) $offs + lset rowidlist $row $idlist + lset rowoffsets $row $offs set col 0 } } @@ -1226,16 +1299,27 @@ 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}]] if {$startrow == $row} return assigncolor $id set coords {} - set col [lsearch -exact $rowidlist($row) $id] + set col [lsearch -exact [lindex $rowidlist $row] $id] if {$col < 0} { puts "oops: drawline: id $id not on row $row" return @@ -1243,7 +1327,7 @@ proc drawlineseg {id i wid} { set lasto {} set ns 0 while {1} { - set o [lindex $rowoffsets($row) $col] + set o [lindex $rowoffsets $row $col] if {$o eq {}} break if {$o ne $lasto} { # changing direction @@ -1255,38 +1339,81 @@ 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 rowoffsets 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] set y [yc $row] set y2 [yc $row2] - set ids $rowidlist($row2) - set offs $rowidlist($row2) + 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] @@ -1295,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 @@ -1308,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 $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] } } } @@ -1339,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}] @@ -1350,7 +1470,7 @@ proc drawcmittext {id row col rmx} { -fill $ofill -outline black -width 1] $canv raise $t $canv bind $t <1> {selcanvline {} %x %y} - set xt [xc $row [llength $rowidlist($row)]] + set xt [xc $row [llength [lindex $rowidlist $row]]] if {$xt < $rmx} { set xt $rmx } @@ -1371,15 +1491,20 @@ 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 rowoffsets + global displayorder rowidlist global idrowranges idrangedrawn iddrawn - global commitinfo commitlisted parents numcommits + global commitinfo parentlist numcommits - if {![info exists rowidlist($row)]} return - foreach id $rowidlist($row) { + if {$row >= $numcommits} return + foreach id [lindex $rowidlist $row] { if {![info exists idrowranges($id)]} continue set i -1 foreach {s e} $idrowranges($id) { @@ -1388,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 @@ -1398,22 +1523,18 @@ proc drawcmitrow {row} { set id [lindex $displayorder $row] if {[info exists iddrawn($id)]} return - set col [lsearch -exact $rowidlist($row) $id] + set col [lsearch -exact [lindex $rowidlist $row] $id] if {$col < 0} { puts "oops, row $row id $id not in list" 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 olds [lindex $parentlist $row] + if {$olds ne {}} { + set rmx [drawparentlinks $id $row $col $olds] } else { set rmx 0 } @@ -1456,16 +1577,23 @@ proc clear_display {} { } proc assigncolor {id} { - global colormap commcolors colors nextcolor - global parents nparents children nchildren + global colormap colors nextcolor + 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 } @@ -1498,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) } } } @@ -1526,19 +1652,6 @@ proc assigncolor {id} { set colormap($id) $c } -proc initgraph {} { - global numcommits nextcolor linespc - global nchildren - - allcanvs delete all - set nextcolor 0 - set numcommits 0 - foreach v {colormap cornercrossings crossings lineid} { - global $v - catch {unset $v} - } -} - proc bindline {t id} { global canv @@ -1616,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 $rowidlist($row) $id] + set i [lsearch -exact [lindex $rowidlist $row] $id] if {$i < 0} continue - set idlist $rowidlist([expr {$row+1}]) - foreach p $parents($id) { + set idlist [lindex $rowidlist [expr {$row+1}]] + foreach p [lindex $parentlist $row] { set j [lsearch -exact $idlist $p] if {$j > 0} { if {$j < $i - 1} { @@ -1640,7 +1753,7 @@ proc notecrossings {row id lo hi corner} { global rowidlist crossings cornercrossings for {set i $lo} {[incr i] < $hi} {} { - set p [lindex $rowidlist($row) $i] + set p [lindex [lindex $rowidlist $row] $i] if {$p == {}} continue if {$i == $corner} { if {![info exists cornercrossings($id)] @@ -1676,50 +1789,23 @@ proc xcoord {i level ln} { return $x } -proc drawcommit {id reading} { - global phase todo nchildren nextupdate - global displayorder parents - global commitrow commitidx lineid - - if {$phase != "incrdraw"} { - set phase incrdraw - set displayorder {} - set todo {} - set commitidx 0 - initlayout - initgraph - } - set commitrow($id) $commitidx - set lineid($commitidx) $id - incr commitidx - lappend displayorder $id -} - proc finishcommits {} { - global phase oldcommits commits + global commitidx phase global canv mainfont ctext maincursor textcursor - global parents todo + global findinprogress - if {$phase == "incrdraw" || $phase == "removecommits"} { - foreach id $oldcommits { - lappend commits $id - drawcommit $id 0 - } - set oldcommits {} + if {$commitidx > 0} { drawrest - } elseif {$phase == "updatecommits"} { - # there were no new commits, in fact - set commits $oldcommits - set oldcommits {} - set phase {} } 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, @@ -1734,7 +1820,6 @@ proc settextcursor {c} { } proc drawrest {} { - global phase global numcommits global startmsecs global canvy0 numcommits linespc @@ -1746,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" } @@ -1773,9 +1857,10 @@ proc findmatches {f} { proc dofind {} { global findtype findloc findstring markedmatches commitinfo - global numcommits lineid linehtag linentag linedtag + 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 @@ -1792,6 +1877,8 @@ proc dofind {} { } set foundstrlen [string length $findstring] if {$foundstrlen == 0} return + regsub -all {[*?\[\\]} $foundstring {\\&} matchstring + set matchstring "*$matchstring*" if {$findloc == "Files"} { findfiles return @@ -1803,8 +1890,21 @@ proc dofind {} { } set didsel 0 set fldtypes {Headline Author Date Committer CDate Comment} - for {set l 0} {$l < $numcommits} {incr l} { - set id $lineid($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 { @@ -1929,7 +2029,7 @@ proc stopfindproc {{done 0}} { proc findpatches {} { global findstring selectedline numcommits global findprocpid findprocfile - global finddidsel ctext lineid findinprogress + global finddidsel ctext displayorder findinprogress global findinsertpos if {$numcommits == 0} return @@ -1946,7 +2046,7 @@ proc findpatches {} { if {[incr l] >= $numcommits} { set l 0 } - append inputids $lineid($l) "\n" + append inputids [lindex $displayorder $l] "\n" } if {[catch { @@ -2017,8 +2117,8 @@ proc insertmatch {l id} { } proc findfiles {} { - global selectedline numcommits lineid ctext - global ffileline finddidsel parents nparents + global selectedline numcommits displayorder ctext + global ffileline finddidsel parentlist global findinprogress findstartline findinsertpos global treediffs fdiffid fdiffsneeded fdiffpos global findmergefiles @@ -2035,8 +2135,8 @@ proc findfiles {} { set diffsneeded {} set fdiffsneeded {} while 1 { - set id $lineid($l) - if {$findmergefiles || $nparents($id) == 1} { + set id [lindex $displayorder $l] + if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} { if {![info exists treediffs($id)]} { append diffsneeded "$id\n" lappend fdiffsneeded $id @@ -2064,11 +2164,11 @@ proc findfiles {} { set finddidsel 0 set findinsertpos end - set id $lineid($l) + set id [lindex $displayorder $l] . config -cursor watch settextcursor watch set findinprogress 1 - findcont $id + findcont update } @@ -2115,7 +2215,7 @@ proc donefilediff {} { set treediffs($nullid) {} if {[info exists findid] && $nullid eq $findid} { unset findid - findcont $nullid + findcont } incr fdiffpos } @@ -2126,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 lineid numcommits matchinglines findinprogress + 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 @@ -2161,7 +2262,6 @@ proc findcont {id} { set l 0 } if {$l == $findstartline} break - set id $lineid($l) } stopfindproc if {!$finddidsel} { @@ -2172,7 +2272,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)] @@ -2258,17 +2358,33 @@ 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 lineid linehtag linentag linedtag - global canvy0 linespc parents nparents children + global displayorder linehtag linentag linedtag + global canvy0 linespc parentlist childlist global cflist currentid sha1entry global commentend idtags linknum - global mergemax + global mergemax numcommits $canv delete hover normalline - if {![info exists lineid($l)]} return + if {$l < 0 || $l >= $numcommits} return set y [expr {$canvy0 + $l * $linespc}] set ymax [lindex [$canv cget -scrollregion] 3] set ytop [expr {$y - $linespc - 1}] @@ -2325,7 +2441,7 @@ proc selectline {l isnew} { set selectedline $l - set id $lineid($l) + set id [lindex $displayorder $l] set currentid $id $sha1entry delete 0 end $sha1entry insert 0 $id @@ -2351,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 { @@ -2364,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] @@ -2389,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 @@ -2404,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 @@ -2461,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 @@ -2476,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} { @@ -2491,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 @@ -2513,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 {} @@ -2554,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] } } @@ -2581,7 +2728,7 @@ proc addtocflist {ids} { } proc gettreediffs {ids} { - global treediff parents treepending + global treediff treepending set treepending $ids set treediff {} if {[catch \ @@ -2601,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 } @@ -2683,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]} { @@ -2758,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]} { @@ -2817,20 +2963,22 @@ proc sha1change {n1 n2 op} { } proc gotocommit {} { - global sha1string currentid commitrow tagids - global lineid numcommits + 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]} { set matches {} - for {set l 0} {$l < $numcommits} {incr l} { - if {[string match $id* $lineid($l)]} { - lappend matches $lineid($l) + foreach i $displayorder { + if {[string match $id* $i]} { + lappend matches $i } } if {$matches ne {}} { @@ -2849,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" } @@ -2858,7 +3006,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 @@ -2918,65 +3066,26 @@ proc linehover {} { } proc clickisonarrow {id y} { - global mainline mainlinearrow sidelines lthickness + global lthickness idrowranges set thresh [expr {2 * $lthickness + 6}] - if {[info exists mainline($id)]} { - if {$mainlinearrow($id) ne "none"} { - if {abs([lindex $mainline($id) 1] - $y) < $thresh} { - return "up" - } - } - } - if {[info exists sidelines($id)]} { - foreach ls $sidelines($id) { - set coords [lindex $ls 0] - set arrow [lindex $ls 2] - if {$arrow eq "first" || $arrow eq "both"} { - if {abs([lindex $coords 1] - $y) < $thresh} { - return "up" - } - } - if {$arrow eq "last" || $arrow eq "both"} { - if {abs([lindex $coords end] - $y) < $thresh} { - return "down" - } - } + set n [expr {[llength $idrowranges($id)] - 1}] + for {set i 1} {$i < $n} {incr i} { + set row [lindex $idrowranges($id) $i] + if {abs([yc $row] - $y) < $thresh} { + return $i } } return {} } -proc arrowjump {id dirn y} { - global mainline sidelines canv canv2 canv3 +proc arrowjump {id n y} { + global idrowranges canv - set yt {} - if {$dirn eq "down"} { - if {[info exists mainline($id)]} { - set y1 [lindex $mainline($id) 1] - if {$y1 > $y} { - set yt $y1 - } - } - if {[info exists sidelines($id)]} { - foreach ls $sidelines($id) { - set y1 [lindex $ls 0 1] - if {$y1 > $y && ($yt eq {} || $y1 < $yt)} { - set yt $y1 - } - } - } - } else { - if {[info exists sidelines($id)]} { - foreach ls $sidelines($id) { - set y1 [lindex $ls 0 end] - if {$y1 < $y && ($yt eq {} || $y1 > $yt)} { - set yt $y1 - } - } - } - } - if {$yt eq {}} return + # 1 <-> 2, 3 <-> 4, etc... + set n [expr {(($n - 1) ^ 1) + 1}] + set row [lindex $idrowranges($id) $n] + set yt [yc $row] set ymax [lindex [$canv cget -scrollregion] 3] if {$ymax eq {} || $ymax <= 0} return set view [$canv yview] @@ -2985,21 +3094,20 @@ proc arrowjump {id dirn y} { if {$yfrac < 0} { set yfrac 0 } - $canv yview moveto $yfrac - $canv2 yview moveto $yfrac - $canv3 yview moveto $yfrac + allcanvs yview moveto $yfrac } 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 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 @@ -3029,11 +3137,13 @@ 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) $ctext insert end "\n\t" $ctext insert end $child [list link link$i] @@ -3052,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 } } @@ -3088,15 +3199,15 @@ proc rowmenu {x y id} { } proc diffvssel {dirn} { - global rowmenuid selectedline lineid + global rowmenuid selectedline displayorder if {![info exists selectedline]} return if {$dirn} { - set oldid $lineid($selectedline) + set oldid [lindex $displayorder $selectedline] set newid $rowmenuid } else { set oldid $rowmenuid - set newid $lineid($selectedline) + set newid [lindex $displayorder $selectedline] } addtohistory [list doseldiff $oldid $newid] doseldiff $oldid $newid @@ -3377,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]] @@ -3786,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 @@ -3814,6 +3925,13 @@ foreach arg $argv { } } +# check that we can find a .git directory somewhere... +set gitdir [gitdir] +if {![file isdirectory $gitdir]} { + error_popup "Cannot find the git directory \"$gitdir\"." + exit 1 +} + set history {} set historyindex 0