X-Git-Url: https://git.tokkee.org/?a=blobdiff_plain;ds=sidebyside;f=gitk;h=3dabc695167dc33c6655efbabbd9a0c3e870ccda;hb=e861ce1692fa9809f3e7b898804f8ddaf7cd8975;hp=25c86b70af6284eacd079e508f97f16d03f3f88d;hpb=96535e615db869f096686b0ce8e79e30dec7ad25;p=git.git diff --git a/gitk b/gitk index 25c86b70a..3dabc6951 100755 --- a/gitk +++ b/gitk @@ -2,7 +2,7 @@ # Tcl ignores the next line -*- tcl -*- \ exec wish "$0" -- "$@" -# Copyright (C) 2005 Paul Mackerras. All rights reserved. +# Copyright (C) 2005-2006 Paul Mackerras. All rights reserved. # This program is free software; it may be used, copied, modified # and distributed under the terms of the GNU General Public Licence, # either version 2, or (at your option) any later version. @@ -17,13 +17,12 @@ proc gitdir {} { } proc start_rev_list {view} { - global startmsecs nextupdate ncmupdate + global startmsecs nextupdate global commfd leftover tclencoding datemode global viewargs viewfiles commitidx set startmsecs [clock clicks -milliseconds] set nextupdate [expr {$startmsecs + 100}] - set ncmupdate 1 set commitidx($view) 0 set args $viewargs($view) if {$viewfiles($view) ne {}} { @@ -79,7 +78,7 @@ proc getcommitlines {fd view} { global parentlist childlist children curview hlview global vparentlist vchildlist vdisporder vcmitlisted - set stuff [read $fd] + set stuff [read $fd 500000] if {$stuff == {}} { if {![eof $fd]} return global viewname @@ -185,7 +184,7 @@ proc getcommitlines {fd view} { } if {$gotsome} { if {$view == $curview} { - layoutmore + while {[layoutmore $nextupdate]} doupdate } elseif {[info exists hlview] && $view == $hlview} { vhighlightmore } @@ -196,20 +195,13 @@ proc getcommitlines {fd view} { } proc doupdate {} { - global commfd nextupdate numcommits ncmupdate + global commfd nextupdate numcommits foreach v [array names commfd] { fileevent $commfd($v) readable {} } update set nextupdate [expr {[clock clicks -milliseconds] + 100}] - if {$numcommits < 100} { - set ncmupdate [expr {$numcommits + 1}] - } elseif {$numcommits < 10000} { - set ncmupdate [expr {$numcommits + 10}] - } else { - set ncmupdate [expr {$numcommits + 100}] - } foreach v [array names commfd] { set fd $commfd($v) fileevent $fd readable [list getcommitlines $fd $v] @@ -238,6 +230,7 @@ proc updatecommits {} { catch {unset selectedline} catch {unset thickerline} catch {unset viewdata($n)} + discardallcommits readrefs showview $n } @@ -311,7 +304,7 @@ proc getcommit {id} { proc readrefs {} { global tagids idtags headids idheads tagcontents - global otherrefids idotherrefs + global otherrefids idotherrefs mainhead foreach v {tagids idtags headids idheads otherrefids idotherrefs} { catch {unset $v} @@ -340,13 +333,13 @@ proc readrefs {} { set tag {} catch { set commit [exec git rev-parse "$id^0"] - if {"$commit" != "$id"} { + if {$commit != $id} { set tagids($name) $commit lappend idtags($commit) $name } } catch { - set tagcontents($name) [exec git cat-file tag "$id"] + set tagcontents($name) [exec git cat-file tag $id] } } elseif { $type == "heads" } { set headids($name) $id @@ -357,6 +350,13 @@ proc readrefs {} { } } close $refd + set mainhead {} + catch { + set thehead [exec git symbolic-ref HEAD] + if {[string match "refs/heads/*" $thehead]} { + set mainhead [string range $thehead 11 end] + } + } } proc show_error {w top msg} { @@ -376,6 +376,23 @@ proc error_popup msg { show_error $w $w $msg } +proc confirm_popup msg { + global confirm_ok + set confirm_ok 0 + set w .confirm + toplevel $w + wm transient $w . + message $w.m -text $msg -justify center -aspect 400 + pack $w.m -side top -fill x -padx 20 -pady 20 + button $w.ok -text OK -command "set confirm_ok 1; destroy $w" + pack $w.ok -side left -fill x + button $w.cancel -text Cancel -command "destroy $w" + pack $w.cancel -side right -fill x + bind $w "grab $w; focus $w" + tkwait window $w + return $confirm_ok +} + proc makewindow {} { global canv canv2 canv3 linespc charspc ctext cflist global textfont mainfont uifont @@ -385,6 +402,8 @@ proc makewindow {} { global rowctxmenu mergemax wrapcomment global highlight_files gdttype global searchstring sstring + global bgcolor fgcolor bglist fglist diffcolors + global headctxmenu menu .bar .bar add cascade -label "File" -menu .bar.file @@ -445,18 +464,19 @@ proc makewindow {} { .ctop add .ctop.top set canv .ctop.top.clist.canv canvas $canv -height $geometry(canvh) -width $geometry(canv1) \ - -bg white -bd 0 \ + -background $bgcolor -bd 0 \ -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll" .ctop.top.clist add $canv set canv2 .ctop.top.clist.canv2 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \ - -bg white -bd 0 -yscrollincr $linespc + -background $bgcolor -bd 0 -yscrollincr $linespc .ctop.top.clist add $canv2 set canv3 .ctop.top.clist.canv3 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \ - -bg white -bd 0 -yscrollincr $linespc + -background $bgcolor -bd 0 -yscrollincr $linespc .ctop.top.clist add $canv3 bind .ctop.top.clist {resizeclistpanes %W %w} + lappend bglist $canv $canv2 $canv3 set sha1entry .ctop.top.bar.sha1 set entries $sha1entry @@ -534,7 +554,7 @@ proc makewindow {} { pack .ctop.top.lbar.vlabel -side left -fill y global viewhlmenu selectedhlview set viewhlmenu [tk_optionMenu .ctop.top.lbar.vhl selectedhlview None] - $viewhlmenu entryconf 0 -command delvhighlight + $viewhlmenu entryconf None -command delvhighlight $viewhlmenu conf -font $uifont .ctop.top.lbar.vhl conf -font $uifont pack .ctop.top.lbar.vhl -side left -fill y @@ -562,19 +582,22 @@ proc makewindow {} { trace add variable searchstring write incrsearch pack $sstring -side left -expand 1 -fill x set ctext .ctop.cdet.left.ctext - text $ctext -bg white -state disabled -font $textfont \ + text $ctext -background $bgcolor -foreground $fgcolor \ + -state disabled -font $textfont \ -width $geometry(ctextw) -height $geometry(ctexth) \ -yscrollcommand scrolltext -wrap none scrollbar .ctop.cdet.left.sb -command "$ctext yview" pack .ctop.cdet.left.sb -side right -fill y pack $ctext -side left -fill both -expand 1 .ctop.cdet add .ctop.cdet.left + lappend bglist $ctext + lappend fglist $ctext $ctext tag conf comment -wrap $wrapcomment $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa" - $ctext tag conf hunksep -fore blue - $ctext tag conf d0 -fore red - $ctext tag conf d1 -fore "#00a000" + $ctext tag conf hunksep -fore [lindex $diffcolors 2] + $ctext tag conf d0 -fore [lindex $diffcolors 0] + $ctext tag conf d1 -fore [lindex $diffcolors 1] $ctext tag conf m0 -fore red $ctext tag conf m1 -fore blue $ctext tag conf m2 -fore green @@ -607,11 +630,15 @@ proc makewindow {} { pack .ctop.cdet.right.mode -side top -fill x set cflist .ctop.cdet.right.cfiles set indent [font measure $mainfont "nn"] - text $cflist -width $geometry(cflistw) -background white -font $mainfont \ + text $cflist -width $geometry(cflistw) \ + -background $bgcolor -foreground $fgcolor \ + -font $mainfont \ -tabs [list $indent [expr {2 * $indent}]] \ -yscrollcommand ".ctop.cdet.right.sb set" \ -cursor [. cget -cursor] \ -spacing1 1 -spacing3 1 + lappend bglist $cflist + lappend fglist $cflist 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 @@ -694,6 +721,16 @@ proc makewindow {} { $rowctxmenu add command -label "Make patch" -command mkpatch $rowctxmenu add command -label "Create tag" -command mktag $rowctxmenu add command -label "Write commit to file" -command writecommit + $rowctxmenu add command -label "Create new branch" -command mkbranch + $rowctxmenu add command -label "Cherry-pick this commit" \ + -command cherrypick + + set headctxmenu .headctxmenu + menu $headctxmenu -tearoff 0 + $headctxmenu add command -label "Check out this branch" \ + -command cobranch + $headctxmenu add command -label "Remove this branch" \ + -command rmbranch } # mouse-2 makes all windows scan vertically, but only the one @@ -743,9 +780,10 @@ proc click {w} { proc savestuff {w} { global canv canv2 canv3 ctext cflist mainfont textfont uifont global stuffsaved findmergefiles maxgraphpct - global maxwidth + global maxwidth showneartags global viewname viewfiles viewargs viewperm nextviewnum global cmitmode wrapcomment + global colors bgcolor fgcolor diffcolors if {$stuffsaved} return if {![winfo viewable .]} return @@ -759,6 +797,11 @@ proc savestuff {w} { puts $f [list set maxwidth $maxwidth] puts $f [list set cmitmode $cmitmode] puts $f [list set wrapcomment $wrapcomment] + puts $f [list set showneartags $showneartags] + puts $f [list set bgcolor $bgcolor] + puts $f [list set fgcolor $fgcolor] + puts $f [list set colors $colors] + puts $f [list set diffcolors $diffcolors] puts $f "set geometry(width) [winfo width .ctop]" puts $f "set geometry(height) [winfo height .ctop]" puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]" @@ -1431,7 +1474,7 @@ proc doviewmenu {m first cmd op argv} { proc allviewmenus {n op args} { global viewhlmenu - doviewmenu .bar.view 7 [list showview $n] $op $args + doviewmenu .bar.view 5 [list showview $n] $op $args doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args } @@ -1473,7 +1516,7 @@ proc newviewok {top n} { set viewperm($n) $newviewperm($n) if {$newviewname($n) ne $viewname($n)} { set viewname($n) $newviewname($n) - doviewmenu .bar.view 7 [list showview $n] \ + doviewmenu .bar.view 5 [list showview $n] \ entryconf [list -label $viewname($n)] doviewmenu $viewhlmenu 1 [list addvhighlight $n] \ entryconf [list -label $viewname($n) -value $viewname($n)] @@ -1589,8 +1632,8 @@ proc showview {n} { 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"}] + .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}] + .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}] if {![info exists viewdata($n)]} { set pending_select $selid @@ -1646,7 +1689,7 @@ proc showview {n} { show_status "Reading commits..." } if {[info exists commfd($n)]} { - layoutmore + layoutmore {} } else { finishcommits } @@ -2327,20 +2370,38 @@ proc visiblerows {} { return [list $r0 $r1] } -proc layoutmore {} { +proc layoutmore {tmax} { global rowlaidout rowoptim commitidx numcommits optim_delay global uparrowlen curview - set row $rowlaidout - set rowlaidout [layoutrows $row $commitidx($curview) 0] - set orow [expr {$rowlaidout - $uparrowlen - 1}] - if {$orow > $rowoptim} { - optimize_rows $rowoptim 0 $orow - set rowoptim $orow - } - set canshow [expr {$rowoptim - $optim_delay}] - if {$canshow > $numcommits} { - showstuff $canshow + while {1} { + if {$rowoptim - $optim_delay > $numcommits} { + showstuff [expr {$rowoptim - $optim_delay}] + } elseif {$rowlaidout - $uparrowlen - 1 > $rowoptim} { + set nr [expr {$rowlaidout - $uparrowlen - 1 - $rowoptim}] + if {$nr > 100} { + set nr 100 + } + optimize_rows $rowoptim 0 [expr {$rowoptim + $nr}] + incr rowoptim $nr + } elseif {$commitidx($curview) > $rowlaidout} { + set nr [expr {$commitidx($curview) - $rowlaidout}] + # may need to increase this threshold if uparrowlen or + # mingaplen are increased... + if {$nr > 150} { + set nr 150 + } + set row $rowlaidout + set rowlaidout [layoutrows $row [expr {$row + $nr}] 0] + if {$rowlaidout == $row} { + return 0 + } + } else { + return 0 + } + if {$tmax ne {} && [clock clicks -milliseconds] >= $tmax} { + return 1 + } } } @@ -2868,11 +2929,11 @@ proc drawlines {id} { } proc drawcmittext {id row col rmx} { - global linespc canv canv2 canv3 canvy0 + global linespc canv canv2 canv3 canvy0 fgcolor global commitlisted commitinfo rowidlist global rowtextx idpos idtags idheads idotherrefs global linehtag linentag linedtag - global mainfont canvxmax boldrows boldnamerows + global mainfont canvxmax boldrows boldnamerows fgcolor set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}] set x [xc $row $col] @@ -2880,7 +2941,7 @@ proc drawcmittext {id row col rmx} { set orad [expr {$linespc / 3}] set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \ [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \ - -fill $ofill -outline black -width 1] + -fill $ofill -outline $fgcolor -width 1 -tags circle] $canv raise $t $canv bind $t <1> {selcanvline {} %x %y} set xt [xc $row [llength [lindex $rowidlist $row]]] @@ -2908,13 +2969,13 @@ proc drawcmittext {id row col rmx} { lappend nfont bold } } - set linehtag($row) [$canv create text $xt $y -anchor w \ - -text $headline -font $font] + set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \ + -text $headline -font $font -tags text] $canv bind $linehtag($row) "rowmenu %X %Y $id" - set linentag($row) [$canv2 create text 3 $y -anchor w \ - -text $name -font $nfont] - set linedtag($row) [$canv3 create text 3 $y -anchor w \ - -text $date -font $mainfont] + set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \ + -text $name -font $nfont -tags text] + set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \ + -text $date -font $mainfont -tags text] set xr [expr {$xt + [font measure $mainfont $headline]}] if {$xr > $canvxmax} { set canvxmax $xr @@ -3134,9 +3195,9 @@ proc bindline {t id} { } proc drawtags {id x xt y1} { - global idtags idheads idotherrefs + global idtags idheads idotherrefs mainhead global linespc lthickness - global canv mainfont commitrow rowtextx curview + global canv mainfont commitrow rowtextx curview fgcolor bgcolor set marks {} set ntags 0 @@ -3161,8 +3222,14 @@ proc drawtags {id x xt y1} { set yb [expr {$yt + $linespc - 1}] set xvals {} set wvals {} + set i -1 foreach tag $marks { - set wid [font measure $mainfont $tag] + incr i + if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} { + set wid [font measure [concat $mainfont bold] $tag] + } else { + set wid [font measure $mainfont $tag] + } lappend xvals $xt lappend wvals $wid set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}] @@ -3173,6 +3240,7 @@ proc drawtags {id x xt y1} { foreach tag $marks x $xvals wid $wvals { set xl [expr {$x + $delta}] set xr [expr {$x + $delta + $wid + $lthickness}] + set font $mainfont if {[incr ntags -1] >= 0} { # draw a tag set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \ @@ -3184,6 +3252,9 @@ proc drawtags {id x xt y1} { # draw a head or other ref if {[incr nheads -1] >= 0} { set col green + if {$tag eq $mainhead} { + lappend font bold + } } else { set col "#ddddff" } @@ -3199,10 +3270,12 @@ proc drawtags {id x xt y1} { -width 0 -fill "#ffddaa" -tags tag.$id } } - set t [$canv create text $xl $y1 -anchor w -text $tag \ - -font $mainfont -tags tag.$id] + set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \ + -font $font -tags [list tag.$id text]] if {$ntags >= 0} { $canv bind $t <1> [list showtag $tag 1] + } elseif {$nheads >= 0} { + $canv bind $t [list headmenu %X %Y $id $tag] } } return $xt @@ -3221,16 +3294,16 @@ proc xcoord {i level ln} { } proc show_status {msg} { - global canv mainfont + global canv mainfont fgcolor clear_display - $canv create text 3 3 -anchor nw -text $msg -font $mainfont -tags textitems + $canv create text 3 3 -anchor nw -text $msg -font $mainfont \ + -tags text -fill $fgcolor } proc finishcommits {} { global commitidx phase curview - global canv mainfont ctext maincursor textcursor - global findinprogress pending_select + global pending_select if {$commitidx($curview) > 0} { drawrest @@ -3241,6 +3314,108 @@ proc finishcommits {} { catch {unset pending_select} } +# Insert a new commit as the child of the commit on row $row. +# The new commit will be displayed on row $row and the commits +# on that row and below will move down one row. +proc insertrow {row newcmit} { + global displayorder parentlist childlist commitlisted + global commitrow curview rowidlist rowoffsets numcommits + global rowrangelist idrowranges rowlaidout rowoptim numcommits + global linesegends selectedline + + if {$row >= $numcommits} { + puts "oops, inserting new row $row but only have $numcommits rows" + return + } + set p [lindex $displayorder $row] + set displayorder [linsert $displayorder $row $newcmit] + set parentlist [linsert $parentlist $row $p] + set kids [lindex $childlist $row] + lappend kids $newcmit + lset childlist $row $kids + set childlist [linsert $childlist $row {}] + set commitlisted [linsert $commitlisted $row 1] + set l [llength $displayorder] + for {set r $row} {$r < $l} {incr r} { + set id [lindex $displayorder $r] + set commitrow($curview,$id) $r + } + + set idlist [lindex $rowidlist $row] + set offs [lindex $rowoffsets $row] + set newoffs {} + foreach x $idlist { + if {$x eq {} || ($x eq $p && [llength $kids] == 1)} { + lappend newoffs {} + } else { + lappend newoffs 0 + } + } + if {[llength $kids] == 1} { + set col [lsearch -exact $idlist $p] + lset idlist $col $newcmit + } else { + set col [llength $idlist] + lappend idlist $newcmit + lappend offs {} + lset rowoffsets $row $offs + } + set rowidlist [linsert $rowidlist $row $idlist] + set rowoffsets [linsert $rowoffsets [expr {$row+1}] $newoffs] + + set rowrangelist [linsert $rowrangelist $row {}] + set l [llength $rowrangelist] + for {set r 0} {$r < $l} {incr r} { + set ranges [lindex $rowrangelist $r] + if {$ranges ne {} && [lindex $ranges end] >= $row} { + set newranges {} + foreach x $ranges { + if {$x >= $row} { + lappend newranges [expr {$x + 1}] + } else { + lappend newranges $x + } + } + lset rowrangelist $r $newranges + } + } + if {[llength $kids] > 1} { + set rp1 [expr {$row + 1}] + set ranges [lindex $rowrangelist $rp1] + if {$ranges eq {}} { + set ranges [list $row $rp1] + } elseif {[lindex $ranges end-1] == $rp1} { + lset ranges end-1 $row + } + lset rowrangelist $rp1 $ranges + } + foreach id [array names idrowranges] { + set ranges $idrowranges($id) + if {$ranges ne {} && [lindex $ranges end] >= $row} { + set newranges {} + foreach x $ranges { + if {$x >= $row} { + lappend newranges [expr {$x + 1}] + } else { + lappend newranges $x + } + } + set idrowranges($id) $newranges + } + } + + set linesegends [linsert $linesegends $row {}] + + incr rowlaidout + incr rowoptim + incr numcommits + + if {[info exists selectedline] && $selectedline >= $row} { + incr selectedline + } + redisplay +} + # Don't change the text pane cursor if it is currently the hand cursor, # showing that we are over a sha1 ID link. proc settextcursor {c} { @@ -3273,9 +3448,7 @@ proc notbusy {what} { } proc drawrest {} { - global numcommits global startmsecs - global canvy0 numcommits linespc global rowlaidout commitidx curview global pending_select @@ -3289,6 +3462,7 @@ proc drawrest {} { } set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}] + #global numcommits #puts "overall $drawmsecs ms for $numcommits commits" } @@ -3523,7 +3697,7 @@ proc commit_descriptor {p} { if {[llength $commitinfo($p)] > 1} { set l [lindex $commitinfo($p) 0] } - return "$p ($l)" + return "$p ($l)\n" } # append some text to the ctext widget, and make any SHA1 ID @@ -3533,7 +3707,6 @@ proc appendwithlinks {text tags} { set start [$ctext index "end - 1c"] $ctext insert end $text $tags - $ctext insert end "\n" set links [regexp -indices -all -inline {[0-9a-f]{40}} $text] foreach l $links { set s [lindex $l 0] @@ -3568,6 +3741,69 @@ proc viewnextline {dir} { allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}] } +# add a list of tag or branch names at position pos +# returns the number of names inserted +proc appendrefs {pos tags var} { + global ctext commitrow linknum curview $var + + if {[catch {$ctext index $pos}]} { + return 0 + } + set tags [lsort $tags] + set sep {} + foreach tag $tags { + set id [set $var\($tag\)] + set lk link$linknum + incr linknum + $ctext insert $pos $sep + $ctext insert $pos $tag $lk + $ctext tag conf $lk -foreground blue + if {[info exists commitrow($curview,$id)]} { + $ctext tag bind $lk <1> \ + [list selectline $commitrow($curview,$id) 1] + $ctext tag conf $lk -underline 1 + $ctext tag bind $lk { %W configure -cursor hand2 } + $ctext tag bind $lk { %W configure -cursor $curtextcursor } + } + set sep ", " + } + return [llength $tags] +} + +proc taglist {ids} { + global idtags + + set tags {} + foreach id $ids { + foreach tag $idtags($id) { + lappend tags $tag + } + } + return $tags +} + +# called when we have finished computing the nearby tags +proc dispneartags {} { + global selectedline currentid ctext anc_tags desc_tags showneartags + global desc_heads + + if {![info exists selectedline] || !$showneartags} return + set id $currentid + $ctext conf -state normal + if {[info exists desc_heads($id)]} { + if {[appendrefs branch $desc_heads($id) headids] > 1} { + $ctext insert "branch -2c" "es" + } + } + if {[info exists anc_tags($id)]} { + appendrefs follows [taglist $anc_tags($id)] tagids + } + if {[info exists desc_tags($id)]} { + appendrefs precedes [taglist $desc_tags($id)] tagids + } + $ctext conf -state disabled +} + proc selectline {l isnew} { global canv canv2 canv3 ctext commitinfo selectedline global displayorder linehtag linentag linedtag @@ -3575,7 +3811,7 @@ proc selectline {l isnew} { global currentid sha1entry global commentend idtags linknum global mergemax numcommits pending_select - global cmitmode + global cmitmode desc_tags anc_tags showneartags allcommits desc_heads catch {unset pending_select} $canv delete hover @@ -3678,16 +3914,44 @@ proc selectline {l isnew} { } } else { foreach p $olds { - append headers "Parent: [commit_descriptor $p]\n" + append headers "Parent: [commit_descriptor $p]" } } foreach c [lindex $childlist $l] { - append headers "Child: [commit_descriptor $c]\n" + append headers "Child: [commit_descriptor $c]" } # make anything that looks like a SHA1 ID be a clickable link appendwithlinks $headers {} + if {$showneartags} { + if {![info exists allcommits]} { + getallcommits + } + $ctext insert end "Branch: " + $ctext mark set branch "end -1c" + $ctext mark gravity branch left + if {[info exists desc_heads($id)]} { + if {[appendrefs branch $desc_heads($id) headids] > 1} { + # turn "Branch" into "Branches" + $ctext insert "branch -2c" "es" + } + } + $ctext insert end "\nFollows: " + $ctext mark set follows "end -1c" + $ctext mark gravity follows left + if {[info exists anc_tags($id)]} { + appendrefs follows [taglist $anc_tags($id)] tagids + } + $ctext insert end "\nPrecedes: " + $ctext mark set precedes "end -1c" + $ctext mark gravity precedes left + if {[info exists desc_tags($id)]} { + appendrefs precedes [taglist $desc_tags($id)] tagids + } + $ctext insert end "\n" + } + $ctext insert end "\n" appendwithlinks [lindex $info 5] {comment} $ctext tag delete Comments @@ -4176,12 +4440,27 @@ proc getblobdiffline {bdf ids} { } } +proc prevfile {} { + global difffilestart ctext + set prev [lindex $difffilestart 0] + set here [$ctext index @0,0] + foreach loc $difffilestart { + if {[$ctext compare $loc >= $here]} { + $ctext yview $prev + return + } + set prev $loc + } + $ctext yview $prev +} + proc nextfile {} { global difffilestart ctext set here [$ctext index @0,0] foreach loc $difffilestart { if {[$ctext compare $loc > $here]} { $ctext yview $loc + return } } } @@ -4344,6 +4623,7 @@ proc redisplay {} { drawvisible if {[info exists selectedline]} { selectline $selectedline 0 + allcanvs yview moveto [lindex $span 0] } } @@ -4487,7 +4767,8 @@ proc linehover {} { set t [$canv create rectangle $x0 $y0 $x1 $y1 \ -fill \#ffff80 -outline black -width 1 -tags hover] $canv raise $t - set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont] + set t [$canv create text $x $y -anchor nw -text $text -tags hover \ + -font $mainfont] $canv raise $t } @@ -4618,9 +4899,9 @@ proc rowmenu {x y id} { } else { set state normal } - $rowctxmenu entryconfigure 0 -state $state - $rowctxmenu entryconfigure 1 -state $state - $rowctxmenu entryconfigure 2 -state $state + $rowctxmenu entryconfigure "Diff this*" -state $state + $rowctxmenu entryconfigure "Diff selected*" -state $state + $rowctxmenu entryconfigure "Make patch" -state $state set rowmenuid $id tk_popup $rowctxmenu $x $y } @@ -4810,16 +5091,24 @@ proc domktag {} { set tagids($tag) $id lappend idtags($id) $tag redrawtags $id + addedtag $id } proc redrawtags {id} { global canv linehtag commitrow idpos selectedline curview + global mainfont canvxmax if {![info exists commitrow($curview,$id)]} return drawcmitrow $commitrow($curview,$id) $canv delete tag.$id set xt [eval drawtags $id $idpos($id)] $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2] + set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text] + set xr [expr {$xt + [font measure $mainfont $text]}] + if {$xr > $canvxmax} { + set canvxmax $xr + setcanvscroll + } if {[info exists selectedline] && $selectedline == $commitrow($curview,$id)} { selectline $selectedline 0 @@ -4893,26 +5182,537 @@ proc wrcomcan {} { unset wrcomtop } -proc listrefs {id} { - global idtags idheads idotherrefs +proc mkbranch {} { + global rowmenuid mkbrtop - set x {} + set top .makebranch + catch {destroy $top} + toplevel $top + label $top.title -text "Create new branch" + grid $top.title - -pady 10 + label $top.id -text "ID:" + entry $top.sha1 -width 40 -relief flat + $top.sha1 insert 0 $rowmenuid + $top.sha1 conf -state readonly + grid $top.id $top.sha1 -sticky w + label $top.nlab -text "Name:" + entry $top.name -width 40 + grid $top.nlab $top.name -sticky w + frame $top.buts + button $top.buts.go -text "Create" -command [list mkbrgo $top] + button $top.buts.can -text "Cancel" -command "catch {destroy $top}" + grid $top.buts.go $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.name +} + +proc mkbrgo {top} { + global headids idheads + + set name [$top.name get] + set id [$top.sha1 get] + if {$name eq {}} { + error_popup "Please specify a name for the new branch" + return + } + catch {destroy $top} + nowbusy newbranch + update + if {[catch { + exec git branch $name $id + } err]} { + notbusy newbranch + error_popup $err + } else { + addedhead $id $name + # XXX should update list of heads displayed for selected commit + notbusy newbranch + redrawtags $id + } +} + +proc cherrypick {} { + global rowmenuid curview commitrow + global mainhead desc_heads anc_tags desc_tags allparents allchildren + + if {[info exists desc_heads($rowmenuid)] + && [lsearch -exact $desc_heads($rowmenuid) $mainhead] >= 0} { + set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\ + included in branch $mainhead -- really re-apply it?"] + if {!$ok} return + } + nowbusy cherrypick + update + set oldhead [exec git rev-parse HEAD] + # Unfortunately git-cherry-pick writes stuff to stderr even when + # no error occurs, and exec takes that as an indication of error... + if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} { + notbusy cherrypick + error_popup $err + return + } + set newhead [exec git rev-parse HEAD] + if {$newhead eq $oldhead} { + notbusy cherrypick + error_popup "No changes committed" + return + } + set allparents($newhead) $oldhead + lappend allchildren($oldhead) $newhead + set desc_heads($newhead) $mainhead + if {[info exists anc_tags($oldhead)]} { + set anc_tags($newhead) $anc_tags($oldhead) + } + set desc_tags($newhead) {} + if {[info exists commitrow($curview,$oldhead)]} { + insertrow $commitrow($curview,$oldhead) $newhead + if {$mainhead ne {}} { + movedhead $newhead $mainhead + } + redrawtags $oldhead + redrawtags $newhead + } + notbusy cherrypick +} + +# context menu for a head +proc headmenu {x y id head} { + global headmenuid headmenuhead headctxmenu + + set headmenuid $id + set headmenuhead $head + tk_popup $headctxmenu $x $y +} + +proc cobranch {} { + global headmenuid headmenuhead mainhead headids + + # check the tree is clean first?? + set oldmainhead $mainhead + nowbusy checkout + update + if {[catch { + exec git checkout $headmenuhead + } err]} { + notbusy checkout + error_popup $err + } else { + notbusy checkout + set mainhead $headmenuhead + if {[info exists headids($oldmainhead)]} { + redrawtags $headids($oldmainhead) + } + redrawtags $headmenuid + } +} + +proc rmbranch {} { + global desc_heads headmenuid headmenuhead mainhead + global headids idheads + + set head $headmenuhead + set id $headmenuid + if {$head eq $mainhead} { + error_popup "Cannot delete the currently checked-out branch" + return + } + if {$desc_heads($id) eq $head} { + # the stuff on this branch isn't on any other branch + if {![confirm_popup "The commits on branch $head aren't on any other\ + branch.\nReally delete branch $head?"]} return + } + nowbusy rmbranch + update + if {[catch {exec git branch -D $head} err]} { + notbusy rmbranch + error_popup $err + return + } + removedhead $id $head + redrawtags $id + notbusy rmbranch +} + +# Stuff for finding nearby tags +proc getallcommits {} { + global allcstart allcommits allcfd allids + + set allids {} + set fd [open [concat | git rev-list --all --topo-order --parents] r] + set allcfd $fd + fconfigure $fd -blocking 0 + set allcommits "reading" + nowbusy allcommits + restartgetall $fd +} + +proc discardallcommits {} { + global allparents allchildren allcommits allcfd + global desc_tags anc_tags alldtags tagisdesc allids desc_heads + + if {![info exists allcommits]} return + if {$allcommits eq "reading"} { + catch {close $allcfd} + } + foreach v {allcommits allchildren allparents allids desc_tags anc_tags + alldtags tagisdesc desc_heads} { + catch {unset $v} + } +} + +proc restartgetall {fd} { + global allcstart + + fileevent $fd readable [list getallclines $fd] + set allcstart [clock clicks -milliseconds] +} + +proc combine_dtags {l1 l2} { + global tagisdesc notfirstd + + set res [lsort -unique [concat $l1 $l2]] + for {set i 0} {$i < [llength $res]} {incr i} { + set x [lindex $res $i] + for {set j [expr {$i+1}]} {$j < [llength $res]} {} { + set y [lindex $res $j] + if {[info exists tagisdesc($x,$y)]} { + if {$tagisdesc($x,$y) > 0} { + # x is a descendent of y, exclude x + set res [lreplace $res $i $i] + incr i -1 + break + } else { + # y is a descendent of x, exclude y + set res [lreplace $res $j $j] + } + } else { + # no relation, keep going + incr j + } + } + } + return $res +} + +proc combine_atags {l1 l2} { + global tagisdesc + + set res [lsort -unique [concat $l1 $l2]] + for {set i 0} {$i < [llength $res]} {incr i} { + set x [lindex $res $i] + for {set j [expr {$i+1}]} {$j < [llength $res]} {} { + set y [lindex $res $j] + if {[info exists tagisdesc($x,$y)]} { + if {$tagisdesc($x,$y) < 0} { + # x is an ancestor of y, exclude x + set res [lreplace $res $i $i] + incr i -1 + break + } else { + # y is an ancestor of x, exclude y + set res [lreplace $res $j $j] + } + } else { + # no relation, keep going + incr j + } + } + } + return $res +} + +proc forward_pass {id children} { + global idtags desc_tags idheads desc_heads alldtags tagisdesc + + set dtags {} + set dheads {} + foreach child $children { + if {[info exists idtags($child)]} { + set ctags [list $child] + } else { + set ctags $desc_tags($child) + } + if {$dtags eq {}} { + set dtags $ctags + } elseif {$ctags ne $dtags} { + set dtags [combine_dtags $dtags $ctags] + } + set cheads $desc_heads($child) + if {$dheads eq {}} { + set dheads $cheads + } elseif {$cheads ne $dheads} { + set dheads [lsort -unique [concat $dheads $cheads]] + } + } + set desc_tags($id) $dtags if {[info exists idtags($id)]} { - set x $idtags($id) + set adt $dtags + foreach tag $dtags { + set adt [concat $adt $alldtags($tag)] + } + set adt [lsort -unique $adt] + set alldtags($id) $adt + foreach tag $adt { + set tagisdesc($id,$tag) -1 + set tagisdesc($tag,$id) 1 + } } - set y {} if {[info exists idheads($id)]} { - set y $idheads($id) + set dheads [concat $dheads $idheads($id)] } - set z {} - if {[info exists idotherrefs($id)]} { - set z $idotherrefs($id) + set desc_heads($id) $dheads +} + +proc getallclines {fd} { + global allparents allchildren allcommits allcstart + global desc_tags anc_tags idtags tagisdesc allids + global idheads travindex + + while {[gets $fd line] >= 0} { + set id [lindex $line 0] + lappend allids $id + set olds [lrange $line 1 end] + set allparents($id) $olds + if {![info exists allchildren($id)]} { + set allchildren($id) {} + } + foreach p $olds { + lappend allchildren($p) $id + } + # compute nearest tagged descendents as we go + # also compute descendent heads + forward_pass $id $allchildren($id) + if {[clock clicks -milliseconds] - $allcstart >= 50} { + fileevent $fd readable {} + after idle restartgetall $fd + return + } + } + if {[eof $fd]} { + set travindex [llength $allids] + set allcommits "traversing" + after idle restartatags + if {[catch {close $fd} err]} { + error_popup "Error reading full commit graph: $err.\n\ + Results may be incomplete." + } + } +} + +# walk backward through the tree and compute nearest tagged ancestors +proc restartatags {} { + global allids allparents idtags anc_tags travindex + + set t0 [clock clicks -milliseconds] + set i $travindex + while {[incr i -1] >= 0} { + set id [lindex $allids $i] + set atags {} + foreach p $allparents($id) { + if {[info exists idtags($p)]} { + set ptags [list $p] + } else { + set ptags $anc_tags($p) + } + if {$atags eq {}} { + set atags $ptags + } elseif {$ptags ne $atags} { + set atags [combine_atags $atags $ptags] + } + } + set anc_tags($id) $atags + if {[clock clicks -milliseconds] - $t0 >= 50} { + set travindex $i + after idle restartatags + return + } + } + set allcommits "done" + set travindex 0 + notbusy allcommits + dispneartags +} + +# update the desc_tags and anc_tags arrays for a new tag just added +proc addedtag {id} { + global desc_tags anc_tags allparents allchildren allcommits + global idtags tagisdesc alldtags + + if {![info exists desc_tags($id)]} return + set adt $desc_tags($id) + foreach t $desc_tags($id) { + set adt [concat $adt $alldtags($t)] + } + set adt [lsort -unique $adt] + set alldtags($id) $adt + foreach t $adt { + set tagisdesc($id,$t) -1 + set tagisdesc($t,$id) 1 + } + if {[info exists anc_tags($id)]} { + set todo $anc_tags($id) + while {$todo ne {}} { + set do [lindex $todo 0] + set todo [lrange $todo 1 end] + if {[info exists tagisdesc($id,$do)]} continue + set tagisdesc($do,$id) -1 + set tagisdesc($id,$do) 1 + if {[info exists anc_tags($do)]} { + set todo [concat $todo $anc_tags($do)] + } + } + } + + set lastold $desc_tags($id) + set lastnew [list $id] + set nup 0 + set nch 0 + set todo $allparents($id) + while {$todo ne {}} { + set do [lindex $todo 0] + set todo [lrange $todo 1 end] + if {![info exists desc_tags($do)]} continue + if {$desc_tags($do) ne $lastold} { + set lastold $desc_tags($do) + set lastnew [combine_dtags $lastold [list $id]] + incr nch + } + if {$lastold eq $lastnew} continue + set desc_tags($do) $lastnew + incr nup + if {![info exists idtags($do)]} { + set todo [concat $todo $allparents($do)] + } + } + + if {![info exists anc_tags($id)]} return + set lastold $anc_tags($id) + set lastnew [list $id] + set nup 0 + set nch 0 + set todo $allchildren($id) + while {$todo ne {}} { + set do [lindex $todo 0] + set todo [lrange $todo 1 end] + if {![info exists anc_tags($do)]} continue + if {$anc_tags($do) ne $lastold} { + set lastold $anc_tags($do) + set lastnew [combine_atags $lastold [list $id]] + incr nch + } + if {$lastold eq $lastnew} continue + set anc_tags($do) $lastnew + incr nup + if {![info exists idtags($do)]} { + set todo [concat $todo $allchildren($do)] + } + } +} + +# update the desc_heads array for a new head just added +proc addedhead {hid head} { + global desc_heads allparents headids idheads + + set headids($head) $hid + lappend idheads($hid) $head + + set todo [list $hid] + while {$todo ne {}} { + set do [lindex $todo 0] + set todo [lrange $todo 1 end] + if {![info exists desc_heads($do)] || + [lsearch -exact $desc_heads($do) $head] >= 0} continue + set oldheads $desc_heads($do) + lappend desc_heads($do) $head + set heads $desc_heads($do) + while {1} { + set p $allparents($do) + if {[llength $p] != 1 || ![info exists desc_heads($p)] || + $desc_heads($p) ne $oldheads} break + set do $p + set desc_heads($do) $heads + } + set todo [concat $todo $p] + } +} + +# update the desc_heads array for a head just removed +proc removedhead {hid head} { + global desc_heads allparents headids idheads + + unset headids($head) + if {$idheads($hid) eq $head} { + unset idheads($hid) + } else { + set i [lsearch -exact $idheads($hid) $head] + if {$i >= 0} { + set idheads($hid) [lreplace $idheads($hid) $i $i] + } + } + + set todo [list $hid] + while {$todo ne {}} { + set do [lindex $todo 0] + set todo [lrange $todo 1 end] + if {![info exists desc_heads($do)]} continue + set i [lsearch -exact $desc_heads($do) $head] + if {$i < 0} continue + set oldheads $desc_heads($do) + set heads [lreplace $desc_heads($do) $i $i] + while {1} { + set desc_heads($do) $heads + set p $allparents($do) + if {[llength $p] != 1 || ![info exists desc_heads($p)] || + $desc_heads($p) ne $oldheads} break + set do $p + } + set todo [concat $todo $p] + } +} + +# update things for a head moved to a child of its previous location +proc movedhead {id name} { + global headids idheads + + set oldid $headids($name) + set headids($name) $id + if {$idheads($oldid) eq $name} { + unset idheads($oldid) + } else { + set i [lsearch -exact $idheads($oldid) $name] + if {$i >= 0} { + set idheads($oldid) [lreplace $idheads($oldid) $i $i] + } + } + lappend idheads($id) $name +} + +proc changedrefs {} { + global desc_heads desc_tags anc_tags allcommits allids + global allchildren allparents idtags travindex + + if {![info exists allcommits]} return + catch {unset desc_heads} + catch {unset desc_tags} + catch {unset anc_tags} + catch {unset alldtags} + catch {unset tagisdesc} + foreach id $allids { + forward_pass $id $allchildren($id) + } + if {$allcommits ne "reading"} { + set travindex [llength $allids] + if {$allcommits ne "traversing"} { + set allcommits "traversing" + after idle restartatags + } } - return [list $x $y $z] } proc rereadrefs {} { - global idtags idheads idotherrefs + global idtags idheads idotherrefs mainhead set refids [concat [array names idtags] \ [array names idheads] [array names idotherrefs]] @@ -4921,17 +5721,39 @@ proc rereadrefs {} { set ref($id) [listrefs $id] } } + set oldmainhead $mainhead readrefs + changedrefs set refids [lsort -unique [concat $refids [array names idtags] \ [array names idheads] [array names idotherrefs]]] foreach id $refids { set v [listrefs $id] - if {![info exists ref($id)] || $ref($id) != $v} { + if {![info exists ref($id)] || $ref($id) != $v || + ($id eq $oldmainhead && $id ne $mainhead) || + ($id eq $mainhead && $id ne $oldmainhead)} { redrawtags $id } } } +proc listrefs {id} { + global idtags idheads idotherrefs + + set x {} + if {[info exists idtags($id)]} { + set x $idtags($id) + } + set y {} + if {[info exists idheads($id)]} { + set y $idheads($id) + } + set z {} + if {[info exists idotherrefs($id)]} { + set z $idotherrefs($id) + } + return [list $x $y $z] +} + proc showtag {tag isnew} { global ctext tagcontents tagids linknum @@ -4959,7 +5781,8 @@ proc doquit {} { proc doprefs {} { global maxwidth maxgraphpct diffopts - global oldprefs prefstop + global oldprefs prefstop showneartags + global bgcolor fgcolor ctext diffcolors set top .gitkprefs set prefstop $top @@ -4967,7 +5790,7 @@ proc doprefs {} { raise $top return } - foreach v {maxwidth maxgraphpct diffopts} { + foreach v {maxwidth maxgraphpct diffopts showneartags} { set oldprefs($v) [set $v] } toplevel $top @@ -4983,12 +5806,46 @@ proc doprefs {} { -font optionfont spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct grid x $top.maxpctl $top.maxpct -sticky w + label $top.ddisp -text "Diff display options" grid $top.ddisp - -sticky w -pady 10 label $top.diffoptl -text "Options for diff program" \ -font optionfont entry $top.diffopt -width 20 -textvariable diffopts grid x $top.diffoptl $top.diffopt -sticky w + frame $top.ntag + label $top.ntag.l -text "Display nearby tags" -font optionfont + checkbutton $top.ntag.b -variable showneartags + pack $top.ntag.b $top.ntag.l -side left + grid x $top.ntag -sticky w + + label $top.cdisp -text "Colors: press to choose" + grid $top.cdisp - -sticky w -pady 10 + label $top.bg -padx 40 -relief sunk -background $bgcolor + button $top.bgbut -text "Background" -font optionfont \ + -command [list choosecolor bgcolor 0 $top.bg background setbg] + grid x $top.bgbut $top.bg -sticky w + label $top.fg -padx 40 -relief sunk -background $fgcolor + button $top.fgbut -text "Foreground" -font optionfont \ + -command [list choosecolor fgcolor 0 $top.fg foreground setfg] + grid x $top.fgbut $top.fg -sticky w + label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0] + button $top.diffoldbut -text "Diff: old lines" -font optionfont \ + -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \ + [list $ctext tag conf d0 -foreground]] + grid x $top.diffoldbut $top.diffold -sticky w + label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1] + button $top.diffnewbut -text "Diff: new lines" -font optionfont \ + -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \ + [list $ctext tag conf d1 -foreground]] + grid x $top.diffnewbut $top.diffnew -sticky w + label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2] + button $top.hunksepbut -text "Diff: hunk header" -font optionfont \ + -command [list choosecolor diffcolors 2 $top.hunksep \ + "diff hunk header" \ + [list $ctext tag conf hunksep -foreground]] + grid x $top.hunksepbut $top.hunksep -sticky w + frame $top.buts button $top.buts.ok -text "OK" -command prefsok button $top.buts.can -text "Cancel" -command prefscan @@ -4998,11 +5855,40 @@ proc doprefs {} { grid $top.buts - - -pady 10 -sticky ew } +proc choosecolor {v vi w x cmd} { + global $v + + set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \ + -title "Gitk: choose color for $x"] + if {$c eq {}} return + $w conf -background $c + lset $v $vi $c + eval $cmd $c +} + +proc setbg {c} { + global bglist + + foreach w $bglist { + $w conf -background $c + } +} + +proc setfg {c} { + global fglist canv + + foreach w $fglist { + $w conf -foreground $c + } + allcanvs itemconf text -fill $c + $canv itemconf circle -outline $c +} + proc prefscan {} { global maxwidth maxgraphpct diffopts - global oldprefs prefstop + global oldprefs prefstop showneartags - foreach v {maxwidth maxgraphpct diffopts} { + foreach v {maxwidth maxgraphpct diffopts showneartags} { set $v $oldprefs($v) } catch {destroy $prefstop} @@ -5011,13 +5897,15 @@ proc prefscan {} { proc prefsok {} { global maxwidth maxgraphpct - global oldprefs prefstop + global oldprefs prefstop showneartags catch {destroy $prefstop} unset prefstop if {$maxwidth != $oldprefs(maxwidth) || $maxgraphpct != $oldprefs(maxgraphpct)} { redisplay + } elseif {$showneartags != $oldprefs(showneartags)} { + reselectline } } @@ -5328,8 +6216,12 @@ set downarrowlen 7 set mingaplen 30 set cmitmode "patch" set wrapcomment "none" +set showneartags 1 set colors {green red blue magenta darkgrey brown orange} +set bgcolor white +set fgcolor black +set diffcolors {red "#00a000" blue} catch {source ~/.gitk} @@ -5413,8 +6305,8 @@ if {$cmdline_files ne {} || $revtreeargs ne {}} { set viewargs(1) $revtreeargs set viewperm(1) 0 addviewmenu 1 - .bar.view entryconf 2 -state normal - .bar.view entryconf 3 -state normal + .bar.view entryconf Edit* -state normal + .bar.view entryconf Delete* -state normal } if {[info exists permviews]} {