From e1a7c81f6a8c5a96a3d07632514f85d9470c3a82 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Tue, 18 Jul 2006 01:52:14 +1000 Subject: gitk: Minor cleanups Removed some unnecessary quotes and globals, updated copyright notice. Signed-off-by: Paul Mackerras --- gitk | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/gitk b/gitk index 7d540c1b0..7b86c1916 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. @@ -341,13 +341,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 @@ -3263,8 +3263,7 @@ proc show_status {msg} { proc finishcommits {} { global commitidx phase curview - global canv mainfont ctext maincursor textcursor - global findinprogress pending_select + global pending_select if {$commitidx($curview) > 0} { drawrest @@ -3307,9 +3306,7 @@ proc notbusy {what} { } proc drawrest {} { - global numcommits global startmsecs - global canvy0 numcommits linespc global rowlaidout commitidx curview global pending_select @@ -3323,6 +3320,7 @@ proc drawrest {} { } set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}] + #global numcommits #puts "overall $drawmsecs ms for $numcommits commits" } -- cgit v1.2.1 From cec7bece83a42918457819b526c49c7d55f795c5 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Wed, 2 Aug 2006 09:38:10 +1000 Subject: gitk: Recompute ancestor/descendent heads/tags when rereading refs We weren't updating the desc_heads, desc_tags and anc_tags arrays when rereading the set of heads/tags/etc. The tricky thing to get right here is restarting the computation correctly when we are only half-way through it. Signed-off-by: Paul Mackerras --- gitk | 132 +++++++++++++++++++++++++++++++++++++++++++------------------------ 1 file changed, 85 insertions(+), 47 deletions(-) diff --git a/gitk b/gitk index 7b86c1916..1f0a2e6ec 100755 --- a/gitk +++ b/gitk @@ -4932,7 +4932,7 @@ proc domktag {} { proc redrawtags {id} { global canv linehtag commitrow idpos selectedline curview - global mainfont + global mainfont canvxmax if {![info exists commitrow($curview,$id)]} return drawcmitrow $commitrow($curview,$id) @@ -5020,8 +5020,9 @@ proc wrcomcan {} { # Stuff for finding nearby tags proc getallcommits {} { - global allcstart allcommits allcfd + 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 @@ -5105,10 +5106,52 @@ proc combine_atags {l1 l2} { 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 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 + } + } + if {[info exists idheads($id)]} { + lappend dheads $id + } + set desc_heads($id) $dheads +} + proc getallclines {fd} { global allparents allchildren allcommits allcstart - global desc_tags anc_tags idtags alldtags tagisdesc allids - global desc_heads idheads + global desc_tags anc_tags idtags tagisdesc allids + global desc_heads idheads travindex while {[gets $fd line] >= 0} { set id [lindex $line 0] @@ -5123,43 +5166,7 @@ proc getallclines {fd} { } # compute nearest tagged descendents as we go # also compute descendent heads - set dtags {} - set dheads {} - foreach child $allchildren($id) { - 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 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 - } - } - if {[info exists idheads($id)]} { - lappend dheads $id - } - set desc_heads($id) $dheads + forward_pass $id $allchildren($id) if {[clock clicks -milliseconds] - $allcstart >= 50} { fileevent $fd readable {} after idle restartgetall $fd @@ -5167,7 +5174,9 @@ proc getallclines {fd} { } } if {[eof $fd]} { - after idle restartatags [llength $allids] + 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." @@ -5176,10 +5185,11 @@ proc getallclines {fd} { } # walk backward through the tree and compute nearest tagged ancestors -proc restartatags {i} { - global allids allparents idtags anc_tags t0 +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 {} @@ -5197,17 +5207,41 @@ proc restartatags {i} { } set anc_tags($id) $atags if {[clock clicks -milliseconds] - $t0 >= 50} { - after idle restartatags $i + set travindex $i + after idle restartatags return } } set allcommits "done" + set travindex 0 notbusy allcommits dispneartags } +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 + } + } +} + proc rereadrefs {} { - global idtags idheads idotherrefs + global idtags idheads idotherrefs mainhead set refids [concat [array names idtags] \ [array names idheads] [array names idotherrefs]] @@ -5216,12 +5250,16 @@ 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 } } -- cgit v1.2.1 From d6ac1a86e932fdb48705b9b1b6e2849aaea9ad24 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Wed, 2 Aug 2006 09:41:04 +1000 Subject: gitk: Add a row context-menu item for creating a new branch Signed-off-by: Paul Mackerras --- gitk | 80 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 80 insertions(+) diff --git a/gitk b/gitk index 1f0a2e6ec..61106f2d3 100755 --- a/gitk +++ b/gitk @@ -711,6 +711,7 @@ 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 } # mouse-2 makes all windows scan vertically, but only the one @@ -5018,6 +5019,61 @@ proc wrcomcan {} { unset wrcomtop } +proc mkbranch {} { + global rowmenuid mkbrtop + + 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 { + set headids($name) $id + if {![info exists idheads($id)]} { + addedhead $id + } + lappend idheads($id) $name + # XXX should update list of heads displayed for selected commit + notbusy newbranch + redrawtags $id + } +} + # Stuff for finding nearby tags proc getallcommits {} { global allcstart allcommits allcfd allids @@ -5218,6 +5274,30 @@ proc restartatags {} { dispneartags } +# update the desc_heads array for a new head just added +proc addedhead {hid} { + global desc_heads allparents + + 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) $hid] >= 0} continue + set oldheads $desc_heads($do) + lappend desc_heads($do) $hid + 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] + } +} + proc changedrefs {} { global desc_heads desc_tags anc_tags allcommits allids global allchildren allparents idtags travindex -- cgit v1.2.1 From 10299152ca10107a4570764286e129572ed2f3c3 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Wed, 2 Aug 2006 09:52:01 +1000 Subject: gitk: Add a context menu for heads This menu allows you to check out a branch and to delete a branch. If you ask to delete a branch that has commits that aren't on any other branch, gitk will prompt for confirmation before doing the deletion. Signed-off-by: Paul Mackerras --- gitk | 118 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 118 insertions(+) diff --git a/gitk b/gitk index 61106f2d3..fc65cc0f2 100755 --- a/gitk +++ b/gitk @@ -384,6 +384,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 @@ -394,6 +411,7 @@ proc makewindow {} { 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 @@ -712,6 +730,13 @@ proc makewindow {} { $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 + + 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 @@ -3237,6 +3262,8 @@ proc drawtags {id x xt y1} { -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 @@ -5074,6 +5101,73 @@ proc mkbrgo {top} { } } +# 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 maainhead $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 $id} { + # 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 + } + unset headids($head) + if {$idheads($id) eq $head} { + unset idheads($id) + removedhead $id + } else { + set i [lsearch -exact $idheads($id) $head] + if {$i >= 0} { + set idheads($id) [lreplace $idheads($id) $i $i] + } + } + redrawtags $id + notbusy rmbranch +} + # Stuff for finding nearby tags proc getallcommits {} { global allcstart allcommits allcfd allids @@ -5298,6 +5392,30 @@ proc addedhead {hid} { } } +# update the desc_heads array for a head just removed +proc removedhead {hid} { + global desc_heads allparents + + 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) $hid] + 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] + } +} + proc changedrefs {} { global desc_heads desc_tags anc_tags allcommits allids global allchildren allparents idtags travindex -- cgit v1.2.1 From 53cda8d97e6ee53cc8defa8c7226f0b3093eb12a Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Wed, 2 Aug 2006 19:43:34 +1000 Subject: gitk: Fix a couple of buglets in the branch head menu items This fixes a silly typo (an extra a) and fixes the condition for asking for confirmation of removing a branch. Signed-off-by: Paul Mackerras --- gitk | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gitk b/gitk index fc65cc0f2..596f60586 100755 --- a/gitk +++ b/gitk @@ -5124,7 +5124,7 @@ proc cobranch {} { error_popup $err } else { notbusy checkout - set maainhead $headmenuhead + set mainhead $headmenuhead if {[info exists headids($oldmainhead)]} { redrawtags $headids($oldmainhead) } @@ -5142,7 +5142,7 @@ proc rmbranch {} { error_popup "Cannot delete the currently checked-out branch" return } - if {$desc_heads($id) eq $id} { + if {$desc_heads($id) eq $id && $idheads($id) eq [list $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 -- cgit v1.2.1 From ca6d8f58a15b9db621dd2b905a04d06bdff44bf8 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Sun, 6 Aug 2006 21:08:05 +1000 Subject: gitk: Add a menu item for cherry-picking commits This does a git-cherry-pick -r to cherry-pick the commit that was right-clicked on to the head of the current branch. This would work better with some minor changes to the git-cherry-pick script. Along the way, this changes desc_heads to record the names of the descendent heads rather than their IDs. Signed-off-by: Paul Mackerras --- gitk | 253 +++++++++++++++++++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 210 insertions(+), 43 deletions(-) diff --git a/gitk b/gitk index 596f60586..750a08107 100755 --- a/gitk +++ b/gitk @@ -730,6 +730,8 @@ proc makewindow {} { $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 @@ -3302,6 +3304,104 @@ proc finishcommits {} { catch {unset pending_select} } +# Inserting 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 + + 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 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 + + 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} { @@ -3629,27 +3729,20 @@ proc viewnextline {dir} { # add a list of tag or branch names at position pos # returns the number of names inserted -proc appendrefs {pos l var} { - global ctext commitrow linknum curview idtags $var +proc appendrefs {pos tags var} { + global ctext commitrow linknum curview $var if {[catch {$ctext index $pos}]} { return 0 } - set tags {} - foreach id $l { - foreach tag [set $var\($id\)] { - lappend tags [concat $tag $id] - } - } - set tags [lsort -index 1 $tags] + set tags [lsort $tags] set sep {} foreach tag $tags { - set name [lindex $tag 0] - set id [lindex $tag 1] + set id [set $var\($tag\)] set lk link$linknum incr linknum $ctext insert $pos $sep - $ctext insert $pos $name $lk + $ctext insert $pos $tag $lk $ctext tag conf $lk -foreground blue if {[info exists commitrow($curview,$id)]} { $ctext tag bind $lk <1> \ @@ -3663,6 +3756,18 @@ proc appendrefs {pos l var} { 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 @@ -3672,15 +3777,15 @@ proc dispneartags {} { set id $currentid $ctext conf -state normal if {[info exists desc_heads($id)]} { - if {[appendrefs branch $desc_heads($id) idheads] > 1} { + if {[appendrefs branch $desc_heads($id) headids] > 1} { $ctext insert "branch -2c" "es" } } if {[info exists anc_tags($id)]} { - appendrefs follows $anc_tags($id) idtags + appendrefs follows [taglist $anc_tags($id)] tagids } if {[info exists desc_tags($id)]} { - appendrefs precedes $desc_tags($id) idtags + appendrefs precedes [taglist $desc_tags($id)] tagids } $ctext conf -state disabled } @@ -3813,7 +3918,7 @@ proc selectline {l isnew} { $ctext mark set branch "end -1c" $ctext mark gravity branch left if {[info exists desc_heads($id)]} { - if {[appendrefs branch $desc_heads($id) idheads] > 1} { + if {[appendrefs branch $desc_heads($id) headids] > 1} { # turn "Branch" into "Branches" $ctext insert "branch -2c" "es" } @@ -3822,13 +3927,13 @@ proc selectline {l isnew} { $ctext mark set follows "end -1c" $ctext mark gravity follows left if {[info exists anc_tags($id)]} { - appendrefs follows $anc_tags($id) idtags + 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 $desc_tags($id) idtags + appendrefs precedes [taglist $desc_tags($id)] tagids } $ctext insert end "\n" } @@ -4489,6 +4594,7 @@ proc redisplay {} { drawvisible if {[info exists selectedline]} { selectline $selectedline 0 + allcanvs yview moveto [lindex $span 0] } } @@ -5090,17 +5196,57 @@ proc mkbrgo {top} { notbusy newbranch error_popup $err } else { - set headids($name) $id - if {![info exists idheads($id)]} { - addedhead $id - } - lappend idheads($id) $name + 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 @@ -5142,7 +5288,7 @@ proc rmbranch {} { error_popup "Cannot delete the currently checked-out branch" return } - if {$desc_heads($id) eq $id && $idheads($id) eq [list $head]} { + 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 @@ -5154,16 +5300,7 @@ proc rmbranch {} { error_popup $err return } - unset headids($head) - if {$idheads($id) eq $head} { - unset idheads($id) - removedhead $id - } else { - set i [lsearch -exact $idheads($id) $head] - if {$i >= 0} { - set idheads($id) [lreplace $idheads($id) $i $i] - } - } + removedhead $id $head redrawtags $id notbusy rmbranch } @@ -5293,7 +5430,7 @@ proc forward_pass {id children} { } } if {[info exists idheads($id)]} { - lappend dheads $id + set dheads [concat $dheads $idheads($id)] } set desc_heads($id) $dheads } @@ -5301,7 +5438,7 @@ proc forward_pass {id children} { proc getallclines {fd} { global allparents allchildren allcommits allcstart global desc_tags anc_tags idtags tagisdesc allids - global desc_heads idheads travindex + global idheads travindex while {[gets $fd line] >= 0} { set id [lindex $line 0] @@ -5369,17 +5506,20 @@ proc restartatags {} { } # update the desc_heads array for a new head just added -proc addedhead {hid} { - global desc_heads allparents +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) $hid] >= 0} continue + [lsearch -exact $desc_heads($do) $head] >= 0} continue set oldheads $desc_heads($do) - lappend desc_heads($do) $hid + lappend desc_heads($do) $head set heads $desc_heads($do) while {1} { set p $allparents($do) @@ -5393,15 +5533,25 @@ proc addedhead {hid} { } # update the desc_heads array for a head just removed -proc removedhead {hid} { - global desc_heads allparents +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) $hid] + 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] @@ -5416,6 +5566,23 @@ proc removedhead {hid} { } } +# 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 -- cgit v1.2.1 From ceadfe90c64b293a653bcbbce83283d2665d7cf9 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Tue, 8 Aug 2006 20:55:36 +1000 Subject: gitk: Update preceding/following tag info when creating a tag Signed-off-by: Paul Mackerras --- gitk | 77 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 77 insertions(+) diff --git a/gitk b/gitk index 750a08107..0f3522725 100755 --- a/gitk +++ b/gitk @@ -5062,6 +5062,7 @@ proc domktag {} { set tagids($tag) $id lappend idtags($id) $tag redrawtags $id + addedtag $id } proc redrawtags {id} { @@ -5505,6 +5506,82 @@ proc restartatags {} { 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 -- cgit v1.2.1 From d1e46756d312f65613863a41c256d852fcde330c Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Wed, 16 Aug 2006 20:02:32 +1000 Subject: gitk: Improve responsiveness while reading and layout out the graph This restructures layoutmore so that it can take a time limit and do limited amounts of graph layout and graph optimization, and return 1 if it exceeded the time limit before finishing everything it could do. Also getcommitlines reads at most half a megabyte each time, to limit the time it spends parsing the commits to about a tenth of a second. Also got rid of the unused ncmupdate variable while I was at it. Signed-off-by: Paul Mackerras --- gitk | 58 ++++++++++++++++++++++++++++++++++------------------------ 1 file changed, 34 insertions(+), 24 deletions(-) diff --git a/gitk b/gitk index 0f3522725..b66ccca4d 100755 --- a/gitk +++ b/gitk @@ -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] @@ -1697,7 +1689,7 @@ proc showview {n} { show_status "Reading commits..." } if {[info exists commfd($n)]} { - layoutmore + layoutmore {} } else { finishcommits } @@ -2378,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 + } } } -- cgit v1.2.1 From 561d038ab8adb2bab5ba368b88e620be18c4811b Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Mon, 28 Aug 2006 22:41:09 +1000 Subject: gitk: Fix some bugs in the new cherry-picking code When inserting the new commit row for the cherry-picked commit, we weren't advancing the selected line (if there is one), and we weren't updating commitlisted properly. --- gitk | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/gitk b/gitk index b66ccca4d..ebbeac63a 100755 --- a/gitk +++ b/gitk @@ -3314,14 +3314,14 @@ proc finishcommits {} { catch {unset pending_select} } -# Inserting a new commit as the child of the commit on row $row. +# 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 + global linesegends selectedline if {$row >= $numcommits} { puts "oops, inserting new row $row but only have $numcommits rows" @@ -3334,6 +3334,7 @@ proc insertrow {row newcmit} { 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] @@ -3409,6 +3410,9 @@ proc insertrow {row newcmit} { incr rowoptim incr numcommits + if {[info exists selectedline] && $selectedline >= $row} { + incr selectedline + } redisplay } -- cgit v1.2.1