diff options
Diffstat (limited to 'gitk')
| -rwxr-xr-x | gitk | 471 |
1 files changed, 344 insertions, 127 deletions
@@ -17,19 +17,38 @@ proc gitdir {} { } proc parse_args {rargs} { - global parsed_args + global parsed_args cmdline_files + set parsed_args {} + set cmdline_files {} if {[catch { - set parse_args [concat --default HEAD $rargs] - set parsed_args [split [eval exec git-rev-parse $parse_args] "\n"] + set args [concat --default HEAD $rargs] + set args [split [eval exec git-rev-parse $args] "\n"] + set i 0 + foreach arg $args { + if {![regexp {^[0-9a-f]{40}$} $arg]} { + if {$arg eq "--"} { + incr i + } + set cmdline_files [lrange $args $i end] + break + } + lappend parsed_args $arg + incr i + } }]} { # if git-rev-parse failed for some reason... + set i [lsearch -exact $rargs "--"] + if {$i >= 0} { + set cmdline_files [lrange $rargs [expr {$i+1}] end] + set rargs [lrange $rargs 0 [expr {$i-1}]] + } if {$rargs == {}} { - set rargs HEAD + set parsed_args HEAD + } else { + set parsed_args $rargs } - set parsed_args $rargs } - return $parsed_args } proc start_rev_list {rlargs} { @@ -65,7 +84,7 @@ proc getcommits {rargs} { global phase canv mainfont set phase getcommits - start_rev_list [parse_args $rargs] + start_rev_list $rargs $canv delete all $canv create text 3 3 -anchor nw -text "Reading commits..." \ -font $mainfont -tags textitems @@ -141,11 +160,12 @@ proc getcommitlines {commfd} { set id [lindex $ids 0] if {$listed} { set olds [lrange $ids 1 end] - if {[llength $olds] > 1} { - set olds [lsort -unique $olds] - } + set i 0 foreach p $olds { - lappend children($p) $id + if {$i == 0 || [lsearch -exact $olds $p] >= $i} { + lappend children($p) $id + } + incr i } } else { set olds {} @@ -196,18 +216,14 @@ proc readcommit {id} { parsecommit $id $contents 0 } -proc updatecommits {rargs} { - 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 - getcommits $rargs +proc updatecommits {} { + global viewdata curview revtreeargs + + set n $curview + set curview -1 + catch {unset viewdata($n)} + parse_args $revtreeargs + showview $n } proc parsecommit {id contents listed} { @@ -334,7 +350,7 @@ proc error_popup msg { tkwait window $w } -proc makewindow {rargs} { +proc makewindow {} { global canv canv2 canv3 linespc charspc ctext cflist textfont mainfont uifont global findtype findtypemenu findloc findstring fstring geometry global entries sha1entry sha1string sha1but @@ -345,7 +361,7 @@ proc makewindow {rargs} { .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 @@ -353,6 +369,12 @@ proc makewindow {rargs} { .bar add cascade -label "Edit" -menu .bar.edit .bar.edit add command -label "Preferences" -command doprefs .bar.edit configure -font $uifont + menu .bar.view + .bar add cascade -label "View" -menu .bar.view + .bar.view add command -label "New view..." -command newview + .bar.view add command -label "Delete view" -command delview -state disabled + .bar.view add separator + .bar.view add command -label "All files" -command {showview 0} menu .bar.help .bar add cascade -label "Help" -menu .bar.help .bar.help add command -label "About gitk" -command about @@ -786,6 +808,165 @@ f Scroll diff view to next file pack $w.ok -side bottom } +proc newview {} { + global newviewname nextviewnum newviewtop + + set top .gitkview + if {[winfo exists $top]} { + raise $top + return + } + set newviewtop $top + toplevel $top + wm title $top "Gitk view definition" + label $top.nl -text "Name" + entry $top.name -width 20 -textvariable newviewname + set newviewname "View $nextviewnum" + grid $top.nl $top.name -sticky w + label $top.l -text "Files and directories to include:" + grid $top.l - -sticky w -pady 10 + text $top.t -width 30 -height 10 + grid $top.t - -sticky w + frame $top.buts + button $top.buts.ok -text "OK" -command newviewok + button $top.buts.can -text "Cancel" -command newviewcan + 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 newviewok {} { + global newviewtop nextviewnum + global viewname viewfiles + + set n $nextviewnum + incr nextviewnum + set viewname($n) [$newviewtop.name get] + set files {} + foreach f [split [$newviewtop.t get 0.0 end] "\n"] { + set ft [string trim $f] + if {$ft ne {}} { + lappend files $ft + } + } + set viewfiles($n) $files + catch {destroy $newviewtop} + unset newviewtop + .bar.view add command -label $viewname($n) -command [list showview $n] + after idle showview $n +} + +proc newviewcan {} { + global newviewtop + + catch {destroy $newviewtop} + unset newviewtop +} + +proc delview {} { + global curview viewdata + + if {$curview == 0} return + set nmenu [.bar.view index end] + set targetcmd [list showview $curview] + for {set i 5} {$i <= $nmenu} {incr i} { + if {[.bar.view entrycget $i -command] eq $targetcmd} { + .bar.view delete $i + break + } + } + set viewdata($curview) {} + showview 0 +} + +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 parsed_args + global pending_select phase + + 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 + stopfindproc + if {$curview >= 0 && $phase eq {} && ![info exists viewdata($curview)]} { + set viewdata($curview) \ + [list $displayorder $parentlist $childlist $rowidlist \ + $rowoffsets $rowrangelist $commitlisted] + } + catch {unset matchinglines} + catch {unset treediffs} + clear_display + readrefs + + set curview $n + .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}] + + if {![info exists viewdata($n)]} { + set args $parsed_args + if {$viewfiles($n) ne {}} { + set args [concat $args "--" $viewfiles($n)] + } + set pending_select $selid + getcommits $args + return + } + + set displayorder [lindex $viewdata($n) 0] + set parentlist [lindex $viewdata($n) 1] + set childlist [lindex $viewdata($n) 2] + set rowidlist [lindex $viewdata($n) 3] + set rowoffsets [lindex $viewdata($n) 4] + set rowrangelist [lindex $viewdata($n) 5] + set commitlisted [lindex $viewdata($n) 6] + set numcommits [llength $displayorder] + catch {unset colormap} + catch {unset rowtextx} + catch {unset commitrow} + catch {unset idrowranges} + 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 +} + proc shortids {ids} { set res {} foreach id $ids { @@ -902,10 +1083,12 @@ proc makeuparrow {oid x y z} { proc initlayout {} { global rowidlist rowoffsets displayorder commitlisted global rowlaidout rowoptim - global idinlist rowchk + 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 @@ -913,6 +1096,7 @@ proc initlayout {} { set commitlisted {} set parentlist {} set childlist {} + set rowrangelist {} catch {unset children} set nextcolor 0 set rowidlist {{}} @@ -922,6 +1106,11 @@ proc initlayout {} { set rowlaidout 0 set rowoptim 0 set canvxmax [$canv cget -width] + catch {unset colormap} + catch {unset rowtextx} + catch {unset commitrow} + catch {unset idrowranges} + catch {unset linesegends} } proc setcanvscroll {} { @@ -960,7 +1149,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 } @@ -971,7 +1159,7 @@ proc layoutmore {} { } proc showstuff {canshow} { - global numcommits + global numcommits commitrow pending_select global linesegends idrowranges idrangedrawn if {$numcommits == 0} { @@ -985,6 +1173,7 @@ proc showstuff {canshow} { 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) { @@ -1007,6 +1196,11 @@ 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 + } } proc layoutrows {row endrow last} { @@ -1015,7 +1209,7 @@ proc layoutrows {row endrow last} { 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] @@ -1074,9 +1268,12 @@ 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 rowrangelist $ranges incr row set offs [ntimes [llength $idlist] 0] set l [llength $newolds] @@ -1136,7 +1333,7 @@ proc addextraid {id row} { proc layouttail {} { global rowidlist rowoffsets idinlist commitidx - global idrowranges + global idrowranges rowrangelist set row $commitidx set idlist [lindex $rowidlist $row] @@ -1146,6 +1343,7 @@ proc layouttail {} { addextraid $id $row unset idinlist($id) lappend idrowranges($id) $row + lappend rowrangelist $idrowranges($id) incr row set offs [ntimes $col 0] set idlist [lreplace $idlist $col $col] @@ -1159,6 +1357,7 @@ proc layouttail {} { lset rowoffsets $row 0 makeuparrow $id 0 $row 0 lappend idrowranges($id) $row + lappend rowrangelist $idrowranges($id) incr row lappend rowidlist {} lappend rowoffsets {} @@ -1175,7 +1374,7 @@ 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] @@ -1308,13 +1507,33 @@ proc linewidth {id} { return $wid } +proc rowranges {id} { + global idrowranges commitrow numcommits rowrangelist + + set ranges {} + if {[info exists commitrow($id)] && $commitrow($id) < $numcommits} { + 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 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 {} @@ -1358,8 +1577,7 @@ proc drawlineseg {id i} { } } if {[llength $coords] < 4} return - set last [expr {[llength $idrowranges($id)] / 2 - 1}] - if {$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. @@ -1379,7 +1597,7 @@ proc drawlineseg {id i} { } } } - set arrow [expr {2 * ($i > 0) + ($i < $last)}] + 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] @@ -1388,7 +1606,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] @@ -1407,9 +1625,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 } @@ -1432,11 +1650,11 @@ proc drawparentlinks {id row col olds} { proc drawlines {id} { global colormap canv - global idrowranges idrangedrawn + 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 @@ -1499,14 +1717,13 @@ proc drawcmittext {id row col rmx} { proc drawcmitrow {row} { global displayorder rowidlist - global idrowranges idrangedrawn iddrawn + global idrangedrawn iddrawn global commitinfo commitlisted parentlist numcommits if {$row >= $numcommits} return foreach id [lindex $rowidlist $row] { - if {![info exists idrowranges($id)]} continue set i -1 - foreach {s e} $idrowranges($id) { + foreach {s e} [rowranges $id] { incr i if {$row < $s} continue if {$e eq {}} break @@ -1575,10 +1792,50 @@ 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 commitrow parentlist children childlist - global cornercrossings crossings if {[info exists colormap($id)]} return set ncolors [llength $colors] @@ -1598,32 +1855,22 @@ proc assigncolor {id} { } } 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 $kids { if {[info exists colormap($child)] @@ -1727,55 +1974,6 @@ proc drawtags {id x xt y1} { return $xt } -proc checkcrossings {row endrow} { - global displayorder parentlist rowidlist - - for {} {$row < $endrow} {incr row} { - set id [lindex $displayorder $row] - set i [lsearch -exact [lindex $rowidlist $row] $id] - if {$i < 0} continue - set idlist [lindex $rowidlist [expr {$row+1}]] - foreach p [lindex $parentlist $row] { - 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 @@ -2379,8 +2577,9 @@ proc selectline {l isnew} { 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 @@ -2548,9 +2747,10 @@ proc selnextpage {dir} { } proc unselectline {} { - global selectedline + global selectedline currentid catch {unset selectedline} + catch {unset currentid} allcanvs delete secsel } @@ -3065,12 +3265,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 } @@ -3079,11 +3280,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 @@ -3936,10 +4137,26 @@ set historyindex 0 set optim_delay 16 +set nextviewnum 1 +set curview 0 +set viewfiles(0) {} + set stopped 0 set stuffsaved 0 set patchnum 0 setcoords -makewindow $revtreeargs +makewindow readrefs -getcommits $revtreeargs +parse_args $revtreeargs +set args $parsed_args +if {$cmdline_files ne {}} { + # create a view for the files/dirs specified on the command line + set curview 1 + set nextviewnum 2 + set viewname(1) "Command line" + set viewfiles(1) $cmdline_files + .bar.view add command -label $viewname(1) -command {showview 1} + .bar.view entryconf 2 -state normal + set args [concat $args "--" $cmdline_files] +} +getcommits $args |