X-Git-Url: https://git.octo.it/?a=blobdiff_plain;f=gitk;h=7c25d2ef9702b696fdec62b07943a868260dc4ea;hb=cb303a949f0a6eaa32125b6a52acb9476f71632f;hp=9c435873f90a6c601acbfc365068a908dbe32482;hpb=f3408449622cad37ce29f23754c8e7a8fb453ff1;p=git.git diff --git a/gitk b/gitk index 9c435873..7c25d2ef 100755 --- a/gitk +++ b/gitk @@ -16,37 +16,26 @@ proc gitdir {} { } } -proc parse_args {rargs} { - global parsed_args - - if {[catch { - set parse_args [concat --default HEAD $rargs] - set parsed_args [split [eval exec git-rev-parse $parse_args] "\n"] - }]} { - # if git-rev-parse failed for some reason... - if {$rargs == {}} { - set rargs HEAD - } - set parsed_args $rargs - } - return $parsed_args -} - -proc start_rev_list {rlargs} { +proc start_rev_list {} { global startmsecs nextupdate ncmupdate global commfd leftover tclencoding datemode + global revtreeargs curview viewfiles set startmsecs [clock clicks -milliseconds] set nextupdate [expr {$startmsecs + 100}] set ncmupdate 1 initlayout + set args $revtreeargs + if {$viewfiles($curview) ne {}} { + set args [concat $args "--" $viewfiles($curview)] + } set order "--topo-order" if {$datemode} { set order "--date-order" } if {[catch { set commfd [open [concat | git-rev-list --header $order \ - --parents --boundary $rlargs] r] + --parents --boundary --default HEAD $args] r] } err]} { puts stderr "Error executing git-rev-list: $err" exit 1 @@ -61,11 +50,23 @@ proc start_rev_list {rlargs} { settextcursor watch } -proc getcommits {rargs} { +proc stop_rev_list {} { + global commfd + + if {![info exists commfd]} return + catch { + set pid [pid $commfd] + exec kill $pid + } + catch {close $commfd} + unset commfd +} + +proc getcommits {} { global phase canv mainfont set phase getcommits - start_rev_list [parse_args $rargs] + start_rev_list $canv delete all $canv create text 3 3 -anchor nw -text "Reading commits..." \ -font $mainfont -tags textitems @@ -75,6 +76,7 @@ proc getcommitlines {commfd} { global commitlisted nextupdate global leftover global displayorder commitidx commitrow commitdata + global parentlist childlist children set stuff [read $commfd] if {$stuff == {}} { @@ -140,15 +142,28 @@ proc getcommitlines {commfd} { set id [lindex $ids 0] if {$listed} { set olds [lrange $ids 1 end] - set commitlisted($id) 1 + set i 0 + foreach p $olds { + if {$i == 0 || [lsearch -exact $olds $p] >= $i} { + lappend children($p) $id + } + incr i + } } else { set olds {} } - updatechildren $id $olds + lappend parentlist $olds + if {[info exists children($id)]} { + lappend childlist $children($id) + unset 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} { @@ -181,43 +196,21 @@ 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 - mergefilelist currentid rowtextx commitrow - rowidlist rowoffsets idrowranges idrangedrawn iddrawn - linesegends crossings cornercrossings} { - global $v - catch {unset $v} - } - allcanvs delete all - readrefs - getcommits $rargs -} - -proc updatechildren {id olds} { - global children nchildren parents nparents +proc updatecommits {} { + global viewdata curview revtreeargs phase - 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) - } + if {$phase ne {}} { + stop_rev_list + set phase {} } + set n $curview + set curview -1 + catch {unset viewdata($n)} + readrefs + showview $n } proc parsecommit {id contents listed} { @@ -274,7 +267,7 @@ proc parsecommit {id contents listed} { } proc getcommit {id} { - global commitdata commitinfo nparents + global commitdata commitinfo if {[info exists commitdata($id)]} { parsecommit $id $commitdata($id) 1 @@ -282,7 +275,6 @@ proc getcommit {id} { readcommit $id if {![info exists commitinfo($id)]} { set commitinfo($id) {"No commit information available"} - set nparents($id) 0 } } return 1 @@ -295,16 +287,22 @@ 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]} { continue } + if {[regexp {^remotes/.*/HEAD$} $path match]} { + continue + } if {![regexp {^(tags|heads)/(.*)$} $path match type name]} { set type others set name $path } + if {[regexp {^remotes/} $path match]} { + set type heads + } if {$type == "tags"} { set tagids($name) $id lappend idtags($id) $name @@ -345,8 +343,9 @@ proc error_popup msg { tkwait window $w } -proc makewindow {rargs} { - global canv canv2 canv3 linespc charspc ctext cflist textfont +proc makewindow {} { + global canv canv2 canv3 linespc charspc ctext cflist + global textfont mainfont uifont global findtype findtypemenu findloc findstring fstring geometry global entries sha1entry sha1string sha1but global maincursor textcursor curtextcursor @@ -354,16 +353,29 @@ 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 "Update" -command updatecommits .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.view -font $uifont + .bar add cascade -label "View" -menu .bar.view + .bar.view add command -label "New view..." -command newview + .bar.view add command -label "Edit view..." -command editview + .bar.view add command -label "Delete view" -command delview -state disabled + .bar.view add separator + .bar.view add radiobutton -label "All files" -command {showview 0} \ + -variable selectedview -value 0 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)]} { @@ -410,7 +422,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 @@ -440,19 +452,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 @@ -499,7 +516,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 @@ -512,14 +529,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" @@ -568,6 +593,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 @@ -599,9 +637,10 @@ 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 + global viewname viewfiles viewperm nextviewnum if {$stuffsaved} return if {![winfo viewable .]} return @@ -609,6 +648,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] @@ -624,6 +664,13 @@ proc savestuff {w} { set wid [expr {([winfo width $cflist] - 11) \ / [font measure [$cflist cget -font] "0"]}] puts $f "set geometry(cflistw) $wid" + puts -nonewline $f "set permviews {" + for {set v 0} {$v < $nextviewnum} {incr v} { + if {$viewperm($v)} { + puts $f "{[list $viewname($v) $viewfiles($v)]}" + } + } + puts $f "}" close $f file rename -force "~/.gitk-new" "~/.gitk" } @@ -716,6 +763,329 @@ 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 newview {} { + global nextviewnum newviewname newviewperm uifont + + set top .gitkview + if {[winfo exists $top]} { + raise $top + return + } + set newviewname($nextviewnum) "View $nextviewnum" + set newviewperm($nextviewnum) 0 + vieweditor $top $nextviewnum "Gitk view definition" +} + +proc editview {} { + global curview + global viewname viewperm newviewname newviewperm + + set top .gitkvedit-$curview + if {[winfo exists $top]} { + raise $top + return + } + set newviewname($curview) $viewname($curview) + set newviewperm($curview) $viewperm($curview) + vieweditor $top $curview "Gitk: edit view $viewname($curview)" +} + +proc vieweditor {top n title} { + global newviewname newviewperm viewfiles + global uifont + + toplevel $top + wm title $top $title + label $top.nl -text "Name" -font $uifont + entry $top.name -width 20 -textvariable newviewname($n) + grid $top.nl $top.name -sticky w -pady 5 + checkbutton $top.perm -text "Remember this view" -variable newviewperm($n) + grid $top.perm - -pady 5 -sticky w + message $top.l -aspect 500 -font $uifont \ + -text "Enter files and directories to include, one per line:" + grid $top.l - -sticky w + text $top.t -width 40 -height 10 -background white + if {[info exists viewfiles($n)]} { + foreach f $viewfiles($n) { + $top.t insert end $f + $top.t insert end "\n" + } + $top.t delete {end - 1c} end + $top.t mark set insert 0.0 + } + grid $top.t - -sticky w -padx 5 + frame $top.buts + button $top.buts.ok -text "OK" -command [list newviewok $top $n] + button $top.buts.can -text "Cancel" -command [list destroy $top] + grid $top.buts.ok $top.buts.can + grid columnconfigure $top.buts 0 -weight 1 -uniform a + grid columnconfigure $top.buts 1 -weight 1 -uniform a + grid $top.buts - -pady 10 -sticky ew + focus $top.t +} + +proc viewmenuitem {n} { + set nmenu [.bar.view index end] + set targetcmd [list showview $n] + for {set i 6} {$i <= $nmenu} {incr i} { + if {[.bar.view entrycget $i -command] eq $targetcmd} { + return $i + } + } + return {} +} + +proc newviewok {top n} { + global nextviewnum newviewperm newviewname + global viewname viewfiles viewperm selectedview curview + + set files {} + foreach f [split [$top.t get 0.0 end] "\n"] { + set ft [string trim $f] + if {$ft ne {}} { + lappend files $ft + } + } + if {![info exists viewfiles($n)]} { + # creating a new view + incr nextviewnum + set viewname($n) $newviewname($n) + set viewperm($n) $newviewperm($n) + set viewfiles($n) $files + .bar.view add radiobutton -label $viewname($n) \ + -command [list showview $n] -variable selectedview -value $n + after idle showview $n + } else { + # editing an existing view + set viewperm($n) $newviewperm($n) + if {$newviewname($n) ne $viewname($n)} { + set viewname($n) $newviewname($n) + set i [viewmenuitem $n] + if {$i ne {}} { + .bar.view entryconf $i -label $viewname($n) + } + } + if {$files ne $viewfiles($n)} { + set viewfiles($n) $files + if {$curview == $n} { + after idle updatecommits + } + } + } + catch {destroy $top} +} + +proc delview {} { + global curview viewdata viewperm + + if {$curview == 0} return + set i [viewmenuitem $curview] + if {$i ne {}} { + .bar.view delete $i + } + set viewdata($curview) {} + set viewperm($curview) 0 + showview 0 +} + +proc flatten {var} { + global $var + + set ret {} + foreach i [array names $var] { + lappend ret $i [set $var\($i\)] + } + return $ret +} + +proc unflatten {var l} { + global $var + + catch {unset $var} + foreach {i v} $l { + set $var\($i\) $v + } +} + +proc showview {n} { + global curview viewdata viewfiles + global displayorder parentlist childlist rowidlist rowoffsets + global colormap rowtextx commitrow + global numcommits rowrangelist commitlisted idrowranges + global selectedline currentid canv canvy0 + global matchinglines treediffs + global pending_select phase + global commitidx rowlaidout rowoptim linesegends leftover + global commfd nextupdate + global selectedview + + if {$n == $curview} return + set selid {} + if {[info exists selectedline]} { + set selid $currentid + set y [yc $selectedline] + set ymax [lindex [$canv cget -scrollregion] 3] + set span [$canv yview] + set ytop [expr {[lindex $span 0] * $ymax}] + set ybot [expr {[lindex $span 1] * $ymax}] + if {$ytop < $y && $y < $ybot} { + set yscreen [expr {$y - $ytop}] + } else { + set yscreen [expr {($ybot - $ytop) / 2}] + } + } + unselectline + normalline + stopfindproc + if {$curview >= 0} { + if {$phase ne {}} { + set viewdata($curview) \ + [list $phase $displayorder $parentlist $childlist $rowidlist \ + $rowoffsets $rowrangelist $commitlisted \ + [flatten children] [flatten idrowranges] \ + [flatten idinlist] \ + $commitidx $rowlaidout $rowoptim $numcommits \ + $linesegends $leftover $commfd] + fileevent $commfd readable {} + } elseif {![info exists viewdata($curview)] + || [lindex $viewdata($curview) 0] ne {}} { + set viewdata($curview) \ + [list {} $displayorder $parentlist $childlist $rowidlist \ + $rowoffsets $rowrangelist $commitlisted] + } + } + catch {unset matchinglines} + catch {unset treediffs} + clear_display + + set curview $n + set selectedview $n + .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}] + .bar.view entryconf 3 -state [expr {$n == 0? "disabled": "normal"}] + + if {![info exists viewdata($n)]} { + set pending_select $selid + getcommits + return + } + + set v $viewdata($n) + set phase [lindex $v 0] + set displayorder [lindex $v 1] + set parentlist [lindex $v 2] + set childlist [lindex $v 3] + set rowidlist [lindex $v 4] + set rowoffsets [lindex $v 5] + set rowrangelist [lindex $v 6] + set commitlisted [lindex $v 7] + if {$phase eq {}} { + set numcommits [llength $displayorder] + catch {unset idrowranges} + catch {unset children} + } else { + unflatten children [lindex $v 8] + unflatten idrowranges [lindex $v 9] + unflatten idinlist [lindex $v 10] + set commitidx [lindex $v 11] + set rowlaidout [lindex $v 12] + set rowoptim [lindex $v 13] + set numcommits [lindex $v 14] + set linesegends [lindex $v 15] + set leftover [lindex $v 16] + set commfd [lindex $v 17] + fileevent $commfd readable [list getcommitlines $commfd] + set nextupdate [expr {[clock clicks -milliseconds] + 100}] + } + + catch {unset colormap} + catch {unset rowtextx} + catch {unset commitrow} + set curview $n + set row 0 + foreach id $displayorder { + set commitrow($id) $row + incr row + } + setcanvscroll + set yf 0 + set row 0 + if {$selid ne {} && [info exists commitrow($selid)]} { + set row $commitrow($selid) + # try to get the selected row in the same position on the screen + set ymax [lindex [$canv cget -scrollregion] 3] + set ytop [expr {[yc $row] - $yscreen}] + if {$ytop < 0} { + set ytop 0 + } + set yf [expr {$ytop * 1.0 / $ymax}] + } + allcanvs yview moveto $yf + drawvisible + selectline $row 0 + if {$phase eq {}} { + global maincursor textcursor + . config -cursor $maincursor + settextcursor $textcursor + } else { + . config -cursor watch + settextcursor watch + if {$phase eq "getcommits"} { + global mainfont + $canv create text 3 3 -anchor nw -text "Reading commits..." \ + -font $mainfont -tags textitems + } + } +} + proc shortids {ids} { set res {} foreach id $ids { @@ -751,20 +1121,21 @@ proc ntimes {n o} { } proc usedinrange {id l1 l2} { - global children commitrow + global children commitrow childlist if {[info exists commitrow($id)]} { set r $commitrow($id) if {$l1 <= $r && $r <= $l2} { return [expr {$r - $l1 + 1}] } + set kids [lindex $childlist $r] + } else { + set kids $children($id) } - foreach c $children($id) { - if {[info exists commitrow($c)]} { - set r $commitrow($c) - if {$l1 <= $r && $r <= $l2} { - return [expr {$r - $l1 + 1}] - } + foreach c $kids { + set r $commitrow($c) + if {$l1 <= $r && $r <= $l2} { + return [expr {$r - $l1 + 1}] } } return 0 @@ -830,15 +1201,23 @@ 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 idinlist rowchk rowrangelist idrowranges + global commitidx numcommits canvxmax canv global nextcolor + global parentlist childlist children + global colormap rowtextx commitrow + global linesegends set commitidx 0 set numcommits 0 set displayorder {} + set commitlisted {} + set parentlist {} + set childlist {} + set rowrangelist {} + catch {unset children} set nextcolor 0 set rowidlist {{}} set rowoffsets {{}} @@ -846,6 +1225,21 @@ proc initlayout {} { catch {unset rowchk} set rowlaidout 0 set rowoptim 0 + set canvxmax [$canv cget -width] + catch {unset colormap} + catch {unset rowtextx} + catch {unset commitrow} + catch {unset idrowranges} + set linesegends {} +} + +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 {} { @@ -875,7 +1269,6 @@ proc layoutmore {} { set rowlaidout [layoutrows $row $commitidx 0] set orow [expr {$rowlaidout - $uparrowlen - 1}] if {$orow > $rowoptim} { - checkcrossings $rowoptim $orow optimize_rows $rowoptim 0 $orow set rowoptim $orow } @@ -886,8 +1279,7 @@ proc layoutmore {} { } proc showstuff {canshow} { - global numcommits - global canvy0 linespc + global numcommits commitrow pending_select selectedline global linesegends idrowranges idrangedrawn if {$numcommits == 0} { @@ -897,22 +1289,20 @@ 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] + set selrow -1 for {set r $row} {$r < $canshow} {incr r} { - if {[info exists linesegends($r)]} { - foreach id $linesegends($r) { - set i -1 - foreach {s e} $idrowranges($id) { - incr i - if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0 - && ![info exists idrangedrawn($id,$i)]} { - drawlineseg $id $i - set idrangedrawn($id,$i) 1 - } + foreach id [lindex $linesegends [expr {$r+1}]] { + set i -1 + foreach {s e} [rowranges $id] { + incr i + if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0 + && ![info exists idrangedrawn($id,$i)]} { + drawlineseg $id $i + set idrangedrawn($id,$i) 1 } } } @@ -924,15 +1314,23 @@ proc showstuff {canshow} { drawcmitrow $row incr row } + if {[info exists pending_select] && + [info exists commitrow($pending_select)] && + $commitrow($pending_select) < $numcommits} { + selectline $commitrow($pending_select) 1 + } + if {![info exists selectedline] && ![info exists pending_select]} { + selectline 0 1 + } } 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 + global idinlist rowchk rowrangelist set idlist [lindex $rowidlist $row] set offs [lindex $rowoffsets $row] @@ -940,13 +1338,14 @@ 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)} { lappend oldolds $p } } + set lse {} set nev [expr {[llength $idlist] + [llength $newolds] + [llength $oldolds] - $maxwidth + 1}] if {$nev > 0} { @@ -962,7 +1361,7 @@ proc layoutrows {row endrow last} { set offs [incrange $offs $x 1] set idinlist($i) 0 set rm1 [expr {$row - 1}] - lappend linesegends($rm1) $i + lappend lse $i lappend idrowranges($i) $rm1 if {[incr nev -1] <= 0} break continue @@ -973,13 +1372,14 @@ proc layoutrows {row endrow last} { lset rowidlist $row $idlist lset rowoffsets $row $offs } + lappend linesegends $lse set col [lsearch -exact $idlist $id] if {$col < 0} { set col [llength $idlist] 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) } @@ -991,9 +1391,13 @@ proc layoutrows {row endrow last} { } else { unset idinlist($id) } + set ranges {} if {[info exists idrowranges($id)]} { - lappend idrowranges($id) $row + set ranges $idrowranges($id) + lappend ranges $row + unset idrowranges($id) } + lappend rowrangelist $ranges incr row set offs [ntimes [llength $idlist] 0] set l [llength $newolds] @@ -1032,22 +1436,30 @@ 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) + unset children($id) + } else { + lappend childlist {} } } proc layouttail {} { global rowidlist rowoffsets idinlist commitidx - global idrowranges + global idrowranges rowrangelist set row $commitidx set idlist [lindex $rowidlist $row] @@ -1057,6 +1469,8 @@ proc layouttail {} { addextraid $id $row unset idinlist($id) lappend idrowranges($id) $row + lappend rowrangelist $idrowranges($id) + unset idrowranges($id) incr row set offs [ntimes $col 0] set idlist [lreplace $idlist $col $col] @@ -1070,6 +1484,8 @@ proc layouttail {} { lset rowoffsets $row 0 makeuparrow $id 0 $row 0 lappend idrowranges($id) $row + lappend rowrangelist $idrowranges($id) + unset idrowranges($id) incr row lappend rowidlist {} lappend rowoffsets {} @@ -1086,23 +1502,12 @@ proc insert_pad {row col npad} { } proc optimize_rows {row col endrow} { - global rowidlist rowoffsets idrowranges linesegends displayorder + global rowidlist rowoffsets idrowranges displayorder for {} {$row < $endrow} {incr row} { set idlist [lindex $rowidlist $row] set offs [lindex $rowoffsets $row] set haspad 0 - set downarrowcols {} - if {[info exists linesegends($row)]} { - set downarrowcols $linesegends($row) - if {$col > 0} { - while {$downarrowcols ne {}} { - set i [lsearch -exact $idlist [lindex $downarrowcols 0]] - if {$i < 0 || $i >= $col} break - set downarrowcols [lrange $downarrowcols 1 end] - } - } - } for {} {$col < [llength $offs]} {incr col} { if {[lindex $idlist $col] eq {}} { set haspad 1 @@ -1116,14 +1521,10 @@ proc optimize_rows {row col endrow} { set z0 [lindex $rowoffsets $y0 $x0] if {$z0 eq {}} { set id [lindex $idlist $col] - if {[info exists idrowranges($id)] && - $y0 > [lindex $idrowranges($id) 0]} { + set ranges [rowranges $id] + if {$ranges ne {} && $y0 > [lindex $ranges 0]} { set isarrow 1 } - } elseif {$downarrowcols ne {} && - [lindex $idlist $col] eq [lindex $downarrowcols 0]} { - set downarrowcols [lrange $downarrowcols 1 end] - set isarrow 1 } if {$z < -1 || ($z < 0 && $isarrow)} { set npad [expr {-1 - $z + $isarrow}] @@ -1179,8 +1580,8 @@ proc optimize_rows {row col endrow} { 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]} { + set ranges [rowranges $id] + if {$ranges ne {} && $row == [lindex $ranges 0]} { # it is, work out offset to child set y0 [expr {$row - 1}] set id [lindex $displayorder $y0] @@ -1234,13 +1635,34 @@ proc linewidth {id} { return $wid } +proc rowranges {id} { + global phase idrowranges commitrow rowlaidout rowrangelist + + set ranges {} + if {$phase eq {} || + ([info exists commitrow($id)] && $commitrow($id) < $rowlaidout)} { + set ranges [lindex $rowrangelist $commitrow($id)] + } elseif {[info exists idrowranges($id)]} { + set ranges $idrowranges($id) + } + return $ranges +} + proc drawlineseg {id i} { - global rowoffsets rowidlist idrowranges + global rowoffsets rowidlist global displayorder - global canv colormap + global canv colormap linespc + global numcommits commitrow - set startrow [lindex $idrowranges($id) [expr {2 * $i}]] - set row [lindex $idrowranges($id) [expr {2 * $i + 1}]] + set ranges [rowranges $id] + set downarrow 1 + if {[info exists commitrow($id)] && $commitrow($id) < $numcommits} { + set downarrow [expr {$i < [llength $ranges] / 2 - 1}] + } else { + set downarrow 1 + } + set startrow [lindex $ranges [expr {2 * $i}]] + set row [lindex $ranges [expr {2 * $i + 1}]] if {$startrow == $row} return assigncolor $id set coords {} @@ -1284,8 +1706,27 @@ proc drawlineseg {id i} { } } if {[llength $coords] < 4} return - set last [expr {[llength $idrowranges($id)] / 2 - 1}] - set arrow [expr {2 * ($i > 0) + ($i < $last)}] + if {$downarrow} { + # 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) + $downarrow}] 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] @@ -1294,7 +1735,7 @@ proc drawlineseg {id i} { } proc drawparentlinks {id row col olds} { - global rowidlist canv colormap idrowranges + global rowidlist canv colormap set row2 [expr {$row + 1}] set x [xc $row $col] @@ -1313,9 +1754,9 @@ proc drawparentlinks {id row col olds} { if {$x2 > $rmx} { set rmx $x2 } - if {[info exists idrowranges($p)] && - $row2 == [lindex $idrowranges($p) 0] && - $row2 < [lindex $idrowranges($p) 1]} { + set ranges [rowranges $p] + if {$ranges ne {} && $row2 == [lindex $ranges 0] + && $row2 < [lindex $ranges 1]} { # drawlineseg will do this one for us continue } @@ -1338,24 +1779,22 @@ proc drawparentlinks {id row col olds} { proc drawlines {id} { global colormap canv - global idrowranges idrangedrawn - global children iddrawn commitrow rowidlist + global idrangedrawn + global childlist iddrawn commitrow rowidlist $canv delete lines.$id - set nr [expr {[llength $idrowranges($id)] / 2}] + set nr [expr {[llength [rowranges $id]] / 2}] for {set i 0} {$i < $nr} {incr i} { if {[info exists idrangedrawn($id,$i)]} { 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] - } + 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] } } } @@ -1366,9 +1805,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}] @@ -1398,18 +1837,23 @@ 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 idrangedrawn iddrawn + global commitinfo parentlist numcommits if {$row >= $numcommits} return foreach id [lindex $rowidlist $row] { - if {![info exists idrowranges($id)]} continue + if {$id eq {}} continue set i -1 - foreach {s e} $idrowranges($id) { + foreach {s e} [rowranges $id] { incr i if {$row < $s} continue if {$e eq {}} break @@ -1434,9 +1878,9 @@ proc drawcmitrow {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)] + set olds [lindex $parentlist $row] + if {$olds ne {}} { + set rmx [drawparentlinks $id $row $col $olds] } else { set rmx 0 } @@ -1478,60 +1922,95 @@ proc clear_display {} { catch {unset idrangedrawn} } +proc findcrossings {id} { + global rowidlist parentlist numcommits rowoffsets displayorder + + set cross {} + set ccross {} + foreach {s e} [rowranges $id] { + if {$e >= $numcommits} { + set e [expr {$numcommits - 1}] + } + if {$e <= $s} continue + set x [lsearch -exact [lindex $rowidlist $e] $id] + if {$x < 0} { + puts "findcrossings: oops, no [shortids $id] in row $e" + continue + } + for {set row $e} {[incr row -1] >= $s} {} { + set olds [lindex $parentlist $row] + set kid [lindex $displayorder $row] + set kidx [lsearch -exact [lindex $rowidlist $row] $kid] + if {$kidx < 0} continue + set nextrow [lindex $rowidlist [expr {$row + 1}]] + foreach p $olds { + set px [lsearch -exact $nextrow $p] + if {$px < 0} continue + if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} { + if {[lsearch -exact $ccross $p] >= 0} continue + if {$x == $px + ($kidx < $px? -1: 1)} { + lappend ccross $p + } elseif {[lsearch -exact $cross $p] < 0} { + lappend cross $p + } + } + } + set inc [lindex $rowoffsets $row $x] + if {$inc eq {}} break + incr x $inc + } + } + return [concat $ccross {{}} $cross] +} + proc assigncolor {id} { global colormap colors nextcolor - global parents nparents children nchildren - global cornercrossings crossings + global commitrow parentlist children childlist 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 } } set badcolors {} - if {[info exists cornercrossings($id)]} { - foreach x $cornercrossings($id) { - if {[info exists colormap($x)] - && [lsearch -exact $badcolors $colormap($x)] < 0} { - lappend badcolors $colormap($x) - } + set origbad {} + foreach x [findcrossings $id] { + if {$x eq {}} { + # delimiter between corner crossings and other crossings + if {[llength $badcolors] >= $ncolors - 1} break + set origbad $badcolors } - if {[llength $badcolors] >= $ncolors} { - set badcolors {} + if {[info exists colormap($x)] + && [lsearch -exact $badcolors $colormap($x)] < 0} { + lappend badcolors $colormap($x) } } - set origbad $badcolors - if {[llength $badcolors] < $ncolors - 1} { - if {[info exists crossings($id)]} { - foreach x $crossings($id) { - if {[info exists colormap($x)] - && [lsearch -exact $badcolors $colormap($x)] < 0} { - lappend badcolors $colormap($x) - } - } - if {[llength $badcolors] >= $ncolors} { - set badcolors $origbad - } - } - set origbad $badcolors + if {[llength $badcolors] >= $ncolors} { + set badcolors $origbad } + 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) } } } @@ -1615,6 +2094,14 @@ proc drawtags {id x xt y1} { set xl [expr {$xl - $delta/2}] $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \ -width 1 -outline black -fill $col -tags tag.$id + if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} { + set rwid [font measure $mainfont $remoteprefix] + set xi [expr {$x + 1}] + set yti [expr {$yt + 1}] + set xri [expr {$x + $rwid}] + $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \ + -width 0 -fill "#ffddaa" -tags tag.$id + } } set t [$canv create text $xl $y1 -anchor w -text $tag \ -font $mainfont -tags tag.$id] @@ -1625,55 +2112,6 @@ proc drawtags {id x xt y1} { return $xt } -proc checkcrossings {row endrow} { - global displayorder parents 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) { - set j [lsearch -exact $idlist $p] - if {$j > 0} { - if {$j < $i - 1} { - notecrossings $row $p $j $i [expr {$j+1}] - } elseif {$j > $i + 1} { - notecrossings $row $p $i $j [expr {$j-1}] - } - } - } - } -} - -proc notecrossings {row id lo hi corner} { - global rowidlist crossings cornercrossings - - for {set i $lo} {[incr i] < $hi} {} { - set p [lindex [lindex $rowidlist $row] $i] - if {$p == {}} continue - if {$i == $corner} { - if {![info exists cornercrossings($id)] - || [lsearch -exact $cornercrossings($id) $p] < 0} { - lappend cornercrossings($id) $p - } - if {![info exists cornercrossings($p)] - || [lsearch -exact $cornercrossings($p) $id] < 0} { - lappend cornercrossings($p) $id - } - } else { - if {![info exists crossings($id)] - || [lsearch -exact $crossings($id) $p] < 0} { - lappend crossings($id) $p - } - if {![info exists crossings($p)] - || [lsearch -exact $crossings($p) $id] < 0} { - lappend crossings($p) $id - } - } - } -} - proc xcoord {i level ln} { global canvx0 xspc1 xspc2 @@ -1689,7 +2127,7 @@ proc xcoord {i level ln} { proc finishcommits {} { global commitidx phase global canv mainfont ctext maincursor textcursor - global findinprogress + global findinprogress pending_select if {$commitidx > 0} { drawrest @@ -1703,6 +2141,7 @@ proc finishcommits {} { settextcursor $textcursor } set phase {} + catch {unset pending_select} } # Don't change the text pane cursor if it is currently the hand cursor, @@ -1721,12 +2160,16 @@ proc drawrest {} { global startmsecs global canvy0 numcommits linespc global rowlaidout commitidx + global pending_select set row $rowlaidout layoutrows $rowlaidout $commitidx 1 layouttail optimize_rows $row 0 $commitidx showstuff $commitidx + if {[info exists pending_select]} { + selectline 0 1 + } set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}] #puts "overall $drawmsecs ms for $numcommits commits" @@ -1916,7 +2359,7 @@ proc stopfindproc {{done 0}} { } if {[info exists findinprogress]} { unset findinprogress - if {$phase != "incrdraw"} { + if {$phase eq {}} { . config -cursor $maincursor settextcursor $textcursor } @@ -2015,7 +2458,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 @@ -2033,7 +2476,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 @@ -2065,7 +2508,7 @@ proc findfiles {} { . config -cursor watch settextcursor watch set findinprogress 1 - findcont $id + findcont update } @@ -2112,7 +2555,7 @@ proc donefilediff {} { set treediffs($nullid) {} if {[info exists findid] && $nullid eq $findid} { unset findid - findcont $nullid + findcont } incr fdiffpos } @@ -2123,20 +2566,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 @@ -2158,7 +2602,6 @@ proc findcont {id} { set l 0 } if {$l == $findstartline} break - set id [lindex $displayorder $l] } stopfindproc if {!$finddidsel} { @@ -2255,14 +2698,31 @@ 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 + global mergemax numcommits pending_select + catch {unset pending_select} $canv delete hover normalline if {$l < 0 || $l >= $numcommits} return @@ -2348,9 +2808,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 { @@ -2361,17 +2822,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] @@ -2386,13 +2843,25 @@ proc selectline {l isnew} { $cflist delete 0 end $cflist insert end "Comments" - if {$nparents($id) <= 1} { + if {[llength $olds] <= 1} { startdiff $id } else { - mergediff $id + 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 @@ -2401,25 +2870,46 @@ 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 + global selectedline currentid catch {unset selectedline} + catch {unset currentid} allcanvs delete secsel } proc addtohistory {cmd} { - global history historyindex + global history historyindex curview + set elt [list $curview $cmd] if {$historyindex > 0 - && [lindex $history [expr {$historyindex - 1}]] == $cmd} { + && [lindex $history [expr {$historyindex - 1}]] == $elt} { return } if {$historyindex < [llength $history]} { - set history [lreplace $history $historyindex end $cmd] + set history [lreplace $history $historyindex end $elt] } else { - lappend history $cmd + lappend history $elt } incr historyindex if {$historyindex > 1} { @@ -2430,13 +2920,23 @@ proc addtohistory {cmd} { .ctop.top.bar.rightbut conf -state disabled } +proc godo {elt} { + global curview + + set view [lindex $elt 0] + set cmd [lindex $elt 1] + if {$curview != $view} { + showview $view + } + eval $cmd +} + proc goback {} { global history historyindex if {$historyindex > 1} { incr historyindex -1 - set cmd [lindex $history [expr {$historyindex - 1}]] - eval $cmd + godo [lindex $history [expr {$historyindex - 1}]] .ctop.top.bar.rightbut conf -state normal } if {$historyindex <= 1} { @@ -2450,7 +2950,7 @@ proc goforw {} { if {$historyindex < [llength $history]} { set cmd [lindex $history $historyindex] incr historyindex - eval $cmd + godo $cmd .ctop.top.bar.leftbut conf -state normal } if {$historyindex >= [llength $history]} { @@ -2458,9 +2958,10 @@ proc goforw {} { } } -proc mergediff {id} { - global parents diffmergeid diffopts mdifffd +proc mergediff {id l} { + global diffmergeid diffopts mdifffd global difffilestart diffids + global parentlist set diffmergeid $id set diffids $id @@ -2474,12 +2975,13 @@ 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 +proc getmergediffline {mdf id np} { + global diffmergeid ctext cflist nextupdate mergemax global difffilestart mdifffd set n [gets $mdf line] @@ -2512,7 +3014,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 {} @@ -2553,7 +3054,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] } } @@ -2580,7 +3081,7 @@ proc addtocflist {ids} { } proc gettreediffs {ids} { - global treediff parents treepending + global treediff treepending set treepending $ids set treediff {} if {[catch \ @@ -2757,15 +3258,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]} { @@ -2786,7 +3286,7 @@ proc incrfont {inc} { foreach e $entries { $e conf -font $mainfont } - if {$phase == "getcommits"} { + if {$phase eq "getcommits"} { $canv itemconf textitems -font $mainfont } redisplay @@ -2816,13 +3316,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]} { @@ -2848,7 +3350,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" } @@ -2917,12 +3419,13 @@ proc linehover {} { } proc clickisonarrow {id y} { - global lthickness idrowranges + global lthickness + set ranges [rowranges $id] set thresh [expr {2 * $lthickness + 6}] - set n [expr {[llength $idrowranges($id)] - 1}] + set n [expr {[llength $ranges] - 1}] for {set i 1} {$i < $n} {incr i} { - set row [lindex $idrowranges($id) $i] + set row [lindex $ranges $i] if {abs([yc $row] - $y) < $thresh} { return $i } @@ -2931,11 +3434,11 @@ proc clickisonarrow {id y} { } proc arrowjump {id n y} { - global idrowranges canv + global canv # 1 <-> 2, 3 <-> 4, etc... set n [expr {(($n - 1) ^ 1) + 1}] - set row [lindex $idrowranges($id) $n] + set row [lindex [rowranges $id] $n] set yt [yc $row] set ymax [lindex [$canv cget -scrollregion] 3] if {$ymax eq {} || $ymax <= 0} return @@ -2949,7 +3452,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 @@ -2988,10 +3491,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) @@ -3338,7 +3842,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]] @@ -3747,6 +4250,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 @@ -3787,10 +4291,53 @@ set historyindex 0 set optim_delay 16 +set nextviewnum 1 +set curview 0 +set selectedview 0 +set viewfiles(0) {} +set viewperm(0) 0 + set stopped 0 set stuffsaved 0 set patchnum 0 setcoords -makewindow $revtreeargs +makewindow readrefs -getcommits $revtreeargs + +set cmdline_files {} +catch { + set fileargs [eval exec git-rev-parse --no-revs --no-flags $revtreeargs] + set cmdline_files [split $fileargs "\n"] + set n [llength $cmdline_files] + set revtreeargs [lrange $revtreeargs 0 end-$n] +} +if {[lindex $revtreeargs end] eq "--"} { + set revtreeargs [lrange $revtreeargs 0 end-1] +} + +if {$cmdline_files ne {}} { + # create a view for the files/dirs specified on the command line + set curview 1 + set selectedview 1 + set nextviewnum 2 + set viewname(1) "Command line" + set viewfiles(1) $cmdline_files + set viewperm(1) 0 + .bar.view add radiobutton -label $viewname(1) -command {showview 1} \ + -variable selectedview -value 1 + .bar.view entryconf 2 -state normal + .bar.view entryconf 3 -state normal +} + +if {[info exists permviews]} { + foreach v $permviews { + set n $nextviewnum + incr nextviewnum + set viewname($n) [lindex $v 0] + set viewfiles($n) [lindex $v 1] + set viewperm($n) 1 + .bar.view add radiobutton -label $viewname($n) \ + -command [list showview $n] -variable selectedview -value $n + } +} +getcommits