From d59c4b6fb731e5fddb458106b2e18eed1087c507 Mon Sep 17 00:00:00 2001 From: Eygene Ryabinkin Date: Tue, 27 Mar 2007 14:36:12 +0400 Subject: [PATCH] Teach gitk to use the user-defined UI font everywhere. Some parts of gitk were not respecting the default GUI font. Most of them were catched and fixed. Signed-off-by: Eygene Ryabinkin Signed-off-by: Paul Mackerras --- gitk | 29 +++++++++++++++++++++++------ 1 file changed, 23 insertions(+), 6 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index db28d745dc..d47d3d8f84 100755 --- a/gitk +++ b/gitk @@ -648,8 +648,10 @@ proc makewindow {} { frame .bright.mode radiobutton .bright.mode.patch -text "Patch" \ -command reselectline -variable cmitmode -value "patch" + .bright.mode.patch configure -font $uifont radiobutton .bright.mode.tree -text "Tree" \ -command reselectline -variable cmitmode -value "tree" + .bright.mode.tree configure -font $uifont grid .bright.mode.patch .bright.mode.tree -sticky ew pack .bright.mode -side top -fill x set cflist .bright.cfiles @@ -922,6 +924,7 @@ proc bindall {event action} { } proc about {} { + global uifont set w .about if {[winfo exists $w]} { raise $w @@ -937,11 +940,14 @@ Copyright Use and redistribute under the terms of the GNU General Public License} \ -justify center -aspect 400 pack $w.m -side top -fill x -padx 20 -pady 20 + $w.m configure -font $uifont button $w.ok -text Close -command "destroy $w" pack $w.ok -side bottom + $w.ok configure -font $uifont } proc keys {} { + global uifont set w .keys if {[winfo exists $w]} { raise $w @@ -990,8 +996,10 @@ f Scroll diff view to next file } \ -justify left -bg white -border 2 -relief sunken pack $w.m -side top -fill both + $w.m configure -font $uifont button $w.ok -text Close -command "destroy $w" pack $w.ok -side bottom + $w.ok configure -font $uifont } # Procedures for manipulating the file list window at the @@ -1457,20 +1465,21 @@ proc vieweditor {top n title} { toplevel $top wm title $top $title label $top.nl -text "Name" -font $uifont - entry $top.name -width 20 -textvariable newviewname($n) + entry $top.name -width 20 -textvariable newviewname($n) -font $uifont grid $top.nl $top.name -sticky w -pady 5 - checkbutton $top.perm -text "Remember this view" -variable newviewperm($n) + checkbutton $top.perm -text "Remember this view" -variable newviewperm($n) \ + -font $uifont grid $top.perm - -pady 5 -sticky w message $top.al -aspect 1000 -font $uifont \ -text "Commits to include (arguments to git rev-list):" grid $top.al - -sticky w -pady 5 entry $top.args -width 50 -textvariable newviewargs($n) \ - -background white + -background white -font $uifont grid $top.args - -sticky ew -padx 5 message $top.l -aspect 1000 -font $uifont \ -text "Enter files and directories to include, one per line:" grid $top.l - -sticky w - text $top.t -width 40 -height 10 -background white + text $top.t -width 40 -height 10 -background white -font $uifont if {[info exists viewfiles($n)]} { foreach f $viewfiles($n) { $top.t insert end $f @@ -1481,8 +1490,10 @@ proc vieweditor {top n title} { } grid $top.t - -sticky ew -padx 5 frame $top.buts - button $top.buts.ok -text "OK" -command [list newviewok $top $n] - button $top.buts.can -text "Cancel" -command [list destroy $top] + button $top.buts.ok -text "OK" -command [list newviewok $top $n] \ + -font $uifont + button $top.buts.can -text "Cancel" -command [list destroy $top] \ + -font $uifont 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 @@ -5813,6 +5824,7 @@ proc doprefs {} { global maxwidth maxgraphpct diffopts global oldprefs prefstop showneartags global bgcolor fgcolor ctext diffcolors + global uifont set top .gitkprefs set prefstop $top @@ -5826,6 +5838,7 @@ proc doprefs {} { toplevel $top wm title $top "Gitk preferences" label $top.ldisp -text "Commit list display options" + $top.ldisp configure -font $uifont grid $top.ldisp - -sticky w -pady 10 label $top.spacer -text " " label $top.maxwidthl -text "Maximum graph width (lines)" \ @@ -5838,6 +5851,7 @@ proc doprefs {} { grid x $top.maxpctl $top.maxpct -sticky w label $top.ddisp -text "Diff display options" + $top.ddisp configure -font $uifont grid $top.ddisp - -sticky w -pady 10 label $top.diffoptl -text "Options for diff program" \ -font optionfont @@ -5850,6 +5864,7 @@ proc doprefs {} { grid x $top.ntag -sticky w label $top.cdisp -text "Colors: press to choose" + $top.cdisp configure -font $uifont grid $top.cdisp - -sticky w -pady 10 label $top.bg -padx 40 -relief sunk -background $bgcolor button $top.bgbut -text "Background" -font optionfont \ @@ -5878,7 +5893,9 @@ proc doprefs {} { frame $top.buts button $top.buts.ok -text "OK" -command prefsok + $top.buts.ok configure -font $uifont button $top.buts.can -text "Cancel" -command prefscan + $top.buts.can configure -font $uifont 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 -- cgit v1.2.3 From 3a950e9a9cfc2eb4e30cf6e8658dab25196d746e Mon Sep 17 00:00:00 2001 From: Eygene Ryabinkin Date: Tue, 27 Mar 2007 14:36:59 +0400 Subject: [PATCH] Improve look-and-feel of the gitk tool. Made the default buttons on the dialog active and focused upon the dialog appearence. Bound 'Escape' and 'Return' keys to the dialog dismissal where it was appropriate: mainly for dialogs with only one button and no editable fields. Unified the look of the "About gitk" and "Key bindings" dialogs. Signed-off-by: Eygene Ryabinkin Signed-off-by: Paul Mackerras --- gitk | 23 +++++++++++++++-------- 1 file changed, 15 insertions(+), 8 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index d47d3d8f84..b1c65d7680 100755 --- a/gitk +++ b/gitk @@ -938,12 +938,15 @@ Gitk - a commit viewer for git Copyright © 2005-2006 Paul Mackerras Use and redistribute under the terms of the GNU General Public License} \ - -justify center -aspect 400 - pack $w.m -side top -fill x -padx 20 -pady 20 + -justify center -aspect 400 -border 2 -bg white -relief groove + pack $w.m -side top -fill x -padx 2 -pady 2 $w.m configure -font $uifont - button $w.ok -text Close -command "destroy $w" + button $w.ok -text Close -command "destroy $w" -default active pack $w.ok -side bottom $w.ok configure -font $uifont + bind $w "focus $w.ok" + bind $w "destroy $w" + bind $w "destroy $w" } proc keys {} { @@ -994,12 +997,15 @@ f Scroll diff view to next file Decrease font size Update } \ - -justify left -bg white -border 2 -relief sunken - pack $w.m -side top -fill both + -justify left -bg white -border 2 -relief groove + pack $w.m -side top -fill both -padx 2 -pady 2 $w.m configure -font $uifont - button $w.ok -text Close -command "destroy $w" + button $w.ok -text Close -command "destroy $w" -default active pack $w.ok -side bottom $w.ok configure -font $uifont + bind $w "focus $w.ok" + bind $w "destroy $w" + bind $w "destroy $w" } # Procedures for manipulating the file list window at the @@ -5892,14 +5898,15 @@ proc doprefs {} { grid x $top.hunksepbut $top.hunksep -sticky w frame $top.buts - button $top.buts.ok -text "OK" -command prefsok + button $top.buts.ok -text "OK" -command prefsok -default active $top.buts.ok configure -font $uifont - button $top.buts.can -text "Cancel" -command prefscan + button $top.buts.can -text "Cancel" -command prefscan -default normal $top.buts.can configure -font $uifont 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 + bind $top "focus $top.buts.ok" } proc choosecolor {v vi w x cmd} { -- cgit v1.2.3 From a8d610a2a39496a83108d95e7899e6b373e80940 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Thu, 19 Apr 2007 11:39:12 +1000 Subject: gitk: Allow user to choose whether to see the diff, old file, or new file This adds a set of radiobuttons that select between displaying the full diff (both - and + lines), the old file (suppressing the + lines) and the new file (suppressing the - lines) in the diff display window. Signed-off-by: Paul Mackerras --- gitk | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) (limited to 'gitk') diff --git a/gitk b/gitk index b1c65d7680..a57e84cef7 100755 --- a/gitk +++ b/gitk @@ -593,6 +593,7 @@ proc makewindow {} { frame .bleft -width $geometry(botwidth) -height $geometry(botheight) } frame .bleft.top + frame .bleft.mid button .bleft.top.search -text "Search" -command dosearch \ -font $uifont @@ -602,12 +603,20 @@ proc makewindow {} { lappend entries $sstring trace add variable searchstring write incrsearch pack $sstring -side left -expand 1 -fill x + radiobutton .bleft.mid.diff -text "Diff" \ + -command changediffdisp -variable diffelide -value {0 0} + radiobutton .bleft.mid.old -text "Old version" \ + -command changediffdisp -variable diffelide -value {0 1} + radiobutton .bleft.mid.new -text "New version" \ + -command changediffdisp -variable diffelide -value {1 0} + pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left set ctext .bleft.ctext text $ctext -background $bgcolor -foreground $fgcolor \ -state disabled -font $textfont \ -yscrollcommand scrolltext -wrap none scrollbar .bleft.sb -command "$ctext yview" pack .bleft.top -side top -fill x + pack .bleft.mid -side top -fill x pack .bleft.sb -side right -fill y pack $ctext -side left -fill both -expand 1 lappend bglist $ctext @@ -4486,6 +4495,13 @@ proc getblobdiffline {bdf ids} { } } +proc changediffdisp {} { + global ctext diffelide + + $ctext tag conf d0 -elide [lindex $diffelide 0] + $ctext tag conf d1 -elide [lindex $diffelide 1] +} + proc prevfile {} { global difffilestart ctext set prev [lindex $difffilestart 0] @@ -6330,6 +6346,7 @@ set highlight_paths {} set searchdirn -forwards set boldrows {} set boldnamerows {} +set diffelide {0 0} set optim_delay 16 -- cgit v1.2.3 From 696cf493f76b5dfb13d415571742a72034393a4a Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Tue, 22 May 2007 09:52:00 +1000 Subject: gitk: Use the -q flag to git checkout This avoids having gitk think that an error has occurred in the checkout. Signed-off-by: Paul Mackerras --- gitk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gitk') diff --git a/gitk b/gitk index a57e84cef7..3c9ea974d3 100755 --- a/gitk +++ b/gitk @@ -5356,7 +5356,7 @@ proc cobranch {} { nowbusy checkout update if {[catch { - exec git checkout $headmenuhead + exec git checkout -q $headmenuhead } err]} { notbusy checkout error_popup $err -- cgit v1.2.3 From 60378c0c0996522600dc31864dc60f5ca7d84529 Mon Sep 17 00:00:00 2001 From: Mark Levedahl Date: Sun, 20 May 2007 12:12:48 -0400 Subject: [PATCH] gitk: Make selection highlight color configurable Cygwin's tk by default uses a very dark selection background color that makes the currently selected text almost unreadable. On linux, the default selection background is a light gray which is very usable. This makes the default a light gray everywhere but allows the user to configure the color as well. Signed-off-by: Mark Levedahl Signed-off-by: Paul Mackerras --- gitk | 26 +++++++++++++++++++++++--- 1 file changed, 23 insertions(+), 3 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 3c9ea974d3..27b7dbd4f7 100755 --- a/gitk +++ b/gitk @@ -402,7 +402,7 @@ proc makewindow {} { global rowctxmenu mergemax wrapcomment global highlight_files gdttype global searchstring sstring - global bgcolor fgcolor bglist fglist diffcolors + global bgcolor fgcolor bglist fglist diffcolors selectbgcolor global headctxmenu menu .bar @@ -457,15 +457,18 @@ proc makewindow {} { set cscroll .tf.histframe.csb set canv .tf.histframe.pwclist.canv canvas $canv \ + -selectbackground $selectbgcolor \ -background $bgcolor -bd 0 \ -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll" .tf.histframe.pwclist add $canv set canv2 .tf.histframe.pwclist.canv2 canvas $canv2 \ + -selectbackground $selectbgcolor \ -background $bgcolor -bd 0 -yscrollincr $linespc .tf.histframe.pwclist add $canv2 set canv3 .tf.histframe.pwclist.canv3 canvas $canv3 \ + -selectbackground $selectbgcolor \ -background $bgcolor -bd 0 -yscrollincr $linespc .tf.histframe.pwclist add $canv3 eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0) @@ -666,6 +669,7 @@ proc makewindow {} { set cflist .bright.cfiles set indent [font measure $mainfont "nn"] text $cflist \ + -selectbackground $selectbgcolor \ -background $bgcolor -foreground $fgcolor \ -font $mainfont \ -tabs [list $indent [expr {2 * $indent}]] \ @@ -825,7 +829,7 @@ proc savestuff {w} { global maxwidth showneartags global viewname viewfiles viewargs viewperm nextviewnum global cmitmode wrapcomment - global colors bgcolor fgcolor diffcolors + global colors bgcolor fgcolor diffcolors selectbgcolor if {$stuffsaved} return if {![winfo viewable .]} return @@ -844,6 +848,7 @@ proc savestuff {w} { puts $f [list set fgcolor $fgcolor] puts $f [list set colors $colors] puts $f [list set diffcolors $diffcolors] + puts $f [list set selectbgcolor $selectbgcolor] puts $f "set geometry(main) [wm geometry .]" puts $f "set geometry(topwidth) [winfo width .tf]" @@ -5845,7 +5850,7 @@ proc doquit {} { proc doprefs {} { global maxwidth maxgraphpct diffopts global oldprefs prefstop showneartags - global bgcolor fgcolor ctext diffcolors + global bgcolor fgcolor ctext diffcolors selectbgcolor global uifont set top .gitkprefs @@ -5912,6 +5917,10 @@ proc doprefs {} { "diff hunk header" \ [list $ctext tag conf hunksep -foreground]] grid x $top.hunksepbut $top.hunksep -sticky w + label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor + button $top.selbgbut -text "Select bg" -font optionfont \ + -command [list choosecolor selectbgcolor 0 $top.bg background setselbg] + grid x $top.selbgbut $top.selbgsep -sticky w frame $top.buts button $top.buts.ok -text "OK" -command prefsok -default active @@ -5936,6 +5945,16 @@ proc choosecolor {v vi w x cmd} { eval $cmd $c } +proc setselbg {c} { + global bglist cflist + foreach w $bglist { + $w configure -selectbackground $c + } + $cflist tag configure highlight \ + -background [$cflist cget -selectbackground] + allcanvs itemconf secsel -fill $c +} + proc setbg {c} { global bglist @@ -6292,6 +6311,7 @@ set colors {green red blue magenta darkgrey brown orange} set bgcolor white set fgcolor black set diffcolors {red "#00a000" blue} +set selectbgcolor gray85 catch {source ~/.gitk} -- cgit v1.2.3 From 59ddaf3d19c174ab1547f4d8c0d76c564ddbf440 Mon Sep 17 00:00:00 2001 From: Mark Levedahl Date: Sun, 20 May 2007 11:45:49 -0400 Subject: [PATCH] gitk: Update fontsize in patch / tree list When adjusting fontsize (using ctrl+/-), all panes except the lower right were updated. This fixes that. Signed-off-by: Mark Levedahl Signed-off-by: Paul Mackerras --- gitk | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'gitk') diff --git a/gitk b/gitk index 27b7dbd4f7..8e41d56897 100755 --- a/gitk +++ b/gitk @@ -4695,13 +4695,14 @@ proc redisplay {} { } proc incrfont {inc} { - global mainfont textfont ctext canv phase + global mainfont textfont ctext canv phase cflist global stopped entries unmarkmatches set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]] set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]] setcoords $ctext conf -font $textfont + $cflist conf -font $textfont $ctext tag conf filesep -font [concat $textfont bold] foreach e $entries { $e conf -font $mainfont -- cgit v1.2.3 From 7e12f1a6291032a311ab592e42fd38f5ec358c0e Mon Sep 17 00:00:00 2001 From: Mark Levedahl Date: Sun, 20 May 2007 11:45:50 -0400 Subject: [PATCH] gitk: Allow specifying tabstop as other than default 8 characters. Not all projects use the convention that one tabstop = 8 characters, and a common convention is to use one tabstop = one level of indent. For such projects, using 8 characters per tabstop often shows too much whitespace per indent. This allows the user to configure the number of characters to use per tabstop. Signed-off-by: Mark Levedahl Signed-off-by: Paul Mackerras --- gitk | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 8e41d56897..9fd5f74708 100755 --- a/gitk +++ b/gitk @@ -395,7 +395,7 @@ proc confirm_popup msg { proc makewindow {} { global canv canv2 canv3 linespc charspc ctext cflist - global textfont mainfont uifont + global textfont mainfont uifont tabstop global findtype findtypemenu findloc findstring fstring geometry global entries sha1entry sha1string sha1but global maincursor textcursor curtextcursor @@ -615,6 +615,7 @@ proc makewindow {} { pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left set ctext .bleft.ctext text $ctext -background $bgcolor -foreground $fgcolor \ + -tabs "[expr {$tabstop * $charspc}]" \ -state disabled -font $textfont \ -yscrollcommand scrolltext -wrap none scrollbar .bleft.sb -command "$ctext yview" @@ -824,7 +825,7 @@ proc click {w} { } proc savestuff {w} { - global canv canv2 canv3 ctext cflist mainfont textfont uifont + global canv canv2 canv3 ctext cflist mainfont textfont uifont tabstop global stuffsaved findmergefiles maxgraphpct global maxwidth showneartags global viewname viewfiles viewargs viewperm nextviewnum @@ -838,6 +839,7 @@ proc savestuff {w} { puts $f [list set mainfont $mainfont] puts $f [list set textfont $textfont] puts $f [list set uifont $uifont] + puts $f [list set tabstop $tabstop] puts $f [list set findmergefiles $findmergefiles] puts $f [list set maxgraphpct $maxgraphpct] puts $f [list set maxwidth $maxwidth] @@ -4696,12 +4698,13 @@ proc redisplay {} { proc incrfont {inc} { global mainfont textfont ctext canv phase cflist + global charspc tabstop global stopped entries unmarkmatches set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]] set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]] setcoords - $ctext conf -font $textfont + $ctext conf -font $textfont -tabs "[expr {$tabstop * $charspc}]" $cflist conf -font $textfont $ctext tag conf filesep -font [concat $textfont bold] foreach e $entries { @@ -5852,7 +5855,7 @@ proc doprefs {} { global maxwidth maxgraphpct diffopts global oldprefs prefstop showneartags global bgcolor fgcolor ctext diffcolors selectbgcolor - global uifont + global uifont tabstop set top .gitkprefs set prefstop $top @@ -5890,6 +5893,9 @@ proc doprefs {} { checkbutton $top.ntag.b -variable showneartags pack $top.ntag.b $top.ntag.l -side left grid x $top.ntag -sticky w + label $top.tabstopl -text "tabstop" -font optionfont + entry $top.tabstop -width 10 -textvariable tabstop + grid x $top.tabstopl $top.tabstop -sticky w label $top.cdisp -text "Colors: press to choose" $top.cdisp configure -font $uifont @@ -5988,9 +5994,11 @@ proc prefscan {} { proc prefsok {} { global maxwidth maxgraphpct global oldprefs prefstop showneartags + global charspc ctext tabstop catch {destroy $prefstop} unset prefstop + $ctext configure -tabs "[expr {$tabstop * $charspc}]" if {$maxwidth != $oldprefs(maxwidth) || $maxgraphpct != $oldprefs(maxgraphpct)} { redisplay @@ -6296,6 +6304,7 @@ if {$tclencoding == {}} { set mainfont {Helvetica 9} set textfont {Courier 9} set uifont {Helvetica 9 bold} +set tabstop 8 set findmergefiles 0 set maxgraphpct 50 set maxwidth 16 -- cgit v1.2.3 From e11f12331552427113bcfd3721008ffc7227aac0 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Sat, 16 Jun 2007 20:29:25 +1000 Subject: gitk: New infrastructure for working out branches & previous/next tags Instead of working out descendent heads and descendent & ancestor branches in a two-pass algorithm, this reads and stores a simplified version of the graph topology, and works out descendent/ancestor tags and descendent heads on demand (with a bit of caching). The advantages of this are, first, that we now don't have to use --topo-order on the git rev-list process. Secondly, we don't have to re-read the whole graph when tags or heads change or even when the graph changes. Since we can cope with parents coming before children, we can update the graph by running a git rev-list with arguments that just give us the new commits, and merge the new commits into the simplified graph. The graph is simplified in the sense that commits with exactly one parent and one child (which is >90% of them in most cases) are grouped together into arcs joining nodes or 'branch/merge points', which are the commits that don't have exactly 1 parent and 1 child. This reduces the size of the graph substantially and decreases the time to traverse it correspondingly. Signed-off-by: Paul Mackerras --- gitk | 1240 +++++++++++++++++++++++++++++++++++++++++++++++------------------- 1 file changed, 890 insertions(+), 350 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 9fd5f74708..5948ec37c5 100755 --- a/gitk +++ b/gitk @@ -230,8 +230,9 @@ proc updatecommits {} { catch {unset selectedline} catch {unset thickerline} catch {unset viewdata($n)} - discardallcommits readrefs + changedrefs + regetallcommits showview $n } @@ -359,6 +360,30 @@ proc readrefs {} { } } +# update things for a head moved to a child of its previous location +proc movehead {id name} { + global headids idheads + + removehead $headids($name) $name + set headids($name) $id + lappend idheads($id) $name +} + +# update things when a head has been removed +proc removehead {id name} { + global headids idheads + + if {$idheads($id) eq $name} { + unset idheads($id) + } else { + set i [lsearch -exact $idheads($id) $name] + if {$i >= 0} { + set idheads($id) [lreplace $idheads($id) $i $i] + } + } + unset headids($name) +} + proc show_error {w top msg} { message $w.m -text $msg -justify center -aspect 400 pack $w.m -side top -fill x -padx 20 -pady 20 @@ -3805,22 +3830,31 @@ proc viewnextline {dir} { # add a list of tag or branch names at position pos # returns the number of names inserted -proc appendrefs {pos tags var} { +proc appendrefs {pos ids var} { global ctext commitrow linknum curview $var if {[catch {$ctext index $pos}]} { return 0 } - set tags [lsort $tags] + $ctext conf -state normal + $ctext delete $pos "$pos lineend" + set tags {} + foreach id $ids { + foreach tag [set $var\($id\)] { + lappend tags [list $tag $id] + } + } + set tags [lsort -index 0 -decreasing $tags] set sep {} - foreach tag $tags { - set id [set $var\($tag\)] + foreach ti $tags { + set id [lindex $ti 1] set lk link$linknum incr linknum + $ctext tag delete $lk $ctext insert $pos $sep - $ctext insert $pos $tag $lk - $ctext tag conf $lk -foreground blue + $ctext insert $pos [lindex $ti 0] $lk if {[info exists commitrow($curview,$id)]} { + $ctext tag conf $lk -foreground blue $ctext tag bind $lk <1> \ [list selectline $commitrow($curview,$id) 1] $ctext tag conf $lk -underline 1 @@ -3829,41 +3863,58 @@ proc appendrefs {pos tags var} { } set sep ", " } + $ctext conf -state disabled return [llength $tags] } -proc taglist {ids} { - global idtags +# called when we have finished computing the nearby tags +proc dispneartags {delay} { + global selectedline currentid showneartags tagphase - set tags {} - foreach id $ids { - foreach tag $idtags($id) { - lappend tags $tag - } + if {![info exists selectedline] || !$showneartags} return + after cancel dispnexttag + if {$delay} { + after 200 dispnexttag + set tagphase -1 + } else { + after idle dispnexttag + set tagphase 0 } - 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 +proc dispnexttag {} { + global selectedline currentid showneartags tagphase ctext 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" + switch -- $tagphase { + 0 { + set dtags [desctags $currentid] + if {$dtags ne {}} { + appendrefs precedes $dtags idtags + } + } + 1 { + set atags [anctags $currentid] + if {$atags ne {}} { + appendrefs follows $atags idtags + } + } + 2 { + set dheads [descheads $currentid] + if {$dheads ne {}} { + if {[appendrefs branch $dheads idheads] > 1 + && [$ctext get "branch -3c"] eq "h"} { + # turn "Branch" into "Branches" + $ctext conf -state normal + $ctext insert "branch -2c" "es" + $ctext conf -state disabled + } + } } } - 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 + if {[incr tagphase] <= 2} { + after idle dispnexttag } - $ctext conf -state disabled } proc selectline {l isnew} { @@ -3873,7 +3924,7 @@ proc selectline {l isnew} { global currentid sha1entry global commentend idtags linknum global mergemax numcommits pending_select - global cmitmode desc_tags anc_tags showneartags allcommits desc_heads + global cmitmode showneartags allcommits catch {unset pending_select} $canv delete hover @@ -3993,25 +4044,14 @@ proc selectline {l isnew} { $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" + dispneartags 1 } $ctext insert end "\n" appendwithlinks [lindex $info 5] {comment} @@ -5297,26 +5337,28 @@ proc mkbrgo {top} { notbusy newbranch error_popup $err } else { + set headids($name) $id + lappend idheads($id) $name addedhead $id $name - # XXX should update list of heads displayed for selected commit notbusy newbranch redrawtags $id + dispneartags 0 } } proc cherrypick {} { global rowmenuid curview commitrow - global mainhead desc_heads anc_tags desc_tags allparents allchildren + global mainhead - if {[info exists desc_heads($rowmenuid)] - && [lsearch -exact $desc_heads($rowmenuid) $mainhead] >= 0} { + set oldhead [exec git rev-parse HEAD] + set dheads [descheads $rowmenuid] + if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 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]} { @@ -5330,16 +5372,11 @@ proc 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) {} + addnewchild $newhead $oldhead if {[info exists commitrow($curview,$oldhead)]} { insertrow $commitrow($curview,$oldhead) $newhead if {$mainhead ne {}} { + movehead $newhead $mainhead movedhead $newhead $mainhead } redrawtags $oldhead @@ -5380,7 +5417,7 @@ proc cobranch {} { } proc rmbranch {} { - global desc_heads headmenuid headmenuhead mainhead + global headmenuid headmenuhead mainhead global headids idheads set head $headmenuhead @@ -5389,7 +5426,8 @@ proc rmbranch {} { error_popup "Cannot delete the currently checked-out branch" return } - if {$desc_heads($id) eq $head} { + set dheads [descheads $id] + if {$dheads eq $headids($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 @@ -5401,385 +5439,887 @@ proc rmbranch {} { error_popup $err return } + removehead $id $head removedhead $id $head redrawtags $id notbusy rmbranch + dispneartags 0 } # Stuff for finding nearby tags proc getallcommits {} { - global allcstart allcommits allcfd allids + global allcommits allids nbmp nextarc seeds 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 + set nbmp 0 + set nextarc 0 + set allcommits 0 + set seeds {} + regetallcommits } -proc discardallcommits {} { - global allparents allchildren allcommits allcfd - global desc_tags anc_tags alldtags tagisdesc allids desc_heads +# Called when the graph might have changed +proc regetallcommits {} { + global allcommits seeds - 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} + set cmd [concat | git rev-list --all --parents] + foreach id $seeds { + lappend cmd "^$id" } + set fd [open $cmd r] + fconfigure $fd -blocking 0 + incr allcommits + nowbusy allcommits + restartgetall $fd } 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] +} + +# Since most commits have 1 parent and 1 child, we group strings of +# such commits into "arcs" joining branch/merge points (BMPs), which +# are commits that either don't have 1 parent or don't have 1 child. +# +# arcnos(id) - incoming arcs for BMP, arc we're on for other nodes +# arcout(id) - outgoing arcs for BMP +# arcids(a) - list of IDs on arc including end but not start +# arcstart(a) - BMP ID at start of arc +# arcend(a) - BMP ID at end of arc +# growing(a) - arc a is still growing +# arctags(a) - IDs out of arcids (excluding end) that have tags +# archeads(a) - IDs out of arcids (excluding end) that have heads +# The start of an arc is at the descendent end, so "incoming" means +# coming from descendents, and "outgoing" means going towards ancestors. + +proc getallclines {fd} { + global allids allparents allchildren idtags nextarc nbmp + global arcnos arcids arctags arcout arcend arcstart archeads growing + global seeds allcommits allcstart + + if {![info exists allcstart]} { + set allcstart [clock clicks -milliseconds] + } + set nid 0 + while {[gets $fd line] >= 0} { + set id [lindex $line 0] + if {[info exists allparents($id)]} { + # seen it already + continue + } + lappend allids $id + set olds [lrange $line 1 end] + set allparents($id) $olds + if {![info exists allchildren($id)]} { + set allchildren($id) {} + set arcnos($id) {} + lappend seeds $id + } else { + set a $arcnos($id) + if {[llength $olds] == 1 && [llength $a] == 1} { + lappend arcids($a) $id + if {[info exists idtags($id)]} { + lappend arctags($a) $id } - } else { - # no relation, keep going - incr j + if {[info exists idheads($id)]} { + lappend archeads($a) $id + } + if {[info exists allparents($olds)]} { + # seen parent already + if {![info exists arcout($olds)]} { + splitarc $olds + } + lappend arcids($a) $olds + set arcend($a) $olds + unset growing($a) + } + lappend allchildren($olds) $id + lappend arcnos($olds) $a + continue + } + } + incr nbmp + foreach a $arcnos($id) { + lappend arcids($a) $id + set arcend($a) $id + unset growing($a) + } + + set ao {} + foreach p $olds { + lappend allchildren($p) $id + set a [incr nextarc] + set arcstart($a) $id + set archeads($a) {} + set arctags($a) {} + set archeads($a) {} + set arcids($a) {} + lappend ao $a + set growing($a) 1 + if {[info exists allparents($p)]} { + # seen it already, may need to make a new branch + if {![info exists arcout($p)]} { + splitarc $p + } + lappend arcids($a) $p + set arcend($a) $p + unset growing($a) + } + lappend arcnos($p) $a + } + set arcout($id) $ao + if {[incr nid] >= 50} { + set nid 0 + if {[clock clicks -milliseconds] - $allcstart >= 50} { + fileevent $fd readable {} + after idle restartgetall $fd + unset allcstart + return } } } - return $res + if {![eof $fd]} return + close $fd + if {[incr allcommits -1] == 0} { + notbusy allcommits + } + dispneartags 0 } -proc combine_atags {l1 l2} { - global tagisdesc +proc recalcarc {a} { + global arctags archeads arcids idtags idheads - 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 - } + set at {} + set ah {} + foreach id [lrange $arcids($a) 0 end-1] { + if {[info exists idtags($id)]} { + lappend at $id + } + if {[info exists idheads($id)]} { + lappend ah $id } } - return $res + set arctags($a) $at + set archeads($a) $ah } -proc forward_pass {id children} { - global idtags desc_tags idheads desc_heads alldtags tagisdesc +proc splitarc {p} { + global arcnos arcids nextarc nbmp arctags archeads idtags idheads + global arcstart arcend arcout allparents growing - set dtags {} - set dheads {} - foreach child $children { - if {[info exists idtags($child)]} { - set ctags [list $child] + set a $arcnos($p) + if {[llength $a] != 1} { + puts "oops splitarc called but [llength $a] arcs already" + return + } + set a [lindex $a 0] + set i [lsearch -exact $arcids($a) $p] + if {$i < 0} { + puts "oops splitarc $p not in arc $a" + return + } + set na [incr nextarc] + if {[info exists arcend($a)]} { + set arcend($na) $arcend($a) + } else { + set l [lindex $allparents([lindex $arcids($a) end]) 0] + set j [lsearch -exact $arcnos($l) $a] + set arcnos($l) [lreplace $arcnos($l) $j $j $na] + } + set tail [lrange $arcids($a) [expr {$i+1}] end] + set arcids($a) [lrange $arcids($a) 0 $i] + set arcend($a) $p + set arcstart($na) $p + set arcout($p) $na + set arcids($na) $tail + if {[info exists growing($a)]} { + set growing($na) 1 + unset growing($a) + } + incr nbmp + + foreach id $tail { + if {[llength $arcnos($id)] == 1} { + set arcnos($id) $na } else { - set ctags $desc_tags($child) + set j [lsearch -exact $arcnos($id) $a] + set arcnos($id) [lreplace $arcnos($id) $j $j $na] } - if {$dtags eq {}} { - set dtags $ctags - } elseif {$ctags ne $dtags} { - set dtags [combine_dtags $dtags $ctags] + } + + # reconstruct tags and heads lists + if {$arctags($a) ne {} || $archeads($a) ne {}} { + recalcarc $a + recalcarc $na + } else { + set arctags($na) {} + set archeads($na) {} + } +} + +# Update things for a new commit added that is a child of one +# existing commit. Used when cherry-picking. +proc addnewchild {id p} { + global allids allparents allchildren idtags nextarc nbmp + global arcnos arcids arctags arcout arcend arcstart archeads growing + global seeds + + lappend allids $id + set allparents($id) [list $p] + set allchildren($id) {} + set arcnos($id) {} + lappend seeds $id + incr nbmp + lappend allchildren($p) $id + set a [incr nextarc] + set arcstart($a) $id + set archeads($a) {} + set arctags($a) {} + set arcids($a) [list $p] + set arcend($a) $p + if {![info exists arcout($p)]} { + splitarc $p + } + lappend arcnos($p) $a + set arcout($id) [list $a] +} + +# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a, +# or 0 if neither is true. +proc anc_or_desc {a b} { + global arcout arcstart arcend arcnos cached_isanc + + if {$arcnos($a) eq $arcnos($b)} { + # Both are on the same arc(s); either both are the same BMP, + # or if one is not a BMP, the other is also not a BMP or is + # the BMP at end of the arc (and it only has 1 incoming arc). + if {$a eq $b} { + return 0 } - set cheads $desc_heads($child) - if {$dheads eq {}} { - set dheads $cheads - } elseif {$cheads ne $dheads} { - set dheads [lsort -unique [concat $dheads $cheads]] + # assert {[llength $arcnos($a)] == 1} + set arc [lindex $arcnos($a) 0] + set i [lsearch -exact $arcids($arc) $a] + set j [lsearch -exact $arcids($arc) $b] + if {$i < 0 || $i > $j} { + return 1 + } else { + return -1 } } - set desc_tags($id) $dtags - if {[info exists idtags($id)]} { - set adt $dtags - foreach tag $dtags { - set adt [concat $adt $alldtags($tag)] + + if {![info exists arcout($a)]} { + set arc [lindex $arcnos($a) 0] + if {[info exists arcend($arc)]} { + set aend $arcend($arc) + } else { + set aend {} } - set adt [lsort -unique $adt] - set alldtags($id) $adt - foreach tag $adt { - set tagisdesc($id,$tag) -1 - set tagisdesc($tag,$id) 1 + set a $arcstart($arc) + } else { + set aend $a + } + if {![info exists arcout($b)]} { + set arc [lindex $arcnos($b) 0] + if {[info exists arcend($arc)]} { + set bend $arcend($arc) + } else { + set bend {} } + set b $arcstart($arc) + } else { + set bend $b } - if {[info exists idheads($id)]} { - set dheads [concat $dheads $idheads($id)] + if {$a eq $bend} { + return 1 + } + if {$b eq $aend} { + return -1 + } + if {[info exists cached_isanc($a,$bend)]} { + if {$cached_isanc($a,$bend)} { + return 1 + } + } + if {[info exists cached_isanc($b,$aend)]} { + if {$cached_isanc($b,$aend)} { + return -1 + } + if {[info exists cached_isanc($a,$bend)]} { + return 0 + } } - set desc_heads($id) $dheads -} -proc getallclines {fd} { - global allparents allchildren allcommits allcstart - global desc_tags anc_tags idtags tagisdesc allids - global idheads travindex + set todo [list $a $b] + set anc($a) a + set anc($b) b + for {set i 0} {$i < [llength $todo]} {incr i} { + set x [lindex $todo $i] + if {$anc($x) eq {}} { + continue + } + foreach arc $arcnos($x) { + set xd $arcstart($arc) + if {$xd eq $bend} { + set cached_isanc($a,$bend) 1 + set cached_isanc($b,$aend) 0 + return 1 + } elseif {$xd eq $aend} { + set cached_isanc($b,$aend) 1 + set cached_isanc($a,$bend) 0 + return -1 + } + if {![info exists anc($xd)]} { + set anc($xd) $anc($x) + lappend todo $xd + } elseif {$anc($xd) ne $anc($x)} { + set anc($xd) {} + } + } + } + set cached_isanc($a,$bend) 0 + set cached_isanc($b,$aend) 0 + return 0 +} - 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) {} +# This identifies whether $desc has an ancestor that is +# a growing tip of the graph and which is not an ancestor of $anc +# and returns 0 if so and 1 if not. +# If we subsequently discover a tag on such a growing tip, and that +# turns out to be a descendent of $anc (which it could, since we +# don't necessarily see children before parents), then $desc +# isn't a good choice to display as a descendent tag of +# $anc (since it is the descendent of another tag which is +# a descendent of $anc). Similarly, $anc isn't a good choice to +# display as a ancestor tag of $desc. +# +proc is_certain {desc anc} { + global arcnos arcout arcstart arcend growing problems + + set certain {} + if {[llength $arcnos($anc)] == 1} { + # tags on the same arc are certain + if {$arcnos($desc) eq $arcnos($anc)} { + return 1 } - foreach p $olds { - lappend allchildren($p) $id + if {![info exists arcout($anc)]} { + # if $anc is partway along an arc, use the start of the arc instead + set a [lindex $arcnos($anc) 0] + set anc $arcstart($a) } - # 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 {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} { + set x $desc + } else { + set a [lindex $arcnos($desc) 0] + set x $arcend($a) + } + if {$x == $anc} { + return 1 + } + set anclist [list $x] + set dl($x) 1 + set nnh 1 + set ngrowanc 0 + for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} { + set x [lindex $anclist $i] + if {$dl($x)} { + incr nnh -1 + } + set done($x) 1 + foreach a $arcout($x) { + if {[info exists growing($a)]} { + if {![info exists growanc($x)] && $dl($x)} { + set growanc($x) 1 + incr ngrowanc + } + } else { + set y $arcend($a) + if {[info exists dl($y)]} { + if {$dl($y)} { + if {!$dl($x)} { + set dl($y) 0 + if {![info exists done($y)]} { + incr nnh -1 + } + if {[info exists growanc($x)]} { + incr ngrowanc -1 + } + set xl [list $y] + for {set k 0} {$k < [llength $xl]} {incr k} { + set z [lindex $xl $k] + foreach c $arcout($z) { + if {[info exists arcend($c)]} { + set v $arcend($c) + if {[info exists dl($v)] && $dl($v)} { + set dl($v) 0 + if {![info exists done($v)]} { + incr nnh -1 + } + if {[info exists growanc($v)]} { + incr ngrowanc -1 + } + lappend xl $v + } + } + } + } + } + } + } elseif {$y eq $anc || !$dl($x)} { + set dl($y) 0 + lappend anclist $y + } else { + set dl($y) 1 + lappend anclist $y + incr nnh + } + } } } - 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." + foreach x [array names growanc] { + if {$dl($x)} { + return 0 } } + return 1 } -# walk backward through the tree and compute nearest tagged ancestors -proc restartatags {} { - global allids allparents idtags anc_tags travindex +proc validate_arctags {a} { + global arctags idtags - 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) + set i -1 + set na $arctags($a) + foreach id $arctags($a) { + incr i + if {![info exists idtags($id)]} { + set na [lreplace $na $i $i] + incr i -1 + } + } + set arctags($a) $na +} + +proc validate_archeads {a} { + global archeads idheads + + set i -1 + set na $archeads($a) + foreach id $archeads($a) { + incr i + if {![info exists idheads($id)]} { + set na [lreplace $na $i $i] + incr i -1 + } + } + set archeads($a) $na +} + +# Return the list of IDs that have tags that are descendents of id, +# ignoring IDs that are descendents of IDs already reported. +proc desctags {id} { + global arcnos arcstart arcids arctags idtags allparents + global growing cached_dtags + + if {![info exists allparents($id)]} { + return {} + } + set t1 [clock clicks -milliseconds] + set argid $id + if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} { + # part-way along an arc; check that arc first + set a [lindex $arcnos($id) 0] + if {$arctags($a) ne {}} { + validate_arctags $a + set i [lsearch -exact $arcids($a) $id] + set tid {} + foreach t $arctags($a) { + set j [lsearch -exact $arcids($a) $t] + if {$j >= $i} break + set tid $t } - if {$atags eq {}} { - set atags $ptags - } elseif {$ptags ne $atags} { - set atags [combine_atags $atags $ptags] + if {$tid ne {}} { + return $tid } } - set anc_tags($id) $atags - if {[clock clicks -milliseconds] - $t0 >= 50} { - set travindex $i - after idle restartatags - return + set id $arcstart($a) + if {[info exists idtags($id)]} { + return $id + } + } + if {[info exists cached_dtags($id)]} { + return $cached_dtags($id) + } + + set origid $id + set todo [list $id] + set queued($id) 1 + set nc 1 + for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} { + set id [lindex $todo $i] + set done($id) 1 + set ta [info exists hastaggedancestor($id)] + if {!$ta} { + incr nc -1 + } + # ignore tags on starting node + if {!$ta && $i > 0} { + if {[info exists idtags($id)]} { + set tagloc($id) $id + set ta 1 + } elseif {[info exists cached_dtags($id)]} { + set tagloc($id) $cached_dtags($id) + set ta 1 + } + } + foreach a $arcnos($id) { + set d $arcstart($a) + if {!$ta && $arctags($a) ne {}} { + validate_arctags $a + if {$arctags($a) ne {}} { + lappend tagloc($id) [lindex $arctags($a) end] + } + } + if {$ta || $arctags($a) ne {}} { + set tomark [list $d] + for {set j 0} {$j < [llength $tomark]} {incr j} { + set dd [lindex $tomark $j] + if {![info exists hastaggedancestor($dd)]} { + if {[info exists done($dd)]} { + foreach b $arcnos($dd) { + lappend tomark $arcstart($b) + } + if {[info exists tagloc($dd)]} { + unset tagloc($dd) + } + } elseif {[info exists queued($dd)]} { + incr nc -1 + } + set hastaggedancestor($dd) 1 + } + } + } + if {![info exists queued($d)]} { + lappend todo $d + set queued($d) 1 + if {![info exists hastaggedancestor($d)]} { + incr nc + } + } } } - set allcommits "done" - set travindex 0 - notbusy allcommits - dispneartags -} + set tags {} + foreach id [array names tagloc] { + if {![info exists hastaggedancestor($id)]} { + foreach t $tagloc($id) { + if {[lsearch -exact $tags $t] < 0} { + lappend tags $t + } + } + } + } + set t2 [clock clicks -milliseconds] + set loopix $i -# 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)] + # remove tags that are descendents of other tags + for {set i 0} {$i < [llength $tags]} {incr i} { + set a [lindex $tags $i] + for {set j 0} {$j < $i} {incr j} { + set b [lindex $tags $j] + set r [anc_or_desc $a $b] + if {$r == 1} { + set tags [lreplace $tags $j $j] + incr j -1 + incr i -1 + } elseif {$r == -1} { + set tags [lreplace $tags $i $i] + incr i -1 + break } } } - 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 {[array names growing] ne {}} { + # graph isn't finished, need to check if any tag could get + # eclipsed by another tag coming later. Simply ignore any + # tags that could later get eclipsed. + set ctags {} + foreach t $tags { + if {[is_certain $t $origid]} { + lappend ctags $t + } } - if {$lastold eq $lastnew} continue - set desc_tags($do) $lastnew - incr nup - if {![info exists idtags($do)]} { - set todo [concat $todo $allparents($do)] + if {$tags eq $ctags} { + set cached_dtags($origid) $tags + } else { + set tags $ctags } + } else { + set cached_dtags($origid) $tags } + set t3 [clock clicks -milliseconds] + if {0 && $t3 - $t1 >= 100} { + puts "iterating descendents ($loopix/[llength $todo] nodes) took\ + [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left" + } + return $tags +} - 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 +proc anctags {id} { + global arcnos arcids arcout arcend arctags idtags allparents + global growing cached_atags + + if {![info exists allparents($id)]} { + return {} + } + set t1 [clock clicks -milliseconds] + set argid $id + if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} { + # part-way along an arc; check that arc first + set a [lindex $arcnos($id) 0] + if {$arctags($a) ne {}} { + validate_arctags $a + set i [lsearch -exact $arcids($a) $id] + foreach t $arctags($a) { + set j [lsearch -exact $arcids($a) $t] + if {$j > $i} { + return $t + } + } + } + if {![info exists arcend($a)]} { + return {} + } + set id $arcend($a) + if {[info exists idtags($id)]} { + return $id + } + } + if {[info exists cached_atags($id)]} { + return $cached_atags($id) + } + + set origid $id + set todo [list $id] + set queued($id) 1 + set taglist {} + set nc 1 + for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} { + set id [lindex $todo $i] + set done($id) 1 + set td [info exists hastaggeddescendent($id)] + if {!$td} { + incr nc -1 + } + # ignore tags on starting node + if {!$td && $i > 0} { + if {[info exists idtags($id)]} { + set tagloc($id) $id + set td 1 + } elseif {[info exists cached_atags($id)]} { + set tagloc($id) $cached_atags($id) + set td 1 + } } - if {$lastold eq $lastnew} continue - set anc_tags($do) $lastnew - incr nup - if {![info exists idtags($do)]} { - set todo [concat $todo $allchildren($do)] + foreach a $arcout($id) { + if {!$td && $arctags($a) ne {}} { + validate_arctags $a + if {$arctags($a) ne {}} { + lappend tagloc($id) [lindex $arctags($a) 0] + } + } + if {![info exists arcend($a)]} continue + set d $arcend($a) + if {$td || $arctags($a) ne {}} { + set tomark [list $d] + for {set j 0} {$j < [llength $tomark]} {incr j} { + set dd [lindex $tomark $j] + if {![info exists hastaggeddescendent($dd)]} { + if {[info exists done($dd)]} { + foreach b $arcout($dd) { + if {[info exists arcend($b)]} { + lappend tomark $arcend($b) + } + } + if {[info exists tagloc($dd)]} { + unset tagloc($dd) + } + } elseif {[info exists queued($dd)]} { + incr nc -1 + } + set hastaggeddescendent($dd) 1 + } + } + } + if {![info exists queued($d)]} { + lappend todo $d + set queued($d) 1 + if {![info exists hastaggeddescendent($d)]} { + incr nc + } + } + } + } + set t2 [clock clicks -milliseconds] + set loopix $i + set tags {} + foreach id [array names tagloc] { + if {![info exists hastaggeddescendent($id)]} { + foreach t $tagloc($id) { + if {[lsearch -exact $tags $t] < 0} { + lappend tags $t + } + } } } -} -# 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 + # remove tags that are ancestors of other tags + for {set i 0} {$i < [llength $tags]} {incr i} { + set a [lindex $tags $i] + for {set j 0} {$j < $i} {incr j} { + set b [lindex $tags $j] + set r [anc_or_desc $a $b] + if {$r == -1} { + set tags [lreplace $tags $j $j] + incr j -1 + incr i -1 + } elseif {$r == 1} { + set tags [lreplace $tags $i $i] + incr i -1 + break + } + } + } + + if {[array names growing] ne {}} { + # graph isn't finished, need to check if any tag could get + # eclipsed by another tag coming later. Simply ignore any + # tags that could later get eclipsed. + set ctags {} + foreach t $tags { + if {[is_certain $origid $t]} { + lappend ctags $t + } + } + if {$tags eq $ctags} { + set cached_atags($origid) $tags + } else { + set tags $ctags } - set todo [concat $todo $p] + } else { + set cached_atags($origid) $tags } + set t3 [clock clicks -milliseconds] + if {0 && $t3 - $t1 >= 100} { + puts "iterating ancestors ($loopix/[llength $todo] nodes) took\ + [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left" + } + return $tags } -# update the desc_heads array for a head just removed -proc removedhead {hid head} { - global desc_heads allparents headids idheads +# Return the list of IDs that have heads that are descendents of id, +# including id itself if it has a head. +proc descheads {id} { + global arcnos arcstart arcids archeads idheads cached_dheads + global allparents - 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] + if {![info exists allparents($id)]} { + return {} + } + set ret {} + if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} { + # part-way along an arc; check it first + set a [lindex $arcnos($id) 0] + if {$archeads($a) ne {}} { + validate_archeads $a + set i [lsearch -exact $arcids($a) $id] + foreach t $archeads($a) { + set j [lsearch -exact $arcids($a) $t] + if {$j > $i} break + lappend $ret $t + } } + set id $arcstart($a) } - - 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 origid $id + set todo [list $id] + set seen($id) 1 + for {set i 0} {$i < [llength $todo]} {incr i} { + set id [lindex $todo $i] + if {[info exists cached_dheads($id)]} { + set ret [concat $ret $cached_dheads($id)] + } else { + if {[info exists idheads($id)]} { + lappend ret $id + } + foreach a $arcnos($id) { + if {$archeads($a) ne {}} { + set ret [concat $ret $archeads($a)] + } + set d $arcstart($a) + if {![info exists seen($d)]} { + lappend todo $d + set seen($d) 1 + } + } } - set todo [concat $todo $p] } + set ret [lsort -unique $ret] + set cached_dheads($origid) $ret } -# update things for a head moved to a child of its previous location -proc movedhead {id name} { - global headids idheads +proc addedtag {id} { + global arcnos arcout cached_dtags cached_atags - 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] - } + if {![info exists arcnos($id)]} return + if {![info exists arcout($id)]} { + recalcarc [lindex $arcnos($id) 0] } - lappend idheads($id) $name + catch {unset cached_dtags} + catch {unset cached_atags} } -proc changedrefs {} { - global desc_heads desc_tags anc_tags allcommits allids - global allchildren allparents idtags travindex +proc addedhead {hid head} { + global arcnos arcout cached_dheads + + if {![info exists arcnos($hid)]} return + if {![info exists arcout($hid)]} { + recalcarc [lindex $arcnos($hid) 0] + } + catch {unset cached_dheads} +} + +proc removedhead {hid head} { + global cached_dheads + + catch {unset cached_dheads} +} + +proc movedhead {hid head} { + global arcnos arcout cached_dheads - 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 {![info exists arcnos($hid)]} return + if {![info exists arcout($hid)]} { + recalcarc [lindex $arcnos($hid) 0] } - if {$allcommits ne "reading"} { - set travindex [llength $allids] - if {$allcommits ne "traversing"} { - set allcommits "traversing" - after idle restartatags + catch {unset cached_dheads} +} + +proc changedrefs {} { + global cached_dheads cached_dtags cached_atags + global arctags archeads arcnos arcout idheads idtags + + foreach id [concat [array names idheads] [array names idtags]] { + if {[info exists arcnos($id)] && ![info exists arcout($id)]} { + set a [lindex $arcnos($id) 0] + if {![info exists donearc($a)]} { + recalcarc $a + set donearc($a) 1 + } } } + catch {unset cached_dtags} + catch {unset cached_atags} + catch {unset cached_dheads} } proc rereadrefs {} { -- cgit v1.2.3 From 0a4dd8b855fb5e4997087badbb6291cfc3f57baf Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Sat, 16 Jun 2007 21:21:57 +1000 Subject: gitk: Don't try to list large numbers of tags or heads in the details pane With some large repositories, a commit can end up on thousands of branches, which results in an extremely long "Branches:" line in the details window, and that results in the window being extremely slow to scroll. This fixes it by just showing "many (N)" after "Branches:", "Follows:" or "Precedes:", where N is the number of heads or tags. The limit is currently set at 20 but could be made configurable (and the "many" could be a link to pop up a window listing them all in case anyone really wants to know). Signed-off-by: Paul Mackerras --- gitk | 42 ++++++++++++++++++++++++------------------ 1 file changed, 24 insertions(+), 18 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 5948ec37c5..de5bae7a0e 100755 --- a/gitk +++ b/gitk @@ -3831,7 +3831,7 @@ proc viewnextline {dir} { # add a list of tag or branch names at position pos # returns the number of names inserted proc appendrefs {pos ids var} { - global ctext commitrow linknum curview $var + global ctext commitrow linknum curview $var maxrefs if {[catch {$ctext index $pos}]} { return 0 @@ -3844,24 +3844,29 @@ proc appendrefs {pos ids var} { lappend tags [list $tag $id] } } - set tags [lsort -index 0 -decreasing $tags] - set sep {} - foreach ti $tags { - set id [lindex $ti 1] - set lk link$linknum - incr linknum - $ctext tag delete $lk - $ctext insert $pos $sep - $ctext insert $pos [lindex $ti 0] $lk - if {[info exists commitrow($curview,$id)]} { - $ctext tag conf $lk -foreground blue - $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 } + if {[llength $tags] > $maxrefs} { + $ctext insert $pos "many ([llength $tags])" + } else { + set tags [lsort -index 0 -decreasing $tags] + set sep {} + foreach ti $tags { + set id [lindex $ti 1] + set lk link$linknum + incr linknum + $ctext tag delete $lk + $ctext insert $pos $sep + $ctext insert $pos [lindex $ti 0] $lk + if {[info exists commitrow($curview,$id)]} { + $ctext tag conf $lk -foreground blue + $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 ", " } - set sep ", " } $ctext conf -state disabled return [llength $tags] @@ -6856,6 +6861,7 @@ set mingaplen 30 set cmitmode "patch" set wrapcomment "none" set showneartags 1 +set maxrefs 20 set colors {green red blue magenta darkgrey brown orange} set bgcolor white -- cgit v1.2.3 From 3fc4279a144d0c477749fbe5318e570739f569e2 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Fri, 15 Sep 2006 09:45:23 +1000 Subject: gitk: Add some more comments to the optimize_rows procedure Signed-off-by: Paul Mackerras --- gitk | 12 ++++++++++++ 1 file changed, 12 insertions(+) (limited to 'gitk') diff --git a/gitk b/gitk index de5bae7a0e..a67137443b 100755 --- a/gitk +++ b/gitk @@ -2739,7 +2739,13 @@ proc optimize_rows {row col endrow} { set isarrow 1 } } + # Looking at lines from this row to the previous row, + # make them go straight up if they end in an arrow on + # the previous row; otherwise make them go straight up + # or at 45 degrees. if {$z < -1 || ($z < 0 && $isarrow)} { + # Line currently goes left too much; + # insert pads in the previous row, then optimize it set npad [expr {-1 - $z + $isarrow}] set offs [incrange $offs $col $npad] insert_pad $y0 $x0 $npad @@ -2750,6 +2756,8 @@ proc optimize_rows {row col endrow} { set x0 [expr {$col + $z}] set z0 [lindex $rowoffsets $y0 $x0] } elseif {$z > 1 || ($z > 0 && $isarrow)} { + # Line currently goes right too much; + # insert pads in this line and adjust the next's rowoffsets set npad [expr {$z - 1 + $isarrow}] set y1 [expr {$row + 1}] set offs2 [lindex $rowoffsets $y1] @@ -2780,6 +2788,7 @@ proc optimize_rows {row col endrow} { set z0 [expr {$xc - $x0}] } } + # avoid lines jigging left then immediately right if {$z0 ne {} && $z < 0 && $z0 > 0} { insert_pad $y0 $x0 1 set offs [incrange $offs $col 1] @@ -2788,6 +2797,7 @@ proc optimize_rows {row col endrow} { } if {!$haspad} { set o {} + # Find the first column that doesn't have a line going right for {set col [llength $idlist]} {[incr col -1] >= 0} {} { set o [lindex $offs $col] if {$o eq {}} { @@ -2806,6 +2816,8 @@ proc optimize_rows {row col endrow} { } if {$o eq {} || $o <= 0} break } + # Insert a pad at that column as long as it has a line and + # isn't the last column, and adjust the next row' offsets if {$o ne {} && [incr col] < [llength $idlist]} { set y1 [expr {$row + 1}] set offs2 [lindex $rowoffsets $y1] -- cgit v1.2.3 From e507fd4871acc52cc95934d3d5a6faa04d504ec9 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Sat, 16 Jun 2007 21:51:08 +1000 Subject: gitk: Improve the behaviour of the initial selection It used to be that if you clicked on a line while gitk was still drawing stuff, it would immediately re-select the first line of the display. This fixes that. Signed-off-by: Paul Mackerras --- gitk | 38 ++++++++++++++++++++++++++++++-------- 1 file changed, 30 insertions(+), 8 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index a67137443b..b3df24d696 100755 --- a/gitk +++ b/gitk @@ -1671,7 +1671,7 @@ proc showview {n} { global pending_select phase global commitidx rowlaidout rowoptim linesegends global commfd nextupdate - global selectedview + global selectedview selectfirst global vparentlist vchildlist vdisporder vcmitlisted global hlview selectedhlview @@ -1689,6 +1689,9 @@ proc showview {n} { } else { set yscreen [expr {($ybot - $ytop) / 2}] } + } elseif {[info exists pending_select]} { + set selid $pending_select + unset pending_select } unselectline normalline @@ -1723,7 +1726,9 @@ proc showview {n} { .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}] if {![info exists viewdata($n)]} { - set pending_select $selid + if {$selid ne {}} { + set pending_select $selid + } getcommits return } @@ -1757,7 +1762,8 @@ proc showview {n} { set row 0 setcanvscroll set yf 0 - set row 0 + set row {} + set selectfirst 0 if {$selid ne {} && [info exists commitrow($n,$selid)]} { set row $commitrow($n,$selid) # try to get the selected row in the same position on the screen @@ -1770,7 +1776,17 @@ proc showview {n} { } allcanvs yview moveto $yf drawvisible - selectline $row 0 + if {$row ne {}} { + selectline $row 0 + } elseif {$selid ne {}} { + set pending_select $selid + } else { + if {$numcommits > 0} { + selectline 0 0 + } else { + set selectfirst 1 + } + } if {$phase ne {}} { if {$phase eq "getcommits"} { show_status "Reading commits..." @@ -2407,7 +2423,7 @@ proc initlayout {} { global nextcolor global parentlist childlist children global colormap rowtextx - global linesegends + global linesegends selectfirst set numcommits 0 set displayorder {} @@ -2427,6 +2443,7 @@ proc initlayout {} { catch {unset rowtextx} catch {unset idrowranges} set linesegends {} + set selectfirst 1 } proc setcanvscroll {} { @@ -2495,6 +2512,7 @@ proc layoutmore {tmax} { proc showstuff {canshow} { global numcommits commitrow pending_select selectedline global linesegends idrowranges idrangedrawn curview + global displayorder selectfirst if {$numcommits == 0} { global phase @@ -2533,8 +2551,13 @@ proc showstuff {canshow} { $commitrow($curview,$pending_select) < $numcommits} { selectline $commitrow($curview,$pending_select) 1 } - if {![info exists selectedline] && ![info exists pending_select]} { - selectline 0 1 + if {$selectfirst} { + if {[info exists selectedline] || [info exists pending_select]} { + set selectfirst 0 + } else { + selectline 0 1 + set selectfirst 0 + } } } @@ -3551,7 +3574,6 @@ proc drawrest {} { global rowlaidout commitidx curview global pending_select - set row $rowlaidout layoutrows $rowlaidout $commitidx($curview) 1 layouttail optimize_rows $row 0 $commitidx($curview) -- cgit v1.2.3 From 7eb3cb9c683624681541972910328054e9431b43 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Sun, 17 Jun 2007 14:45:00 +1000 Subject: gitk: Implement a simple scheduler for the compute-intensive stuff This allows us to do compute-intensive processing, such as laying out the graph, relatively efficiently while also having the GUI be reasonably responsive. The problem previously was that file events were serviced before X events, so reading from another process which supplies data quickly (hi git rev-list :) could mean that X events didn't get processed for a long time. With this, gitk finishes laying out the graph slightly sooner and still responds to the GUI while doing so. Signed-off-by: Paul Mackerras --- gitk | 563 +++++++++++++++++++++++++++++++++++++------------------------------ 1 file changed, 310 insertions(+), 253 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index b3df24d696..1b573e046a 100755 --- a/gitk +++ b/gitk @@ -16,13 +16,75 @@ proc gitdir {} { } } +# A simple scheduler for compute-intensive stuff. +# The aim is to make sure that event handlers for GUI actions can +# run at least every 50-100 ms. Unfortunately fileevent handlers are +# run before X event handlers, so reading from a fast source can +# make the GUI completely unresponsive. +proc run args { + global isonrunq runq + + set script $args + if {[info exists isonrunq($script)]} return + if {$runq eq {}} { + after idle dorunq + } + lappend runq [list {} $script] + set isonrunq($script) 1 +} + +proc filerun {fd script} { + fileevent $fd readable [list filereadable $fd $script] +} + +proc filereadable {fd script} { + global runq + + fileevent $fd readable {} + if {$runq eq {}} { + after idle dorunq + } + lappend runq [list $fd $script] +} + +proc dorunq {} { + global isonrunq runq + + set tstart [clock clicks -milliseconds] + set t0 $tstart + while {$runq ne {}} { + set fd [lindex $runq 0 0] + set script [lindex $runq 0 1] + set repeat [eval $script] + set t1 [clock clicks -milliseconds] + set t [expr {$t1 - $t0}] + set runq [lrange $runq 1 end] + if {$repeat ne {} && $repeat} { + if {$fd eq {} || $repeat == 2} { + # script returns 1 if it wants to be readded + # file readers return 2 if they could do more straight away + lappend runq [list $fd $script] + } else { + fileevent $fd readable [list filereadable $fd $script] + } + } elseif {$fd eq {}} { + unset isonrunq($script) + } + set t0 $t1 + if {$t1 - $tstart >= 80} break + } + if {$runq ne {}} { + after idle dorunq + } +} + +# Start off a git rev-list process and arrange to read its output proc start_rev_list {view} { - global startmsecs nextupdate + global startmsecs global commfd leftover tclencoding datemode global viewargs viewfiles commitidx set startmsecs [clock clicks -milliseconds] - set nextupdate [expr {$startmsecs + 100}] set commitidx($view) 0 set args $viewargs($view) if {$viewfiles($view) ne {}} { @@ -45,7 +107,7 @@ proc start_rev_list {view} { if {$tclencoding != {}} { fconfigure $fd -encoding $tclencoding } - fileevent $fd readable [list getcommitlines $fd $view] + filerun $fd [list getcommitlines $fd $view] nowbusy $view } @@ -72,7 +134,7 @@ proc getcommits {} { } proc getcommitlines {fd view} { - global commitlisted nextupdate + global commitlisted global leftover commfd global displayorder commitidx commitrow commitdata global parentlist childlist children curview hlview @@ -80,7 +142,9 @@ proc getcommitlines {fd view} { set stuff [read $fd 500000] if {$stuff == {}} { - if {![eof $fd]} return + if {![eof $fd]} { + return 1 + } global viewname unset commfd($view) notbusy $view @@ -105,9 +169,9 @@ proc getcommitlines {fd view} { error_popup $err } if {$view == $curview} { - after idle finishcommits + run chewcommits $view } - return + return 0 } set start 0 set gotsome 0 @@ -183,29 +247,42 @@ proc getcommitlines {fd view} { set gotsome 1 } if {$gotsome} { - if {$view == $curview} { - while {[layoutmore $nextupdate]} doupdate - } elseif {[info exists hlview] && $view == $hlview} { - vhighlightmore - } - } - if {[clock clicks -milliseconds] >= $nextupdate} { - doupdate + run chewcommits $view } + return 2 } -proc doupdate {} { - global commfd nextupdate numcommits +proc chewcommits {view} { + global curview hlview commfd + global selectedline pending_select + + set more 0 + if {$view == $curview} { + set allread [expr {![info exists commfd($view)]}] + set tlimit [expr {[clock clicks -milliseconds] + 50}] + set more [layoutmore $tlimit $allread] + if {$allread && !$more} { + global displayorder commitidx phase + global numcommits startmsecs - foreach v [array names commfd] { - fileevent $commfd($v) readable {} + if {[info exists pending_select]} { + set row [expr {[lindex $displayorder 0] eq $nullid}] + selectline $row 1 + } + if {$commitidx($curview) > 0} { + #set ms [expr {[clock clicks -milliseconds] - $startmsecs}] + #puts "overall $ms ms for $numcommits commits" + } else { + show_status "No commits selected" + } + notbusy layout + set phase {} + } } - update - set nextupdate [expr {[clock clicks -milliseconds] + 100}] - foreach v [array names commfd] { - set fd $commfd($v) - fileevent $fd readable [list getcommitlines $fd $v] + if {[info exists hlview] && $view == $hlview} { + vhighlightmore } + return $more } proc readcommit {id} { @@ -1594,9 +1671,9 @@ proc newviewok {top n} { set viewargs($n) $newargs addviewmenu $n if {!$newishighlight} { - after idle showview $n + run showview $n } else { - after idle addvhighlight $n + run addvhighlight $n } } else { # editing an existing view @@ -1612,7 +1689,7 @@ proc newviewok {top n} { set viewfiles($n) $files set viewargs($n) $newargs if {$curview == $n} { - after idle updatecommits + run updatecommits } } } @@ -1670,7 +1747,7 @@ proc showview {n} { global matchinglines treediffs global pending_select phase global commitidx rowlaidout rowoptim linesegends - global commfd nextupdate + global commfd global selectedview selectfirst global vparentlist vchildlist vdisporder vcmitlisted global hlview selectedhlview @@ -1791,11 +1868,7 @@ proc showview {n} { if {$phase eq "getcommits"} { show_status "Reading commits..." } - if {[info exists commfd($n)]} { - layoutmore {} - } else { - finishcommits - } + run chewcommits $n } elseif {$numcommits == 0} { show_status "No commits selected" } @@ -1983,7 +2056,7 @@ proc do_file_hl {serial} { set cmd [concat | git diff-tree -r -s --stdin $gdtargs] set filehighlight [open $cmd r+] fconfigure $filehighlight -blocking 0 - fileevent $filehighlight readable readfhighlight + filerun $filehighlight readfhighlight set fhl_list {} drawvisible flushhighlights @@ -2011,7 +2084,11 @@ proc readfhighlight {} { global filehighlight fhighlights commitrow curview mainfont iddrawn global fhl_list - while {[gets $filehighlight line] >= 0} { + if {![info exists filehighlight]} { + return 0 + } + set nr 0 + while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} { set line [string trim $line] set i [lsearch -exact $fhl_list $line] if {$i < 0} continue @@ -2035,8 +2112,10 @@ proc readfhighlight {} { puts "oops, git diff-tree died" catch {close $filehighlight} unset filehighlight + return 0 } next_hlcont + return 1 } proc find_change {name ix op} { @@ -2103,7 +2182,7 @@ proc vrel_change {name ix op} { rhighlight_none if {$highlight_related ne "None"} { - after idle drawvisible + run drawvisible } } @@ -2118,7 +2197,7 @@ proc rhighlight_sel {a} { set anc_todo [list $a] if {$highlight_related ne "None"} { rhighlight_none - after idle drawvisible + run drawvisible } } @@ -2474,15 +2553,17 @@ proc visiblerows {} { return [list $r0 $r1] } -proc layoutmore {tmax} { +proc layoutmore {tmax allread} { global rowlaidout rowoptim commitidx numcommits optim_delay - global uparrowlen curview + global uparrowlen curview rowidlist idinlist + set showdelay $optim_delay + set optdelay [expr {$uparrowlen + 1}] 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 {$rowoptim - $showdelay > $numcommits} { + showstuff [expr {$rowoptim - $showdelay}] + } elseif {$rowlaidout - $optdelay > $rowoptim} { + set nr [expr {$rowlaidout - $optdelay - $rowoptim}] if {$nr > 100} { set nr 100 } @@ -2496,10 +2577,23 @@ proc layoutmore {tmax} { set nr 150 } set row $rowlaidout - set rowlaidout [layoutrows $row [expr {$row + $nr}] 0] + set rowlaidout [layoutrows $row [expr {$row + $nr}] $allread] if {$rowlaidout == $row} { return 0 } + } elseif {$allread} { + set optdelay 0 + set nrows $commitidx($curview) + if {[lindex $rowidlist $nrows] ne {} || + [array names idinlist] ne {}} { + layouttail + set rowlaidout $commitidx($curview) + } elseif {$rowoptim == $nrows} { + set showdelay 0 + if {$numcommits == $nrows} { + return 0 + } + } } else { return 0 } @@ -2715,6 +2809,7 @@ proc layouttail {} { } foreach id [array names idinlist] { + unset idinlist($id) addextraid $id $row lset rowidlist $row [list $id] lset rowoffsets $row 0 @@ -3423,19 +3518,6 @@ proc show_status {msg} { -tags text -fill $fgcolor } -proc finishcommits {} { - global commitidx phase curview - global pending_select - - if {$commitidx($curview) > 0} { - drawrest - } else { - show_status "No commits selected" - } - set phase {} - 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. @@ -3569,24 +3651,6 @@ proc notbusy {what} { } } -proc drawrest {} { - global startmsecs - global rowlaidout commitidx curview - global pending_select - - layoutrows $rowlaidout $commitidx($curview) 1 - layouttail - optimize_rows $row 0 $commitidx($curview) - showstuff $commitidx($curview) - if {[info exists pending_select]} { - selectline 0 1 - } - - set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}] - #global numcommits - #puts "overall $drawmsecs ms for $numcommits commits" -} - proc findmatches {f} { global findtype foundstring foundstrlen if {$findtype == "Regexp"} { @@ -4243,7 +4307,7 @@ proc gettree {id} { set treefilelist($id) {} set treeidlist($id) {} fconfigure $gtf -blocking 0 - fileevent $gtf readable [list gettreeline $gtf $id] + filerun $gtf [list gettreeline $gtf $id] } } else { setfilelist $id @@ -4253,14 +4317,21 @@ proc gettree {id} { proc gettreeline {gtf id} { global treefilelist treeidlist treepending cmitmode diffids - while {[gets $gtf line] >= 0} { - if {[lindex $line 1] ne "blob"} continue - set sha1 [lindex $line 2] - set fname [lindex $line 3] - lappend treefilelist($id) $fname + set nl 0 + while {[incr nl] <= 1000 && [gets $gtf line] >= 0} { + set tl [split $line "\t"] + if {[lindex $tl 0 1] ne "blob"} continue + set sha1 [lindex $tl 0 2] + set fname [lindex $tl 1] + if {[string index $fname 0] eq "\""} { + set fname [lindex $fname 0] + } lappend treeidlist($id) $sha1 + lappend treefilelist($id) $fname + } + if {![eof $gtf]} { + return [expr {$nl >= 1000? 2: 1}] } - if {![eof $gtf]} return close $gtf unset treepending if {$cmitmode ne "tree"} { @@ -4272,6 +4343,7 @@ proc gettreeline {gtf id} { } else { setfilelist $id } + return 0 } proc showfile {f} { @@ -4289,7 +4361,7 @@ proc showfile {f} { return } fconfigure $bf -blocking 0 - fileevent $bf readable [list getblobline $bf $diffids] + filerun $bf [list getblobline $bf $diffids] $ctext config -state normal clear_ctext $commentend $ctext insert end "\n" @@ -4303,18 +4375,21 @@ proc getblobline {bf id} { if {$id ne $diffids || $cmitmode ne "tree"} { catch {close $bf} - return + return 0 } $ctext config -state normal - while {[gets $bf line] >= 0} { + set nl 0 + while {[incr nl] <= 1000 && [gets $bf line] >= 0} { $ctext insert end "$line\n" } if {[eof $bf]} { # delete last newline $ctext delete "end - 2c" "end - 1c" close $bf + return 0 } $ctext config -state disabled + return [expr {$nl >= 1000? 2: 1}] } proc mergediff {id l} { @@ -4334,83 +4409,78 @@ proc mergediff {id l} { fconfigure $mdf -blocking 0 set mdifffd($id) $mdf set np [llength [lindex $parentlist $l]] - fileevent $mdf readable [list getmergediffline $mdf $id $np] - set nextupdate [expr {[clock clicks -milliseconds] + 100}] + filerun $mdf [list getmergediffline $mdf $id $np] } proc getmergediffline {mdf id np} { - global diffmergeid ctext cflist nextupdate mergemax + global diffmergeid ctext cflist mergemax global difffilestart mdifffd - set n [gets $mdf line] - if {$n < 0} { - if {[eof $mdf]} { + $ctext conf -state normal + set nr 0 + while {[incr nr] <= 1000 && [gets $mdf line] >= 0} { + if {![info exists diffmergeid] || $id != $diffmergeid + || $mdf != $mdifffd($id)} { close $mdf + return 0 } - return - } - if {![info exists diffmergeid] || $id != $diffmergeid - || $mdf != $mdifffd($id)} { - return - } - $ctext conf -state normal - if {[regexp {^diff --cc (.*)} $line match fname]} { - # start of a new file - $ctext insert end "\n" - set here [$ctext index "end - 1c"] - lappend difffilestart $here - add_flist [list $fname] - set l [expr {(78 - [string length $fname]) / 2}] - set pad [string range "----------------------------------------" 1 $l] - $ctext insert end "$pad $fname $pad\n" filesep - } elseif {[regexp {^@@} $line]} { - $ctext insert end "$line\n" hunksep - } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} { - # do nothing - } else { - # parse the prefix - one ' ', '-' or '+' for each parent - set spaces {} - set minuses {} - set pluses {} - set isbad 0 - for {set j 0} {$j < $np} {incr j} { - set c [string range $line $j $j] - if {$c == " "} { - lappend spaces $j - } elseif {$c == "-"} { - lappend minuses $j - } elseif {$c == "+"} { - lappend pluses $j - } else { - set isbad 1 - break + if {[regexp {^diff --cc (.*)} $line match fname]} { + # start of a new file + $ctext insert end "\n" + set here [$ctext index "end - 1c"] + lappend difffilestart $here + add_flist [list $fname] + set l [expr {(78 - [string length $fname]) / 2}] + set pad [string range "----------------------------------------" 1 $l] + $ctext insert end "$pad $fname $pad\n" filesep + } elseif {[regexp {^@@} $line]} { + $ctext insert end "$line\n" hunksep + } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} { + # do nothing + } else { + # parse the prefix - one ' ', '-' or '+' for each parent + set spaces {} + set minuses {} + set pluses {} + set isbad 0 + for {set j 0} {$j < $np} {incr j} { + set c [string range $line $j $j] + if {$c == " "} { + lappend spaces $j + } elseif {$c == "-"} { + lappend minuses $j + } elseif {$c == "+"} { + lappend pluses $j + } else { + set isbad 1 + break + } } - } - set tags {} - set num {} - if {!$isbad && $minuses ne {} && $pluses eq {}} { - # line doesn't appear in result, parents in $minuses have the line - set num [lindex $minuses 0] - } elseif {!$isbad && $pluses ne {} && $minuses eq {}} { - # line appears in result, parents in $pluses don't have the line - lappend tags mresult - set num [lindex $spaces 0] - } - if {$num ne {}} { - if {$num >= $mergemax} { - set num "max" + set tags {} + set num {} + if {!$isbad && $minuses ne {} && $pluses eq {}} { + # line doesn't appear in result, parents in $minuses have the line + set num [lindex $minuses 0] + } elseif {!$isbad && $pluses ne {} && $minuses eq {}} { + # line appears in result, parents in $pluses don't have the line + lappend tags mresult + set num [lindex $spaces 0] } - lappend tags m$num + if {$num ne {}} { + if {$num >= $mergemax} { + set num "max" + } + lappend tags m$num + } + $ctext insert end "$line\n" $tags } - $ctext insert end "$line\n" $tags } $ctext conf -state disabled - if {[clock clicks -milliseconds] >= $nextupdate} { - incr nextupdate 100 - fileevent $mdf readable {} - update - fileevent $mdf readable [list getmergediffline $mdf $id $np] + if {[eof $mdf]} { + close $mdf + return 0 } + return [expr {$nr >= 1000? 2: 1}] } proc startdiff {ids} { @@ -4441,37 +4511,39 @@ proc gettreediffs {ids} { {set gdtf [open [concat | git diff-tree --no-commit-id -r $ids] r]} \ ]} return fconfigure $gdtf -blocking 0 - fileevent $gdtf readable [list gettreediffline $gdtf $ids] + filerun $gdtf [list gettreediffline $gdtf $ids] } proc gettreediffline {gdtf ids} { global treediff treediffs treepending diffids diffmergeid global cmitmode - set n [gets $gdtf line] - if {$n < 0} { - if {![eof $gdtf]} return - close $gdtf - set treediffs($ids) $treediff - unset treepending - if {$cmitmode eq "tree"} { - gettree $diffids - } elseif {$ids != $diffids} { - if {![info exists diffmergeid]} { - gettreediffs $diffids - } - } else { - addtocflist $ids + set nr 0 + while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} { + set file [lindex $line 5] + lappend treediff $file + } + if {![eof $gdtf]} { + return [expr {$nr >= 1000? 2: 1}] + } + close $gdtf + set treediffs($ids) $treediff + unset treepending + if {$cmitmode eq "tree"} { + gettree $diffids + } elseif {$ids != $diffids} { + if {![info exists diffmergeid]} { + gettreediffs $diffids } - return + } else { + addtocflist $ids } - set file [lindex $line 5] - lappend treediff $file + return 0 } proc getblobdiffs {ids} { global diffopts blobdifffd diffids env curdifftag curtagstart - global nextupdate diffinhdr treediffs + global diffinhdr treediffs set env(GIT_DIFF_OPTS) $diffopts set cmd [concat | git diff-tree --no-commit-id -r -p -C $ids] @@ -4484,8 +4556,7 @@ proc getblobdiffs {ids} { set blobdifffd($ids) $bdf set curdifftag Comments set curtagstart 0.0 - fileevent $bdf readable [list getblobdiffline $bdf $diffids] - set nextupdate [expr {[clock clicks -milliseconds] + 100}] + filerun $bdf [list getblobdiffline $bdf $diffids] } proc setinlist {var i val} { @@ -4504,81 +4575,78 @@ proc setinlist {var i val} { proc getblobdiffline {bdf ids} { global diffids blobdifffd ctext curdifftag curtagstart global diffnexthead diffnextnote difffilestart - global nextupdate diffinhdr treediffs + global diffinhdr treediffs - set n [gets $bdf line] - if {$n < 0} { - if {[eof $bdf]} { - close $bdf - if {$ids == $diffids && $bdf == $blobdifffd($ids)} { - $ctext tag add $curdifftag $curtagstart end - } - } - return - } - if {$ids != $diffids || $bdf != $blobdifffd($ids)} { - return - } + set nr 0 $ctext conf -state normal - if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} { - # start of a new file - $ctext insert end "\n" - $ctext tag add $curdifftag $curtagstart end - set here [$ctext index "end - 1c"] - set curtagstart $here - set header $newname - set i [lsearch -exact $treediffs($ids) $fname] - if {$i >= 0} { - setinlist difffilestart $i $here + while {[incr nr] <= 1000 && [gets $bdf line] >= 0} { + if {$ids != $diffids || $bdf != $blobdifffd($ids)} { + close $bdf + return 0 } - if {$newname ne $fname} { - set i [lsearch -exact $treediffs($ids) $newname] + if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} { + # start of a new file + $ctext insert end "\n" + $ctext tag add $curdifftag $curtagstart end + set here [$ctext index "end - 1c"] + set curtagstart $here + set header $newname + set i [lsearch -exact $treediffs($ids) $fname] if {$i >= 0} { setinlist difffilestart $i $here } - } - set curdifftag "f:$fname" - $ctext tag delete $curdifftag - set l [expr {(78 - [string length $header]) / 2}] - set pad [string range "----------------------------------------" 1 $l] - $ctext insert end "$pad $header $pad\n" filesep - set diffinhdr 1 - } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} { - # do nothing - } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} { - set diffinhdr 0 - } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \ - $line match f1l f1c f2l f2c rest]} { - $ctext insert end "$line\n" hunksep - set diffinhdr 0 - } else { - set x [string range $line 0 0] - if {$x == "-" || $x == "+"} { - set tag [expr {$x == "+"}] - $ctext insert end "$line\n" d$tag - } elseif {$x == " "} { - $ctext insert end "$line\n" - } elseif {$diffinhdr || $x == "\\"} { - # e.g. "\ No newline at end of file" - $ctext insert end "$line\n" filesep + if {$newname ne $fname} { + set i [lsearch -exact $treediffs($ids) $newname] + if {$i >= 0} { + setinlist difffilestart $i $here + } + } + set curdifftag "f:$fname" + $ctext tag delete $curdifftag + set l [expr {(78 - [string length $header]) / 2}] + set pad [string range "----------------------------------------" \ + 1 $l] + $ctext insert end "$pad $header $pad\n" filesep + set diffinhdr 1 + } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} { + # do nothing + } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} { + set diffinhdr 0 + } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \ + $line match f1l f1c f2l f2c rest]} { + $ctext insert end "$line\n" hunksep + set diffinhdr 0 } else { - # Something else we don't recognize - if {$curdifftag != "Comments"} { - $ctext insert end "\n" - $ctext tag add $curdifftag $curtagstart end - set curtagstart [$ctext index "end - 1c"] - set curdifftag Comments + set x [string range $line 0 0] + if {$x == "-" || $x == "+"} { + set tag [expr {$x == "+"}] + $ctext insert end "$line\n" d$tag + } elseif {$x == " "} { + $ctext insert end "$line\n" + } elseif {$diffinhdr || $x == "\\"} { + # e.g. "\ No newline at end of file" + $ctext insert end "$line\n" filesep + } else { + # Something else we don't recognize + if {$curdifftag != "Comments"} { + $ctext insert end "\n" + $ctext tag add $curdifftag $curtagstart end + set curtagstart [$ctext index "end - 1c"] + set curdifftag Comments + } + $ctext insert end "$line\n" filesep } - $ctext insert end "$line\n" filesep } } $ctext conf -state disabled - if {[clock clicks -milliseconds] >= $nextupdate} { - incr nextupdate 100 - fileevent $bdf readable {} - update - fileevent $bdf readable "getblobdiffline $bdf {$ids}" + if {[eof $bdf]} { + close $bdf + if {$ids == $diffids && $bdf == $blobdifffd($ids)} { + $ctext tag add $curdifftag $curtagstart end + } + return 0 } + return [expr {$nr >= 1000? 2: 1}] } proc changediffdisp {} { @@ -5509,11 +5577,7 @@ proc regetallcommits {} { fconfigure $fd -blocking 0 incr allcommits nowbusy allcommits - restartgetall $fd -} - -proc restartgetall {fd} { - fileevent $fd readable [list getallclines $fd] + filerun $fd [list getallclines $fd] } # Since most commits have 1 parent and 1 child, we group strings of @@ -5534,13 +5598,10 @@ proc restartgetall {fd} { proc getallclines {fd} { global allids allparents allchildren idtags nextarc nbmp global arcnos arcids arctags arcout arcend arcstart archeads growing - global seeds allcommits allcstart + global seeds allcommits - if {![info exists allcstart]} { - set allcstart [clock clicks -milliseconds] - } set nid 0 - while {[gets $fd line] >= 0} { + while {[incr nid] <= 1000 && [gets $fd line] >= 0} { set id [lindex $line 0] if {[info exists allparents($id)]} { # seen it already @@ -5607,22 +5668,16 @@ proc getallclines {fd} { lappend arcnos($p) $a } set arcout($id) $ao - if {[incr nid] >= 50} { - set nid 0 - if {[clock clicks -milliseconds] - $allcstart >= 50} { - fileevent $fd readable {} - after idle restartgetall $fd - unset allcstart - return - } - } } - if {![eof $fd]} return + if {![eof $fd]} { + return [expr {$nid >= 1000? 2: 1}] + } close $fd if {[incr allcommits -1] == 0} { notbusy allcommits } dispneartags 0 + return 0 } proc recalcarc {a} { @@ -5919,6 +5974,7 @@ proc is_certain {desc anc} { if {$dl($x)} { return 0 } + return 0 } return 1 } @@ -6948,6 +7004,7 @@ if {$i >= 0} { } } +set runq {} set history {} set historyindex 0 set fh_serial 0 -- cgit v1.2.3 From 43c25074381dea404518318dacd360ed4f2abf3d Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Wed, 27 Sep 2006 10:56:02 +1000 Subject: gitk: Cope with commit messages with carriage-returns and initial blank lines In some repositories imported from other systems we can get carriage return characters in the commit message, which leads to a multi-line headline being displayed in the summary window, which looks bad. Also some commit messages start with one or more blank lines, which leads to an empty headline. This fixes these problems. Signed-off-by: Paul Mackerras --- gitk | 20 ++++++++++++++------ 1 file changed, 14 insertions(+), 6 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 1b573e046a..0c2767df0b 100755 --- a/gitk +++ b/gitk @@ -341,12 +341,16 @@ proc parsecommit {id contents listed} { } } set headline {} - # take the first line of the comment as the headline - set i [string first "\n" $comment] + # take the first non-blank line of the comment as the headline + set headline [string trimleft $comment] + set i [string first "\n" $headline] if {$i >= 0} { - set headline [string trim [string range $comment 0 $i]] - } else { - set headline $comment + set headline [string range $headline 0 $i] + } + set headline [string trimright $headline] + set i [string first "\r" $headline] + if {$i >= 0} { + set headline [string trimright [string range $headline 0 $i]] } if {!$listed} { # git rev-list indents the comment by 4 spaces; @@ -4157,7 +4161,11 @@ proc selectline {l isnew} { dispneartags 1 } $ctext insert end "\n" - appendwithlinks [lindex $info 5] {comment} + set comment [lindex $info 5] + if {[string first "\r" $comment] >= 0} { + set comment [string map {"\r" "\n "} $comment] + } + appendwithlinks $comment {comment} $ctext tag delete Comments $ctext tag remove found 1.0 end -- cgit v1.2.3 From 00609463979c3a2549c0c917a206345f51975b5d Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Sun, 17 Jun 2007 17:08:35 +1000 Subject: gitk: Disable the head context menu entries for the checked-out branch Neither the "check out this branch" nor the "remove this branch" menu item can be used on the currently-checked out branch, so disable them. Signed-off-by: Paul Mackerras --- gitk | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) (limited to 'gitk') diff --git a/gitk b/gitk index 0c2767df0b..6a45fcae4c 100755 --- a/gitk +++ b/gitk @@ -5502,10 +5502,16 @@ proc cherrypick {} { # context menu for a head proc headmenu {x y id head} { - global headmenuid headmenuhead headctxmenu + global headmenuid headmenuhead headctxmenu mainhead set headmenuid $id set headmenuhead $head + set state normal + if {$head eq $mainhead} { + set state disabled + } + $headctxmenu entryconfigure 0 -state $state + $headctxmenu entryconfigure 1 -state $state tk_popup $headctxmenu $x $y } @@ -5537,6 +5543,7 @@ proc rmbranch {} { set head $headmenuhead set id $headmenuid + # this check shouldn't be needed any more... if {$head eq $mainhead} { error_popup "Cannot delete the currently checked-out branch" return -- cgit v1.2.3 From 66e46f37de3ed3211a8ae0e8fc09c063bc3a1e08 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Sat, 14 Oct 2006 19:21:02 +1000 Subject: gitk: Store ids in rowrangelist and idrowranges rather than row numbers This removes the need for insertrow to go through rowrangelist and idrowranges and adjust a lot of entries. The first entry for a given id is now the row number of the first child, not that row number + 1, and rowranges compensates for that so its callers didn't have to change. This adds a ranges argument to drawlineseg so that we can avoid calling rowranges a second time inside drawlineseg (all its callers already called rowranges). Signed-off-by: Paul Mackerras --- gitk | 76 +++++++++++++++++++++++++------------------------------------------- 1 file changed, 28 insertions(+), 48 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 6a45fcae4c..023205a3b1 100755 --- a/gitk +++ b/gitk @@ -2472,7 +2472,7 @@ proc sanity {row {full 0}} { } proc makeuparrow {oid x y z} { - global rowidlist rowoffsets uparrowlen idrowranges + global rowidlist rowoffsets uparrowlen idrowranges displayorder for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} { incr y -1 @@ -2495,7 +2495,7 @@ proc makeuparrow {oid x y z} { } set tmp [lreplace [lindex $rowoffsets $y] $x $x {}] lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1] - lappend idrowranges($oid) $y + lappend idrowranges($oid) [lindex $displayorder $y] } proc initlayout {} { @@ -2609,7 +2609,7 @@ proc layoutmore {tmax allread} { proc showstuff {canshow} { global numcommits commitrow pending_select selectedline - global linesegends idrowranges idrangedrawn curview + global linesegends idrangedrawn curview global displayorder selectfirst if {$numcommits == 0} { @@ -2627,11 +2627,12 @@ proc showstuff {canshow} { for {set r $row} {$r < $canshow} {incr r} { foreach id [lindex $linesegends [expr {$r+1}]] { set i -1 - foreach {s e} [rowranges $id] { + set ranges [rowranges $id] + foreach {s e} $ranges { incr i if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0 && ![info exists idrangedrawn($id,$i)]} { - drawlineseg $id $i + drawlineseg $id $i $ranges set idrangedrawn($id,$i) 1 } } @@ -2698,7 +2699,7 @@ proc layoutrows {row endrow last} { set idinlist($i) 0 set rm1 [expr {$row - 1}] lappend lse $i - lappend idrowranges($i) $rm1 + lappend idrowranges($i) [lindex $displayorder $rm1] if {[incr nev -1] <= 0} break continue } @@ -2730,7 +2731,7 @@ proc layoutrows {row endrow last} { set ranges {} if {[info exists idrowranges($id)]} { set ranges $idrowranges($id) - lappend ranges $row + lappend ranges $id unset idrowranges($id) } lappend rowrangelist $ranges @@ -2755,7 +2756,7 @@ proc layoutrows {row endrow last} { } foreach i $newolds { set idinlist($i) 1 - set idrowranges($i) $row + set idrowranges($i) $id } incr col $l foreach oid $oldolds { @@ -2993,16 +2994,22 @@ proc rowranges {id} { } elseif {[info exists idrowranges($id)]} { set ranges $idrowranges($id) } - return $ranges + set linenos {} + foreach rid $ranges { + lappend linenos $commitrow($curview,$rid) + } + if {$linenos ne {}} { + lset linenos 0 [expr {[lindex $linenos 0] + 1}] + } + return $linenos } -proc drawlineseg {id i} { +proc drawlineseg {id i ranges} { global rowoffsets rowidlist global displayorder global canv colormap linespc global numcommits commitrow curview - set ranges [rowranges $id] set downarrow 1 if {[info exists commitrow($curview,$id)] && $commitrow($curview,$id) < $numcommits} { @@ -3132,10 +3139,11 @@ proc drawlines {id} { global children iddrawn commitrow rowidlist curview $canv delete lines.$id - set nr [expr {[llength [rowranges $id]] / 2}] + set ranges [rowranges $id] + set nr [expr {[llength $ranges] / 2}] for {set i 0} {$i < $nr} {incr i} { if {[info exists idrangedrawn($id,$i)]} { - drawlineseg $id $i + drawlineseg $id $i $ranges } } foreach child $children($curview,$id) { @@ -3216,13 +3224,14 @@ proc drawcmitrow {row} { foreach id [lindex $rowidlist $row] { if {$id eq {}} continue set i -1 - foreach {s e} [rowranges $id] { + set ranges [rowranges $id] + foreach {s e} $ranges { incr i if {$row < $s} continue if {$e eq {}} break if {$row <= $e} { if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} { - drawlineseg $id $i + drawlineseg $id $i $ranges set idrangedrawn($id,$i) 1 } break @@ -3528,7 +3537,7 @@ proc show_status {msg} { proc insertrow {row newcmit} { global displayorder parentlist childlist commitlisted global commitrow curview rowidlist rowoffsets numcommits - global rowrangelist idrowranges rowlaidout rowoptim numcommits + global rowrangelist rowlaidout rowoptim numcommits global linesegends selectedline if {$row >= $numcommits} { @@ -3572,45 +3581,16 @@ proc insertrow {row newcmit} { 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 + set ranges [list $newcmit $p] + } elseif {[lindex $ranges end-1] eq $p} { + lset ranges end-1 $newcmit } 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 {}] -- cgit v1.2.3 From 322a8cc9b31217c883c42b9babbbdea7f522eeb7 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Sun, 15 Oct 2006 18:03:46 +1000 Subject: gitk: New algorithm for drawing the graph lines This only draws as much of the graph lines as is visible. This can happen by adding coordinates on to an existing graph line or by creating a new line. This means that we only need to have laid out and optimized as much of the graph as is actually visible in order to draw it, including the lines (previously we didn't draw a graph line until we had laid out and optimized to the end of a segment of the line, i.e. down to a down-arrow or to the row where the line's commit is displayed). This also lets us get rid of the linesegends list, and gives us an easy workaround for the X server bug that causes long lines to be misdrawn. This also gets rid of the use of rowoffsets in drawlineseg et al. Signed-off-by: Paul Mackerras --- gitk | 482 +++++++++++++++++++++++++++++++++++++++++-------------------------- 1 file changed, 297 insertions(+), 185 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 023205a3b1..21eefc40a8 100755 --- a/gitk +++ b/gitk @@ -1750,7 +1750,7 @@ proc showview {n} { global selectedline currentid canv canvy0 global matchinglines treediffs global pending_select phase - global commitidx rowlaidout rowoptim linesegends + global commitidx rowlaidout rowoptim global commfd global selectedview selectfirst global vparentlist vchildlist vdisporder vcmitlisted @@ -1786,7 +1786,7 @@ proc showview {n} { set viewdata($curview) \ [list $phase $rowidlist $rowoffsets $rowrangelist \ [flatten idrowranges] [flatten idinlist] \ - $rowlaidout $rowoptim $numcommits $linesegends] + $rowlaidout $rowoptim $numcommits] } elseif {![info exists viewdata($curview)] || [lindex $viewdata($curview) 0] ne {}} { set viewdata($curview) \ @@ -1832,7 +1832,6 @@ proc showview {n} { set rowlaidout [lindex $v 6] set rowoptim [lindex $v 7] set numcommits [lindex $v 8] - set linesegends [lindex $v 9] } catch {unset colormap} @@ -2506,7 +2505,7 @@ proc initlayout {} { global nextcolor global parentlist childlist children global colormap rowtextx - global linesegends selectfirst + global selectfirst set numcommits 0 set displayorder {} @@ -2525,7 +2524,6 @@ proc initlayout {} { catch {unset colormap} catch {unset rowtextx} catch {unset idrowranges} - set linesegends {} set selectfirst 1 } @@ -2608,8 +2606,7 @@ proc layoutmore {tmax allread} { } proc showstuff {canshow} { - global numcommits commitrow pending_select selectedline - global linesegends idrangedrawn curview + global numcommits commitrow pending_select selectedline curview global displayorder selectfirst if {$numcommits == 0} { @@ -2617,33 +2614,16 @@ proc showstuff {canshow} { set phase "incrdraw" allcanvs delete all } - set row $numcommits + set r0 $numcommits set numcommits $canshow setcanvscroll set rows [visiblerows] - set r0 [lindex $rows 0] set r1 [lindex $rows 1] - set selrow -1 - for {set r $row} {$r < $canshow} {incr r} { - foreach id [lindex $linesegends [expr {$r+1}]] { - set i -1 - set ranges [rowranges $id] - foreach {s e} $ranges { - incr i - if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0 - && ![info exists idrangedrawn($id,$i)]} { - drawlineseg $id $i $ranges - set idrangedrawn($id,$i) 1 - } - } - } + if {$r1 >= $canshow} { + set r1 [expr {$canshow - 1}] } - if {$canshow > $r1} { - set canshow $r1 - } - while {$row < $canshow} { - drawcmitrow $row - incr row + if {$r0 <= $r1} { + drawcommits $r0 $r1 } if {[info exists pending_select] && [info exists commitrow($curview,$pending_select)] && @@ -2664,7 +2644,7 @@ proc layoutrows {row endrow last} { global rowidlist rowoffsets displayorder global uparrowlen downarrowlen maxwidth mingaplen global childlist parentlist - global idrowranges linesegends + global idrowranges global commitidx curview global idinlist rowchk rowrangelist @@ -2681,7 +2661,6 @@ proc layoutrows {row endrow last} { lappend oldolds $p } } - set lse {} set nev [expr {[llength $idlist] + [llength $newolds] + [llength $oldolds] - $maxwidth + 1}] if {$nev > 0} { @@ -2698,7 +2677,6 @@ proc layoutrows {row endrow last} { set offs [incrange $offs $x 1] set idinlist($i) 0 set rm1 [expr {$row - 1}] - lappend lse $i lappend idrowranges($i) [lindex $displayorder $rm1] if {[incr nev -1] <= 0} break continue @@ -2709,7 +2687,6 @@ proc layoutrows {row endrow last} { lset rowidlist $row $idlist lset rowoffsets $row $offs } - lappend linesegends $lse set col [lsearch -exact $idlist $id] if {$col < 0} { set col [llength $idlist] @@ -3004,95 +2981,206 @@ proc rowranges {id} { return $linenos } -proc drawlineseg {id i ranges} { - global rowoffsets rowidlist - global displayorder - global canv colormap linespc - global numcommits commitrow curview +# work around tk8.4 refusal to draw arrows on diagonal segments +proc adjarrowhigh {coords} { + global linespc - set downarrow 1 - if {[info exists commitrow($curview,$id)] - && $commitrow($curview,$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 {} - set col [lsearch -exact [lindex $rowidlist $row] $id] - if {$col < 0} { - puts "oops: drawline: id $id not on row $row" - return + set x0 [lindex $coords 0] + set x1 [lindex $coords 2] + if {$x0 != $x1} { + set y0 [lindex $coords 1] + set y1 [lindex $coords 3] + if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} { + # we have a nearby vertical segment, just trim off the diag bit + set coords [lrange $coords 2 end] + } else { + set slope [expr {($x0 - $x1) / ($y0 - $y1)}] + set xi [expr {$x0 - $slope * $linespc / 2}] + set yi [expr {$y0 - $linespc / 2}] + set coords [lreplace $coords 0 1 $xi $y0 $xi $yi] + } } - set lasto {} - set ns 0 + return $coords +} + +proc drawlineseg {id row endrow arrowlow} { + global rowidlist displayorder iddrawn linesegs + global canv colormap linespc curview maxlinelen + + set cols [list [lsearch -exact [lindex $rowidlist $row] $id]] + set le [expr {$row + 1}] + set arrowhigh 1 while {1} { - set o [lindex $rowoffsets $row $col] - if {$o eq {}} break - if {$o ne $lasto} { - # changing direction - set x [xc $row $col] - set y [yc $row] - lappend coords $x $y - set lasto $o + set c [lsearch -exact [lindex $rowidlist $le] $id] + if {$c < 0} { + incr le -1 + break + } + lappend cols $c + set x [lindex $displayorder $le] + if {$x eq $id} { + set arrowhigh 0 + break } - incr col $o - incr row -1 + if {[info exists iddrawn($x)] || $le == $endrow} { + set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id] + if {$c >= 0} { + lappend cols $c + set arrowhigh 0 + } + break + } + incr le } - set x [xc $row $col] - set y [yc $row] - lappend coords $x $y - if {$i == 0} { - # draw the link to the first child as part of this line - incr row -1 - set child [lindex $displayorder $row] - set ccol [lsearch -exact [lindex $rowidlist $row] $child] - if {$ccol >= 0} { - set x [xc $row $ccol] - set y [yc $row] - if {$ccol < $col - 1} { - lappend coords [xc $row [expr {$col - 1}]] [yc $row] - } elseif {$ccol > $col + 1} { - lappend coords [xc $row [expr {$col + 1}]] [yc $row] + if {$le <= $row} { + return $row + } + + set lines {} + set i 0 + set joinhigh 0 + if {[info exists linesegs($id)]} { + set lines $linesegs($id) + foreach li $lines { + set r0 [lindex $li 0] + if {$r0 > $row} { + if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} { + set joinhigh 1 + } + break + } + incr i + } + } + set joinlow 0 + if {$i > 0} { + set li [lindex $lines [expr {$i-1}]] + set r1 [lindex $li 1] + if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} { + set joinlow 1 + } + } + + set x [lindex $cols [expr {$le - $row}]] + set xp [lindex $cols [expr {$le - 1 - $row}]] + set dir [expr {$xp - $x}] + if {$joinhigh} { + set ith [lindex $lines $i 2] + set coords [$canv coords $ith] + set ah [$canv itemcget $ith -arrow] + set arrowhigh [expr {$ah eq "first" || $ah eq "both"}] + set x2 [lindex $cols [expr {$le + 1 - $row}]] + if {$x2 ne {} && $x - $x2 == $dir} { + set coords [lrange $coords 0 end-2] + } + } else { + set coords [list [xc $le $x] [yc $le]] + } + if {$joinlow} { + set itl [lindex $lines [expr {$i-1}] 2] + set al [$canv itemcget $itl -arrow] + set arrowlow [expr {$al eq "last" || $al eq "both"}] + } elseif {$arrowlow && + [lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0} { + set arrowlow 0 + } + set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]] + for {set y $le} {[incr y -1] > $row} {} { + set x $xp + set xp [lindex $cols [expr {$y - 1 - $row}]] + set ndir [expr {$xp - $x}] + if {$dir != $ndir || $xp < 0} { + lappend coords [xc $y $x] [yc $y] + } + set dir $ndir + } + if {!$joinlow} { + if {$xp < 0} { + # join parent line to first child + set ch [lindex $displayorder $row] + set xc [lsearch -exact [lindex $rowidlist $row] $ch] + if {$xc < 0} { + puts "oops: drawlineseg: child $ch not on row $row" + } else { + if {$xc < $x - 1} { + lappend coords [xc $row [expr {$x-1}]] [yc $row] + } elseif {$xc > $x + 1} { + lappend coords [xc $row [expr {$x+1}]] [yc $row] + } + set x $xc } - lappend coords $x $y - } - } - if {[llength $coords] < 4} return - if {$downarrow} { - # This line has an arrow at the lower end: check if the arrow is - # on a diagonal segment, and if so, work around the Tk 8.4 - # refusal to draw arrows on diagonal lines. - set x0 [lindex $coords 0] - set x1 [lindex $coords 2] - if {$x0 != $x1} { - set y0 [lindex $coords 1] - set y1 [lindex $coords 3] - if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} { - # we have a nearby vertical segment, just trim off the diag bit - set coords [lrange $coords 2 end] + lappend coords [xc $row $x] [yc $row] + } else { + set xn [xc $row $xp] + set yn [yc $row] + # work around tk8.4 refusal to draw arrows on diagonal segments + if {$arrowlow && $xn != [lindex $coords end-1]} { + if {[llength $coords] < 4 || + [lindex $coords end-3] != [lindex $coords end-1] || + [lindex $coords end] - $yn > 2 * $linespc} { + set xn [xc $row [expr {$xp - 0.5 * $dir}]] + set yo [yc [expr {$row + 0.5}]] + lappend coords $xn $yo $xn $yn + } } else { - set slope [expr {($x0 - $x1) / ($y0 - $y1)}] - set xi [expr {$x0 - $slope * $linespc / 2}] - set yi [expr {$y0 - $linespc / 2}] - set coords [lreplace $coords 0 1 $xi $y0 $xi $yi] + lappend coords $xn $yn + } + } + if {!$joinhigh} { + if {$arrowhigh} { + set coords [adjarrowhigh $coords] + } + assigncolor $id + set t [$canv create line $coords -width [linewidth $id] \ + -fill $colormap($id) -tags lines.$id -arrow $arrow] + $canv lower $t + bindline $t $id + set lines [linsert $lines $i [list $row $le $t]] + } else { + $canv coords $ith $coords + if {$arrow ne $ah} { + $canv itemconf $ith -arrow $arrow + } + lset lines $i 0 $row + } + } else { + set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id] + set ndir [expr {$xo - $xp}] + set clow [$canv coords $itl] + if {$dir == $ndir} { + set clow [lrange $clow 2 end] + } + set coords [concat $coords $clow] + if {!$joinhigh} { + lset lines [expr {$i-1}] 1 $le + if {$arrowhigh} { + set coords [adjarrowhigh $coords] } + } else { + # coalesce two pieces + $canv delete $ith + set b [lindex $lines [expr {$i-1}] 0] + set e [lindex $lines $i 1] + set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]] + } + $canv coords $itl $coords + if {$arrow ne $al} { + $canv itemconf $itl -arrow $arrow } } - 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] - $canv lower $t - bindline $t $id + + set linesegs($id) $lines + return $le } -proc drawparentlinks {id row col olds} { - global rowidlist canv colormap +proc drawparentlinks {id row} { + global rowidlist canv colormap curview parentlist + global idpos + set rowids [lindex $rowidlist $row] + set col [lsearch -exact $rowids $id] + if {$col < 0} return + set olds [lindex $parentlist $row] set row2 [expr {$row + 1}] set x [xc $row $col] set y [yc $row] @@ -3110,9 +3198,7 @@ proc drawparentlinks {id row col olds} { if {$x2 > $rmx} { set rmx $x2 } - set ranges [rowranges $p] - if {$ranges ne {} && $row2 == [lindex $ranges 0] - && $row2 < [lindex $ranges 1]} { + if {[lsearch -exact $rowids $p] < 0} { # drawlineseg will do this one for us continue } @@ -3130,36 +3216,21 @@ proc drawparentlinks {id row col olds} { $canv lower $t bindline $t $p } - return $rmx + if {$rmx > [lindex $idpos($id) 1]} { + lset idpos($id) 1 $rmx + redrawtags $id + } } proc drawlines {id} { - global colormap canv - global idrangedrawn - global children iddrawn commitrow rowidlist curview + global canv - $canv delete lines.$id - set ranges [rowranges $id] - set nr [expr {[llength $ranges] / 2}] - for {set i 0} {$i < $nr} {incr i} { - if {[info exists idrangedrawn($id,$i)]} { - drawlineseg $id $i $ranges - } - } - foreach child $children($curview,$id) { - if {[info exists iddrawn($child)]} { - set row $commitrow($curview,$child) - set col [lsearch -exact [lindex $rowidlist $row] $child] - if {$col >= 0} { - drawparentlinks $child $row $col [list $id] - } - } - } + $canv itemconf lines.$id -width [linewidth $id] } -proc drawcmittext {id row col rmx} { +proc drawcmittext {id row col} { global linespc canv canv2 canv3 canvy0 fgcolor - global commitlisted commitinfo rowidlist + global commitlisted commitinfo rowidlist parentlist global rowtextx idpos idtags idheads idotherrefs global linehtag linentag linedtag global mainfont canvxmax boldrows boldnamerows fgcolor @@ -3173,10 +3244,18 @@ proc drawcmittext {id row col rmx} { -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]]] - if {$xt < $rmx} { - set xt $rmx + set rmx [llength [lindex $rowidlist $row]] + set olds [lindex $parentlist $row] + if {$olds ne {}} { + set nextids [lindex $rowidlist [expr {$row + 1}]] + foreach p $olds { + set i [lsearch -exact $nextids $p] + if {$i > $rmx} { + set rmx $i + } + } } + set xt [xc $row $rmx] set rowtextx($row) $xt set idpos($id) [list $x $xt $y] if {[info exists idtags($id)] || [info exists idheads($id)] @@ -3214,30 +3293,13 @@ proc drawcmittext {id row col rmx} { proc drawcmitrow {row} { global displayorder rowidlist - global idrangedrawn iddrawn + global iddrawn global commitinfo parentlist numcommits global filehighlight fhighlights findstring nhighlights global hlview vhighlights global highlight_related rhighlights if {$row >= $numcommits} return - foreach id [lindex $rowidlist $row] { - if {$id eq {}} continue - set i -1 - set ranges [rowranges $id] - foreach {s e} $ranges { - incr i - if {$row < $s} continue - if {$e eq {}} break - if {$row <= $e} { - if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} { - drawlineseg $id $i $ranges - set idrangedrawn($id,$i) 1 - } - break - } - } - } set id [lindex $displayorder $row] if {[info exists hlview] && ![info exists vhighlights($row)]} { @@ -3262,49 +3324,99 @@ proc drawcmitrow {row} { getcommit $id } assigncolor $id - set olds [lindex $parentlist $row] - if {$olds ne {}} { - set rmx [drawparentlinks $id $row $col $olds] - } else { - set rmx 0 - } - drawcmittext $id $row $col $rmx + drawcmittext $id $row $col set iddrawn($id) 1 } -proc drawfrac {f0 f1} { - global numcommits canv - global linespc +proc drawcommits {row {endrow {}}} { + global numcommits iddrawn displayorder curview + global parentlist rowidlist - set ymax [lindex [$canv cget -scrollregion] 3] - if {$ymax eq {} || $ymax == 0} return - set y0 [expr {int($f0 * $ymax)}] - set row [expr {int(($y0 - 3) / $linespc) - 1}] if {$row < 0} { set row 0 } - set y1 [expr {int($f1 * $ymax)}] - set endrow [expr {int(($y1 - 3) / $linespc) + 1}] + if {$endrow eq {}} { + set endrow $row + } if {$endrow >= $numcommits} { set endrow [expr {$numcommits - 1}] } - for {} {$row <= $endrow} {incr row} { - drawcmitrow $row + + # make the lines join to already-drawn rows either side + set r [expr {$row - 1}] + if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} { + set r $row + } + set er [expr {$endrow + 1}] + if {$er >= $numcommits || + ![info exists iddrawn([lindex $displayorder $er])]} { + set er $endrow + } + for {} {$r <= $er} {incr r} { + set id [lindex $displayorder $r] + set wasdrawn [info exists iddrawn($id)] + if {!$wasdrawn} { + drawcmitrow $r + } + if {$r == $er} break + set nextid [lindex $displayorder [expr {$r + 1}]] + if {$wasdrawn && [info exists iddrawn($nextid)]} { + catch {unset prevlines} + continue + } + drawparentlinks $id $r + + if {[info exists lineends($r)]} { + foreach lid $lineends($r) { + unset prevlines($lid) + } + } + set rowids [lindex $rowidlist $r] + foreach lid $rowids { + if {$lid eq {}} continue + if {$lid eq $id} { + # see if this is the first child of any of its parents + foreach p [lindex $parentlist $r] { + if {[lsearch -exact $rowids $p] < 0} { + # make this line extend up to the child + set le [drawlineseg $p $r $er 0] + lappend lineends($le) $p + set prevlines($p) 1 + } + } + } elseif {![info exists prevlines($lid)]} { + set le [drawlineseg $lid $r $er 1] + lappend lineends($le) $lid + set prevlines($lid) 1 + } + } } } +proc drawfrac {f0 f1} { + global canv linespc + + set ymax [lindex [$canv cget -scrollregion] 3] + if {$ymax eq {} || $ymax == 0} return + set y0 [expr {int($f0 * $ymax)}] + set row [expr {int(($y0 - 3) / $linespc) - 1}] + set y1 [expr {int($f1 * $ymax)}] + set endrow [expr {int(($y1 - 3) / $linespc) + 1}] + drawcommits $row $endrow +} + proc drawvisible {} { global canv eval drawfrac [$canv yview] } proc clear_display {} { - global iddrawn idrangedrawn + global iddrawn linesegs global vhighlights fhighlights nhighlights rhighlights allcanvs delete all catch {unset iddrawn} - catch {unset idrangedrawn} + catch {unset linesegs} catch {unset vhighlights} catch {unset fhighlights} catch {unset nhighlights} @@ -3538,7 +3650,7 @@ proc insertrow {row newcmit} { global displayorder parentlist childlist commitlisted global commitrow curview rowidlist rowoffsets numcommits global rowrangelist rowlaidout rowoptim numcommits - global linesegends selectedline + global selectedline if {$row >= $numcommits} { puts "oops, inserting new row $row but only have $numcommits rows" @@ -3592,8 +3704,6 @@ proc insertrow {row newcmit} { lset rowrangelist $rp1 $ranges } - set linesegends [linsert $linesegends $row {}] - incr rowlaidout incr rowoptim incr numcommits @@ -3708,13 +3818,13 @@ proc dofind {} { if {$matches == {}} continue set doesmatch 1 if {$ty == "Headline"} { - drawcmitrow $l + drawcommits $l markmatches $canv $l $f $linehtag($l) $matches $mainfont } elseif {$ty == "Author"} { - drawcmitrow $l + drawcommits $l markmatches $canv2 $l $f $linentag($l) $matches $mainfont } elseif {$ty == "Date"} { - drawcmitrow $l + drawcommits $l markmatches $canv3 $l $f $linedtag($l) $matches $mainfont } } @@ -3807,7 +3917,7 @@ proc stopfindproc {{done 0}} { proc markheadline {l id} { global canv mainfont linehtag - drawcmitrow $l + drawcommits $l set bbox [$canv bbox $linehtag($l)] set t [$canv create rect $bbox -outline {} -tags matches -fill yellow] $canv lower $t @@ -5302,10 +5412,11 @@ proc domktag {} { proc redrawtags {id} { global canv linehtag commitrow idpos selectedline curview - global mainfont canvxmax + global mainfont canvxmax iddrawn if {![info exists commitrow($curview,$id)]} return - drawcmitrow $commitrow($curview,$id) + if {![info exists iddrawn($id)]} return + drawcommits $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] @@ -6947,6 +7058,7 @@ set cmitmode "patch" set wrapcomment "none" set showneartags 1 set maxrefs 20 +set maxlinelen 200 set colors {green red blue magenta darkgrey brown orange} set bgcolor white -- cgit v1.2.3 From 219ea3a99b9d4253815bcd71fd78eb00665acdbb Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Thu, 7 Sep 2006 10:21:39 +1000 Subject: gitk: Show local uncommitted changes as a fake commit If there are local changes in the repository, i.e., git-diff-index HEAD produces some output, then this optionally displays an extra row in the graph as a child of the HEAD commit (but with a red circle to indicate that it's not a real commit). There is a checkbox in the preferences window to control whether gitk does this or not. Clicking on the extra row shows the diffs between the working directory and the HEAD (using git diff-index -p). The right-click menu on the extra row allows the user to generate a patch containing the local diffs, or to display the diffs between the working directory and any commit. Signed-off-by: Paul Mackerras --- gitk | 337 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 284 insertions(+), 53 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 21eefc40a8..cd231d4b66 100755 --- a/gitk +++ b/gitk @@ -83,6 +83,7 @@ proc start_rev_list {view} { global startmsecs global commfd leftover tclencoding datemode global viewargs viewfiles commitidx + global lookingforhead showlocalchanges set startmsecs [clock clicks -milliseconds] set commitidx($view) 0 @@ -103,6 +104,7 @@ proc start_rev_list {view} { } set commfd($view) $fd set leftover($view) {} + set lookingforhead $showlocalchanges fconfigure $fd -blocking 0 -translation lf if {$tclencoding != {}} { fconfigure $fd -encoding $tclencoding @@ -262,7 +264,7 @@ proc chewcommits {view} { set tlimit [expr {[clock clicks -milliseconds] + 50}] set more [layoutmore $tlimit $allread] if {$allread && !$more} { - global displayorder commitidx phase + global displayorder nullid commitidx phase global numcommits startmsecs if {[info exists pending_select]} { @@ -386,7 +388,7 @@ proc getcommit {id} { proc readrefs {} { global tagids idtags headids idheads tagcontents - global otherrefids idotherrefs mainhead + global otherrefids idotherrefs mainhead mainheadid foreach v {tagids idtags headids idheads otherrefids idotherrefs} { catch {unset $v} @@ -433,10 +435,14 @@ proc readrefs {} { } close $refd set mainhead {} + set mainheadid {} catch { set thehead [exec git symbolic-ref HEAD] if {[string match "refs/heads/*" $thehead]} { set mainhead [string range $thehead 11 end] + if {[info exists headids($mainhead)]} { + set mainheadid $headids($mainhead) + } } } } @@ -505,7 +511,7 @@ proc makewindow {} { global findtype findtypemenu findloc findstring fstring geometry global entries sha1entry sha1string sha1but global maincursor textcursor curtextcursor - global rowctxmenu mergemax wrapcomment + global rowctxmenu fakerowmenu mergemax wrapcomment global highlight_files gdttype global searchstring sstring global bgcolor fgcolor bglist fglist diffcolors selectbgcolor @@ -878,6 +884,17 @@ proc makewindow {} { $rowctxmenu add command -label "Cherry-pick this commit" \ -command cherrypick + set fakerowmenu .fakerowmenu + menu $fakerowmenu -tearoff 0 + $fakerowmenu add command -label "Diff this -> selected" \ + -command {diffvssel 0} + $fakerowmenu add command -label "Diff selected -> this" \ + -command {diffvssel 1} + $fakerowmenu add command -label "Make patch" -command mkpatch +# $fakerowmenu add command -label "Commit" -command {mkcommit 0} +# $fakerowmenu add command -label "Commit all" -command {mkcommit 1} +# $fakerowmenu add command -label "Revert local changes" -command revertlocal + set headctxmenu .headctxmenu menu $headctxmenu -tearoff 0 $headctxmenu add command -label "Check out this branch" \ @@ -933,7 +950,7 @@ proc click {w} { proc savestuff {w} { global canv canv2 canv3 ctext cflist mainfont textfont uifont tabstop global stuffsaved findmergefiles maxgraphpct - global maxwidth showneartags + global maxwidth showneartags showlocalchanges global viewname viewfiles viewargs viewperm nextviewnum global cmitmode wrapcomment global colors bgcolor fgcolor diffcolors selectbgcolor @@ -952,6 +969,7 @@ proc savestuff {w} { puts $f [list set cmitmode $cmitmode] puts $f [list set wrapcomment $wrapcomment] puts $f [list set showneartags $showneartags] + puts $f [list set showlocalchanges $showlocalchanges] puts $f [list set bgcolor $bgcolor] puts $f [list set fgcolor $fgcolor] puts $f [list set colors $colors] @@ -1746,7 +1764,7 @@ proc showview {n} { global curview viewdata viewfiles global displayorder parentlist childlist rowidlist rowoffsets global colormap rowtextx commitrow nextcolor canvxmax - global numcommits rowrangelist commitlisted idrowranges + global numcommits rowrangelist commitlisted idrowranges rowchk global selectedline currentid canv canvy0 global matchinglines treediffs global pending_select phase @@ -1832,6 +1850,7 @@ proc showview {n} { set rowlaidout [lindex $v 6] set rowoptim [lindex $v 7] set numcommits [lindex $v 8] + catch {unset rowchk} } catch {unset colormap} @@ -1861,8 +1880,9 @@ proc showview {n} { } elseif {$selid ne {}} { set pending_select $selid } else { - if {$numcommits > 0} { - selectline 0 0 + set row [expr {[lindex $displayorder 0] eq $nullid}] + if {$row < $numcommits} { + selectline $row 0 } else { set selectfirst 1 } @@ -2559,11 +2579,12 @@ proc layoutmore {tmax allread} { global rowlaidout rowoptim commitidx numcommits optim_delay global uparrowlen curview rowidlist idinlist + set showlast 0 set showdelay $optim_delay set optdelay [expr {$uparrowlen + 1}] while {1} { if {$rowoptim - $showdelay > $numcommits} { - showstuff [expr {$rowoptim - $showdelay}] + showstuff [expr {$rowoptim - $showdelay}] $showlast } elseif {$rowlaidout - $optdelay > $rowoptim} { set nr [expr {$rowlaidout - $optdelay - $rowoptim}] if {$nr > 100} { @@ -2592,6 +2613,7 @@ proc layoutmore {tmax allread} { set rowlaidout $commitidx($curview) } elseif {$rowoptim == $nrows} { set showdelay 0 + set showlast 1 if {$numcommits == $nrows} { return 0 } @@ -2605,9 +2627,9 @@ proc layoutmore {tmax allread} { } } -proc showstuff {canshow} { +proc showstuff {canshow last} { global numcommits commitrow pending_select selectedline curview - global displayorder selectfirst + global lookingforhead mainheadid displayorder nullid selectfirst if {$numcommits == 0} { global phase @@ -2634,10 +2656,74 @@ proc showstuff {canshow} { if {[info exists selectedline] || [info exists pending_select]} { set selectfirst 0 } else { - selectline 0 1 + set l [expr {[lindex $displayorder 0] eq $nullid}] + selectline $l 1 set selectfirst 0 } } + if {$lookingforhead && [info exists commitrow($curview,$mainheadid)] + && ($last || $commitrow($curview,$mainheadid) < $numcommits - 1)} { + set lookingforhead 0 + dodiffindex + } +} + +proc doshowlocalchanges {} { + global lookingforhead curview mainheadid phase commitrow + + if {[info exists commitrow($curview,$mainheadid)] && + ($phase eq {} || $commitrow($curview,$mainheadid) < $numcommits - 1)} { + dodiffindex + } elseif {$phase ne {}} { + set lookingforhead 1 + } +} + +proc dohidelocalchanges {} { + global lookingforhead localrow lserial + + set lookingforhead 0 + if {$localrow >= 0} { + removerow $localrow + set localrow -1 + } + incr lserial +} + +# spawn off a process to do git diff-index HEAD +proc dodiffindex {} { + global localrow lserial + + incr lserial + set localrow -1 + set fd [open "|git diff-index HEAD" r] + fconfigure $fd -blocking 0 + filerun $fd [list readdiffindex $fd $lserial] +} + +proc readdiffindex {fd serial} { + global localrow commitrow mainheadid nullid curview + global commitinfo commitdata lserial + + if {[gets $fd line] < 0} { + if {[eof $fd]} { + close $fd + return 0 + } + return 1 + } + # we only need to see one line and we don't really care what it says... + close $fd + + if {$serial == $lserial && $localrow == -1} { + # add the line for the local diff to the graph + set localrow $commitrow($curview,$mainheadid) + set hl "Local uncommitted changes" + set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"] + set commitdata($nullid) "\n $hl\n" + insertrow $localrow $nullid + } + return 0 } proc layoutrows {row endrow last} { @@ -2815,7 +2901,7 @@ proc insert_pad {row col npad} { } proc optimize_rows {row col endrow} { - global rowidlist rowoffsets idrowranges displayorder + global rowidlist rowoffsets displayorder for {} {$row < $endrow} {incr row} { set idlist [lindex $rowidlist $row] @@ -3233,9 +3319,13 @@ proc drawcmittext {id row col} { global commitlisted commitinfo rowidlist parentlist global rowtextx idpos idtags idheads idotherrefs global linehtag linentag linedtag - global mainfont canvxmax boldrows boldnamerows fgcolor + global mainfont canvxmax boldrows boldnamerows fgcolor nullid - set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}] + if {$id eq $nullid} { + set ofill red + } else { + set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}] + } set x [xc $row $col] set y [yc $row] set orad [expr {$linespc / 3}] @@ -3647,10 +3737,10 @@ proc show_status {msg} { # 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 displayorder parentlist childlist commitlisted children global commitrow curview rowidlist rowoffsets numcommits global rowrangelist rowlaidout rowoptim numcommits - global selectedline + global selectedline rowchk commitidx if {$row >= $numcommits} { puts "oops, inserting new row $row but only have $numcommits rows" @@ -3663,12 +3753,14 @@ proc insertrow {row newcmit} { lappend kids $newcmit lset childlist $row $kids set childlist [linsert $childlist $row {}] + set children($curview,$p) $kids 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 } + incr commitidx($curview) set idlist [lindex $rowidlist $row] set offs [lindex $rowoffsets $row] @@ -3704,6 +3796,8 @@ proc insertrow {row newcmit} { lset rowrangelist $rp1 $ranges } + catch {unset rowchk} + incr rowlaidout incr rowoptim incr numcommits @@ -3714,6 +3808,67 @@ proc insertrow {row newcmit} { redisplay } +# Remove a commit that was inserted with insertrow on row $row. +proc removerow {row} { + global displayorder parentlist childlist commitlisted children + global commitrow curview rowidlist rowoffsets numcommits + global rowrangelist idrowranges rowlaidout rowoptim numcommits + global linesegends selectedline rowchk commitidx + + if {$row >= $numcommits} { + puts "oops, removing row $row but only have $numcommits rows" + return + } + set rp1 [expr {$row + 1}] + set id [lindex $displayorder $row] + set p [lindex $parentlist $row] + set displayorder [lreplace $displayorder $row $row] + set parentlist [lreplace $parentlist $row $row] + set childlist [lreplace $childlist $row $row] + set commitlisted [lreplace $commitlisted $row $row] + set kids [lindex $childlist $row] + set i [lsearch -exact $kids $id] + if {$i >= 0} { + set kids [lreplace $kids $i $i] + lset childlist $row $kids + set children($curview,$p) $kids + } + set l [llength $displayorder] + for {set r $row} {$r < $l} {incr r} { + set id [lindex $displayorder $r] + set commitrow($curview,$id) $r + } + incr commitidx($curview) -1 + + set rowidlist [lreplace $rowidlist $row $row] + set rowoffsets [lreplace $rowoffsets $rp1 $rp1] + if {$kids ne {}} { + set offs [lindex $rowoffsets $row] + set offs [lreplace $offs end end] + lset rowoffsets $row $offs + } + + set rowrangelist [lreplace $rowrangelist $row $row] + if {[llength $kids] > 0} { + set ranges [lindex $rowrangelist $row] + if {[lindex $ranges end-1] eq $id} { + set ranges [lreplace $ranges end-1 end] + lset rowrangelist $row $ranges + } + } + + catch {unset rowchk} + + incr rowlaidout -1 + incr rowoptim -1 + incr numcommits -1 + + if {[info exists selectedline] && $selectedline > $row} { + incr selectedline -1 + } + 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} { @@ -4392,13 +4547,18 @@ proc goforw {} { } proc gettree {id} { - global treefilelist treeidlist diffids diffmergeid treepending + global treefilelist treeidlist diffids diffmergeid treepending nullid set diffids $id catch {unset diffmergeid} if {![info exists treefilelist($id)]} { if {![info exists treepending]} { - if {[catch {set gtf [open [concat | git ls-tree -r $id] r]}]} { + if {$id ne $nullid} { + set cmd [concat | git ls-tree -r $id] + } else { + set cmd [concat | git ls-files] + } + if {[catch {set gtf [open $cmd r]}]} { return } set treepending $id @@ -4413,18 +4573,22 @@ proc gettree {id} { } proc gettreeline {gtf id} { - global treefilelist treeidlist treepending cmitmode diffids + global treefilelist treeidlist treepending cmitmode diffids nullid set nl 0 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} { - set tl [split $line "\t"] - if {[lindex $tl 0 1] ne "blob"} continue - set sha1 [lindex $tl 0 2] - set fname [lindex $tl 1] - if {[string index $fname 0] eq "\""} { - set fname [lindex $fname 0] - } - lappend treeidlist($id) $sha1 + if {$diffids ne $nullid} { + set tl [split $line "\t"] + if {[lindex $tl 0 1] ne "blob"} continue + set sha1 [lindex $tl 0 2] + set fname [lindex $tl 1] + if {[string index $fname 0] eq "\""} { + set fname [lindex $fname 0] + } + lappend treeidlist($id) $sha1 + } else { + set fname $line + } lappend treefilelist($id) $fname } if {![eof $gtf]} { @@ -4445,7 +4609,7 @@ proc gettreeline {gtf id} { } proc showfile {f} { - global treefilelist treeidlist diffids + global treefilelist treeidlist diffids nullid global ctext commentend set i [lsearch -exact $treefilelist($diffids) $f] @@ -4453,10 +4617,17 @@ proc showfile {f} { puts "oops, $f not in list for id $diffids" return } - set blob [lindex $treeidlist($diffids) $i] - if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} { - puts "oops, error reading blob $blob: $err" - return + if {$diffids ne $nullid} { + set blob [lindex $treeidlist($diffids) $i] + if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} { + puts "oops, error reading blob $blob: $err" + return + } + } else { + if {[catch {set bf [open $f r]} err]} { + puts "oops, can't read $f: $err" + return + } } fconfigure $bf -blocking 0 filerun $bf [list getblobline $bf $diffids] @@ -4582,11 +4753,11 @@ proc getmergediffline {mdf id np} { } proc startdiff {ids} { - global treediffs diffids treepending diffmergeid + global treediffs diffids treepending diffmergeid nullid set diffids $ids catch {unset diffmergeid} - if {![info exists treediffs($ids)]} { + if {![info exists treediffs($ids)] || [lsearch -exact $ids $nullid] >= 0} { if {![info exists treepending]} { gettreediffs $ids } @@ -4601,13 +4772,33 @@ proc addtocflist {ids} { getblobdiffs $ids } +proc diffcmd {ids flags} { + global nullid + + set i [lsearch -exact $ids $nullid] + if {$i >= 0} { + set cmd [concat | git diff-index $flags] + if {[llength $ids] > 1} { + if {$i == 0} { + lappend cmd -R [lindex $ids 1] + } else { + lappend cmd [lindex $ids 0] + } + } else { + lappend cmd HEAD + } + } else { + set cmd [concat | git diff-tree --no-commit-id -r $flags $ids] + } + return $cmd +} + proc gettreediffs {ids} { global treediff treepending + set treepending $ids set treediff {} - if {[catch \ - {set gdtf [open [concat | git diff-tree --no-commit-id -r $ids] r]} \ - ]} return + if {[catch {set gdtf [open [diffcmd $ids {}] r]}]} return fconfigure $gdtf -blocking 0 filerun $gdtf [list gettreediffline $gdtf $ids] } @@ -4644,8 +4835,7 @@ proc getblobdiffs {ids} { global diffinhdr treediffs set env(GIT_DIFF_OPTS) $diffopts - set cmd [concat | git diff-tree --no-commit-id -r -p -C $ids] - if {[catch {set bdf [open $cmd r]} err]} { + if {[catch {set bdf [open [diffcmd $ids {-p -C}] r]} err]} { puts "error getting diffs: $err" return } @@ -5207,19 +5397,25 @@ proc mstime {} { } proc rowmenu {x y id} { - global rowctxmenu commitrow selectedline rowmenuid curview + global rowctxmenu commitrow selectedline rowmenuid curview nullid + global fakerowmenu + set rowmenuid $id if {![info exists selectedline] || $commitrow($curview,$id) eq $selectedline} { set state disabled } else { set state normal } - $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 + if {$id ne $nullid} { + set menu $rowctxmenu + } else { + set menu $fakerowmenu + } + $menu entryconfigure "Diff this*" -state $state + $menu entryconfigure "Diff selected*" -state $state + $menu entryconfigure "Make patch" -state $state + tk_popup $menu $x $y } proc diffvssel {dirn} { @@ -5330,12 +5526,20 @@ proc mkpatchrev {} { } proc mkpatchgo {} { - global patchtop + global patchtop nullid set oldid [$patchtop.fromsha1 get] set newid [$patchtop.tosha1 get] set fname [$patchtop.fname get] - if {[catch {exec git diff-tree -p $oldid $newid >$fname &} err]} { + if {$newid eq $nullid} { + set cmd [list git diff-index -p $oldid] + } elseif {$oldid eq $nullid} { + set cmd [list git diff-index -p -R $newid] + } else { + set cmd [list git diff-tree -p $oldid $newid] + } + lappend cmd >$fname & + if {[catch {eval exec $cmd} err]} { error_popup "Error creating patch: $err" } catch {destroy $patchtop} @@ -5608,11 +5812,13 @@ proc headmenu {x y id head} { proc cobranch {} { global headmenuid headmenuhead mainhead headids + global showlocalchanges mainheadid # check the tree is clean first?? set oldmainhead $mainhead nowbusy checkout update + dohidelocalchanges if {[catch { exec git checkout -q $headmenuhead } err]} { @@ -5621,10 +5827,14 @@ proc cobranch {} { } else { notbusy checkout set mainhead $headmenuhead + set mainheadid $headmenuid if {[info exists headids($oldmainhead)]} { redrawtags $headids($oldmainhead) } redrawtags $headmenuid + if {$showlocalchanges} { + dodiffindex + } } } @@ -6594,7 +6804,7 @@ proc doquit {} { proc doprefs {} { global maxwidth maxgraphpct diffopts - global oldprefs prefstop showneartags + global oldprefs prefstop showneartags showlocalchanges global bgcolor fgcolor ctext diffcolors selectbgcolor global uifont tabstop @@ -6604,7 +6814,7 @@ proc doprefs {} { raise $top return } - foreach v {maxwidth maxgraphpct diffopts showneartags} { + foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} { set oldprefs($v) [set $v] } toplevel $top @@ -6621,6 +6831,11 @@ proc doprefs {} { -font optionfont spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct grid x $top.maxpctl $top.maxpct -sticky w + frame $top.showlocal + label $top.showlocal.l -text "Show local changes" -font optionfont + checkbutton $top.showlocal.b -variable showlocalchanges + pack $top.showlocal.b $top.showlocal.l -side left + grid x $top.showlocal -sticky w label $top.ddisp -text "Diff display options" $top.ddisp configure -font $uifont @@ -6723,9 +6938,9 @@ proc setfg {c} { proc prefscan {} { global maxwidth maxgraphpct diffopts - global oldprefs prefstop showneartags + global oldprefs prefstop showneartags showlocalchanges - foreach v {maxwidth maxgraphpct diffopts showneartags} { + foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} { set $v $oldprefs($v) } catch {destroy $prefstop} @@ -6734,12 +6949,19 @@ proc prefscan {} { proc prefsok {} { global maxwidth maxgraphpct - global oldprefs prefstop showneartags + global oldprefs prefstop showneartags showlocalchanges global charspc ctext tabstop catch {destroy $prefstop} unset prefstop $ctext configure -tabs "[expr {$tabstop * $charspc}]" + if {$showlocalchanges != $oldprefs(showlocalchanges)} { + if {$showlocalchanges} { + doshowlocalchanges + } else { + dohidelocalchanges + } + } if {$maxwidth != $oldprefs(maxwidth) || $maxgraphpct != $oldprefs(maxgraphpct)} { redisplay @@ -6749,7 +6971,10 @@ proc prefsok {} { } proc formatdate {d} { - return [clock format $d -format "%Y-%m-%d %H:%M:%S"] + if {$d ne {}} { + set d [clock format $d -format "%Y-%m-%d %H:%M:%S"] + } + return $d } # This list of encoding names and aliases is distilled from @@ -7059,6 +7284,7 @@ set wrapcomment "none" set showneartags 1 set maxrefs 20 set maxlinelen 200 +set showlocalchanges 1 set colors {green red blue magenta darkgrey brown orange} set bgcolor white @@ -7111,6 +7337,8 @@ if {$i >= 0} { } } +set nullid "0000000000000000000000000000000000000000" + set runq {} set history {} set historyindex 0 @@ -7136,6 +7364,9 @@ set cmdlineok 0 set stopped 0 set stuffsaved 0 set patchnum 0 +set lookingforhead 0 +set localrow -1 +set lserial 0 setcoords makewindow wm title . "[file tail $argv0]: [file tail [pwd]]" -- cgit v1.2.3 From 62d3ea65a7f7f01b72db7f318029be0b0ede5a28 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Mon, 11 Sep 2006 10:36:53 +1000 Subject: gitk: Speed up the reading of references We were doing two execs for each tag - one to map the tag ID to a commit ID and one to read the contents of the tag for later display. This speeds up the process by not reading the contents of the tag (instead it is read later if needed), and by using the -d flag to git show-ref, which gives us refs/tags/foo^{} lines which give us the commit ID. Also this uses string operations instead of regexps. Signed-off-by: Paul Mackerras --- gitk | 65 +++++++++++++++++++++++++++++++---------------------------------- 1 file changed, 31 insertions(+), 34 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index cd231d4b66..f89d2ce39d 100755 --- a/gitk +++ b/gitk @@ -387,47 +387,39 @@ proc getcommit {id} { } proc readrefs {} { - global tagids idtags headids idheads tagcontents + global tagids idtags headids idheads tagobjid global otherrefids idotherrefs mainhead mainheadid foreach v {tagids idtags headids idheads otherrefids idotherrefs} { catch {unset $v} } - set refd [open [list | git show-ref] r] - while {0 <= [set n [gets $refd line]]} { - if {![regexp {^([0-9a-f]{40}) refs/([^^]*)$} $line \ - match id path]} { - continue - } - if {[regexp {^remotes/.*/HEAD$} $path match]} { - continue - } - if {![regexp {^(tags|heads)/(.*)$} $path match type name]} { - set type others - set name $path - } - if {[regexp {^remotes/} $path match]} { - set type heads - } - if {$type == "tags"} { - set tagids($name) $id - lappend idtags($id) $name - set obj {} - set type {} - set tag {} - catch { - set commit [exec git rev-parse "$id^0"] - if {$commit != $id} { - set tagids($name) $commit - lappend idtags($commit) $name - } - } - catch { - set tagcontents($name) [exec git cat-file tag $id] + set refd [open [list | git show-ref -d] r] + while {[gets $refd line] >= 0} { + if {[string index $line 40] ne " "} continue + set id [string range $line 0 39] + set ref [string range $line 41 end] + if {![string match "refs/*" $ref]} continue + set name [string range $ref 5 end] + if {[string match "remotes/*" $name]} { + if {![string match "*/HEAD" $name]} { + set headids($name) $id + lappend idheads($id) $name } - } elseif { $type == "heads" } { + } elseif {[string match "heads/*" $name]} { + set name [string range $name 6 end] set headids($name) $id lappend idheads($id) $name + } elseif {[string match "tags/*" $name]} { + # this lets refs/tags/foo^{} overwrite refs/tags/foo, + # which is what we want since the former is the commit ID + set name [string range $name 5 end] + if {[string match "*^{}" $name]} { + set name [string range $name 0 end-3] + } else { + set tagobjid($name) $id + } + set tagids($name) $id + lappend idtags($id) $name } else { set otherrefids($name) $id lappend idotherrefs($id) $name @@ -6777,7 +6769,7 @@ proc listrefs {id} { } proc showtag {tag isnew} { - global ctext tagcontents tagids linknum + global ctext tagcontents tagids linknum tagobjid if {$isnew} { addtohistory [list showtag $tag 0] @@ -6785,6 +6777,11 @@ proc showtag {tag isnew} { $ctext conf -state normal clear_ctext set linknum 0 + if {![info exists tagcontents($tag)]} { + catch { + set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)] + } + } if {[info exists tagcontents($tag)]} { set text $tagcontents($tag) } else { -- cgit v1.2.3 From 6a90bff1e83bb25898ead28d7d3f426dfdfdbe71 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Mon, 18 Jun 2007 09:48:23 +1000 Subject: gitk: Get rid of the childlist variable The information in childlist is a duplicate of what's in the children array, and it wasn't being accessed often enough to be really worth keeping the list around as well. Signed-off-by: Paul Mackerras --- gitk | 46 +++++++++++++++++----------------------------- 1 file changed, 17 insertions(+), 29 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index f89d2ce39d..73324cfb71 100755 --- a/gitk +++ b/gitk @@ -139,8 +139,8 @@ proc getcommitlines {fd view} { global commitlisted global leftover commfd global displayorder commitidx commitrow commitdata - global parentlist childlist children curview hlview - global vparentlist vchildlist vdisporder vcmitlisted + global parentlist children curview hlview + global vparentlist vdisporder vcmitlisted set stuff [read $fd 500000] if {$stuff == {}} { @@ -237,12 +237,10 @@ proc getcommitlines {fd view} { incr commitidx($view) if {$view == $curview} { lappend parentlist $olds - lappend childlist $children($view,$id) lappend displayorder $id lappend commitlisted $listed } else { lappend vparentlist($view) $olds - lappend vchildlist($view) $children($view,$id) lappend vdisporder($view) $id lappend vcmitlisted($view) $listed } @@ -1754,7 +1752,7 @@ proc unflatten {var l} { proc showview {n} { global curview viewdata viewfiles - global displayorder parentlist childlist rowidlist rowoffsets + global displayorder parentlist rowidlist rowoffsets global colormap rowtextx commitrow nextcolor canvxmax global numcommits rowrangelist commitlisted idrowranges rowchk global selectedline currentid canv canvy0 @@ -1763,7 +1761,7 @@ proc showview {n} { global commitidx rowlaidout rowoptim global commfd global selectedview selectfirst - global vparentlist vchildlist vdisporder vcmitlisted + global vparentlist vdisporder vcmitlisted global hlview selectedhlview if {$n == $curview} return @@ -1789,7 +1787,6 @@ proc showview {n} { stopfindproc if {$curview >= 0} { set vparentlist($curview) $parentlist - set vchildlist($curview) $childlist set vdisporder($curview) $displayorder set vcmitlisted($curview) $commitlisted if {$phase ne {}} { @@ -1828,7 +1825,6 @@ proc showview {n} { set phase [lindex $v 0] set displayorder $vdisporder($n) set parentlist $vparentlist($n) - set childlist $vchildlist($n) set commitlisted $vcmitlisted($n) set rowidlist [lindex $v 1] set rowoffsets [lindex $v 2] @@ -1961,7 +1957,6 @@ proc addvhighlight {n} { if {$n != $curview && ![info exists viewdata($n)]} { set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}] set vparentlist($n) {} - set vchildlist($n) {} set vdisporder($n) {} set vcmitlisted($n) {} start_rev_list $n @@ -2430,17 +2425,15 @@ proc ntimes {n o} { } proc usedinrange {id l1 l2} { - global children commitrow childlist curview + global children commitrow curview if {[info exists commitrow($curview,$id)]} { set r $commitrow($curview,$id) if {$l1 <= $r && $r <= $l2} { return [expr {$r - $l1 + 1}] } - set kids [lindex $childlist $r] - } else { - set kids $children($curview,$id) } + set kids $children($curview,$id) foreach c $kids { set r $commitrow($curview,$c) if {$l1 <= $r && $r <= $l2} { @@ -2515,7 +2508,7 @@ proc initlayout {} { global idinlist rowchk rowrangelist idrowranges global numcommits canvxmax canv global nextcolor - global parentlist childlist children + global parentlist global colormap rowtextx global selectfirst @@ -2523,7 +2516,6 @@ proc initlayout {} { set displayorder {} set commitlisted {} set parentlist {} - set childlist {} set rowrangelist {} set nextcolor 0 set rowidlist {{}} @@ -2721,7 +2713,7 @@ proc readdiffindex {fd serial} { proc layoutrows {row endrow last} { global rowidlist rowoffsets displayorder global uparrowlen downarrowlen maxwidth mingaplen - global childlist parentlist + global children parentlist global idrowranges global commitidx curview global idinlist rowchk rowrangelist @@ -2771,7 +2763,7 @@ proc layoutrows {row endrow last} { lappend idlist $id lset rowidlist $row $idlist set z {} - if {[lindex $childlist $row] ne {}} { + if {$children($curview,$id) ne {}} { set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}] unset idinlist($id) } @@ -2830,7 +2822,7 @@ proc layoutrows {row endrow last} { proc addextraid {id row} { global displayorder commitrow commitinfo global commitidx commitlisted - global parentlist childlist children curview + global parentlist children curview incr commitidx($curview) lappend displayorder $id @@ -2844,7 +2836,6 @@ proc addextraid {id row} { if {![info exists children($curview,$id)]} { set children($curview,$id) {} } - lappend childlist $children($curview,$id) } proc layouttail {} { @@ -3729,7 +3720,7 @@ proc show_status {msg} { # 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 children + global displayorder parentlist commitlisted children global commitrow curview rowidlist rowoffsets numcommits global rowrangelist rowlaidout rowoptim numcommits global selectedline rowchk commitidx @@ -3741,11 +3732,10 @@ proc insertrow {row newcmit} { set p [lindex $displayorder $row] set displayorder [linsert $displayorder $row $newcmit] set parentlist [linsert $parentlist $row $p] - set kids [lindex $childlist $row] + set kids $children($curview,$p) lappend kids $newcmit - lset childlist $row $kids - set childlist [linsert $childlist $row {}] set children($curview,$p) $kids + set children($curview,$newcmit) {} set commitlisted [linsert $commitlisted $row 1] set l [llength $displayorder] for {set r $row} {$r < $l} {incr r} { @@ -3802,7 +3792,7 @@ proc insertrow {row newcmit} { # Remove a commit that was inserted with insertrow on row $row. proc removerow {row} { - global displayorder parentlist childlist commitlisted children + global displayorder parentlist commitlisted children global commitrow curview rowidlist rowoffsets numcommits global rowrangelist idrowranges rowlaidout rowoptim numcommits global linesegends selectedline rowchk commitidx @@ -3816,13 +3806,11 @@ proc removerow {row} { set p [lindex $parentlist $row] set displayorder [lreplace $displayorder $row $row] set parentlist [lreplace $parentlist $row $row] - set childlist [lreplace $childlist $row $row] set commitlisted [lreplace $commitlisted $row $row] - set kids [lindex $childlist $row] + set kids $children($curview,$p) set i [lsearch -exact $kids $id] if {$i >= 0} { set kids [lreplace $kids $i $i] - lset childlist $row $kids set children($curview,$p) $kids } set l [llength $displayorder] @@ -4264,7 +4252,7 @@ proc dispnexttag {} { proc selectline {l isnew} { global canv canv2 canv3 ctext commitinfo selectedline global displayorder linehtag linentag linedtag - global canvy0 linespc parentlist childlist + global canvy0 linespc parentlist children curview global currentid sha1entry global commentend idtags linknum global mergemax numcommits pending_select @@ -4375,7 +4363,7 @@ proc selectline {l isnew} { } } - foreach c [lindex $childlist $l] { + foreach c $children($curview,$id) { append headers "Child: [commit_descriptor $c]" } -- cgit v1.2.3 From 6fb735aedb25eade3d523053cb05c030a1cc06b3 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Thu, 19 Oct 2006 10:09:06 +1000 Subject: gitk: Add a "reset branch to here" row context-menu operation This adds an entry to the menu that comes up when the user does a right-click on a row. The new entry allows the user to reset the currently checked-out head to the commit for the row that they did the right-click on. The user has to select what type of reset to do, and confirm the reset, via a dialog box that pops up. Signed-off-by: Paul Mackerras --- gitk | 62 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 57 insertions(+), 5 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 73324cfb71..d6ed4f6c40 100755 --- a/gitk +++ b/gitk @@ -873,6 +873,8 @@ proc makewindow {} { $rowctxmenu add command -label "Create new branch" -command mkbranch $rowctxmenu add command -label "Cherry-pick this commit" \ -command cherrypick + $rowctxmenu add command -label "Reset HEAD branch to here" \ + -command resethead set fakerowmenu .fakerowmenu menu $fakerowmenu -tearoff 0 @@ -5377,8 +5379,8 @@ proc mstime {} { } proc rowmenu {x y id} { - global rowctxmenu commitrow selectedline rowmenuid curview nullid - global fakerowmenu + global rowctxmenu commitrow selectedline rowmenuid curview + global nullid fakerowmenu mainhead set rowmenuid $id if {![info exists selectedline] @@ -5389,6 +5391,7 @@ proc rowmenu {x y id} { } if {$id ne $nullid} { set menu $rowctxmenu + $menu entryconfigure 7 -label "Reset $mainhead branch to here" } else { set menu $fakerowmenu } @@ -5775,6 +5778,55 @@ proc cherrypick {} { notbusy cherrypick } +proc resethead {} { + global mainheadid mainhead rowmenuid confirm_ok resettype + global showlocalchanges + + set confirm_ok 0 + set w ".confirmreset" + toplevel $w + wm transient $w . + wm title $w "Confirm reset" + message $w.m -text \ + "Reset branch $mainhead to [string range $rowmenuid 0 7]?" \ + -justify center -aspect 1000 + pack $w.m -side top -fill x -padx 20 -pady 20 + frame $w.f -relief sunken -border 2 + message $w.f.rt -text "Reset type:" -aspect 1000 + grid $w.f.rt -sticky w + set resettype mixed + radiobutton $w.f.soft -value soft -variable resettype -justify left \ + -text "Soft: Leave working tree and index untouched" + grid $w.f.soft -sticky w + radiobutton $w.f.mixed -value mixed -variable resettype -justify left \ + -text "Mixed: Leave working tree untouched, reset index" + grid $w.f.mixed -sticky w + radiobutton $w.f.hard -value hard -variable resettype -justify left \ + -text "Hard: Reset working tree and index\n(discard ALL local changes)" + grid $w.f.hard -sticky w + pack $w.f -side top -fill x + button $w.ok -text OK -command "set confirm_ok 1; destroy $w" + pack $w.ok -side left -fill x -padx 20 -pady 20 + button $w.cancel -text Cancel -command "destroy $w" + pack $w.cancel -side right -fill x -padx 20 -pady 20 + bind $w "grab $w; focus $w" + tkwait window $w + if {!$confirm_ok} return + dohidelocalchanges + if {[catch {exec git reset --$resettype $rowmenuid} err]} { + error_popup $err + } else { + set oldhead $mainheadid + movedhead $rowmenuid $mainhead + set mainheadid $rowmenuid + redrawtags $oldhead + redrawtags $rowmenuid + } + if {$showlocalchanges} { + doshowlocalchanges + } +} + # context menu for a head proc headmenu {x y id head} { global headmenuid headmenuhead headctxmenu mainhead @@ -5812,9 +5864,9 @@ proc cobranch {} { redrawtags $headids($oldmainhead) } redrawtags $headmenuid - if {$showlocalchanges} { - dodiffindex - } + } + if {$showlocalchanges} { + dodiffindex } } -- cgit v1.2.3 From a2c22362cc2c0bb0451bc8098b3ba0c9353ebe02 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Tue, 31 Oct 2006 15:00:53 +1100 Subject: gitk: Limit how often we change the canvas scrolling region For some unknown reason, changing the scrolling region on the canvases provokes multiple milliseconds worth of computation in the X server, and this can end up slowing gitk down significantly. This works around the problem by limiting the rate at which we update the scrolling region after the first 100 rows to at most 2 per second. Signed-off-by: Paul Mackerras --- gitk | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) (limited to 'gitk') diff --git a/gitk b/gitk index d6ed4f6c40..d5b71dd45d 100755 --- a/gitk +++ b/gitk @@ -2616,6 +2616,7 @@ proc layoutmore {tmax allread} { proc showstuff {canshow last} { global numcommits commitrow pending_select selectedline curview global lookingforhead mainheadid displayorder nullid selectfirst + global lastscrollset if {$numcommits == 0} { global phase @@ -2623,8 +2624,13 @@ proc showstuff {canshow last} { allcanvs delete all } set r0 $numcommits + set prev $numcommits set numcommits $canshow - setcanvscroll + set t [clock clicks -milliseconds] + if {$prev < 100 || $last || $t - $lastscrollset > 500} { + set lastscrollset $t + setcanvscroll + } set rows [visiblerows] set r1 [lindex $rows 1] if {$r1 >= $canshow} { -- cgit v1.2.3 From f3326b66bf8d77c19b5ca7ad70e536251c81cccb Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Mon, 18 Jun 2007 22:39:21 +1000 Subject: gitk: Fix bug causing nearby tags/heads to sometimes not be displayed When we compute descendent heads and descendent/ancestor tags, we cache the results. We need to be careful to invalidate the cache when we add stuff to the graph. Also make sure that when we cache descendent heads for a node we only cache the heads that are actually descendents of that node. Signed-off-by: Paul Mackerras --- gitk | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index d5b71dd45d..ac73ff6e42 100755 --- a/gitk +++ b/gitk @@ -5950,7 +5950,7 @@ proc regetallcommits {} { # coming from descendents, and "outgoing" means going towards ancestors. proc getallclines {fd} { - global allids allparents allchildren idtags nextarc nbmp + global allids allparents allchildren idtags idheads nextarc nbmp global arcnos arcids arctags arcout arcend arcstart archeads growing global seeds allcommits @@ -6023,6 +6023,12 @@ proc getallclines {fd} { } set arcout($id) $ao } + if {$nid > 0} { + global cached_dheads cached_dtags cached_atags + catch {unset cached_dheads} + catch {unset cached_dtags} + catch {unset cached_atags} + } if {![eof $fd]} { return [expr {$nid >= 1000? 2: 1}] } @@ -6674,7 +6680,7 @@ proc descheads {id} { if {![info exists allparents($id)]} { return {} } - set ret {} + set aret {} if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} { # part-way along an arc; check it first set a [lindex $arcnos($id) 0] @@ -6684,7 +6690,7 @@ proc descheads {id} { foreach t $archeads($a) { set j [lsearch -exact $arcids($a) $t] if {$j > $i} break - lappend $ret $t + lappend aret $t } } set id $arcstart($a) @@ -6692,6 +6698,7 @@ proc descheads {id} { set origid $id set todo [list $id] set seen($id) 1 + set ret {} for {set i 0} {$i < [llength $todo]} {incr i} { set id [lindex $todo $i] if {[info exists cached_dheads($id)]} { @@ -6714,6 +6721,7 @@ proc descheads {id} { } set ret [lsort -unique $ret] set cached_dheads($origid) $ret + return [concat $ret $aret] } proc addedtag {id} { -- cgit v1.2.3 From 9396cd385ad47f9ecb440221bbff4514f4378f7f Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Sat, 23 Jun 2007 20:28:15 +1000 Subject: gitk: Improve handling of whitespace and special chars in filenames The main thing here is better parsing of the diff --git lines in the output of git diff-tree -p. We now cope with filenames in quotes with special chars escaped. If the filenames contain spaces they aren't quoted, however, which can create difficulties in parsing. We get around the difficulties by detecting the case when the filename hasn't changed (chop the part after "diff --git " in two and see if the halves match apart from a/ in one and b/ in the other), and if it hasn't changed, we just use one half. If the filename has changed we wait for the "rename from" and "rename to" lines, which give the old and new filenames unambiguously. This also improves the parsing of the output of git diff-tree. Instead of using lindex to extract the filename, we take the part from the first tab on, and if it starts with a quote, we use [lindex $str 0] to remove the quotes and convert the escapes. This also gets rid of some unused tagging of the diff text, uses [string compare] instead of [regexp] in some places, and fixes the regexp for detecting the @@ hunk-separator lines (the regexp wasn't accepting a single number, as in "-0,0 +1" for example). Signed-off-by: Paul Mackerras --- gitk | 135 ++++++++++++++++++++++++++++++++++++++++++------------------------- 1 file changed, 84 insertions(+), 51 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index ac73ff6e42..72a914590c 100755 --- a/gitk +++ b/gitk @@ -4400,7 +4400,6 @@ proc selectline {l isnew} { } appendwithlinks $comment {comment} - $ctext tag delete Comments $ctext tag remove found 1.0 end $ctext conf -state disabled set commentend [$ctext index "end - 1c"] @@ -4566,10 +4565,11 @@ proc gettreeline {gtf id} { set nl 0 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} { if {$diffids ne $nullid} { - set tl [split $line "\t"] - if {[lindex $tl 0 1] ne "blob"} continue - set sha1 [lindex $tl 0 2] - set fname [lindex $tl 1] + if {[lindex $line 1] ne "blob"} continue + set i [string first "\t" $line] + if {$i < 0} continue + set sha1 [lindex $line 2] + set fname [string range $line [expr {$i+1}] end] if {[string index $fname 0] eq "\""} { set fname [lindex $fname 0] } @@ -4797,8 +4797,14 @@ proc gettreediffline {gdtf ids} { set nr 0 while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} { - set file [lindex $line 5] - lappend treediff $file + set i [string first "\t" $line] + if {$i >= 0} { + set file [string range $line [expr {$i+1}] end] + if {[string index $file 0] eq "\""} { + set file [lindex $file 0] + } + lappend treediff $file + } } if {![eof $gdtf]} { return [expr {$nr >= 1000? 2: 1}] @@ -4819,7 +4825,7 @@ proc gettreediffline {gdtf ids} { } proc getblobdiffs {ids} { - global diffopts blobdifffd diffids env curdifftag curtagstart + global diffopts blobdifffd diffids env global diffinhdr treediffs set env(GIT_DIFF_OPTS) $diffopts @@ -4830,8 +4836,6 @@ proc getblobdiffs {ids} { set diffinhdr 0 fconfigure $bdf -blocking 0 set blobdifffd($ids) $bdf - set curdifftag Comments - set curtagstart 0.0 filerun $bdf [list getblobdiffline $bdf $diffids] } @@ -4848,8 +4852,20 @@ proc setinlist {var i val} { } } +proc makediffhdr {fname ids} { + global ctext curdiffstart treediffs + + set i [lsearch -exact $treediffs($ids) $fname] + if {$i >= 0} { + setinlist difffilestart $i $curdiffstart + } + set l [expr {(78 - [string length $fname]) / 2}] + set pad [string range "----------------------------------------" 1 $l] + $ctext insert $curdiffstart "$pad $fname $pad" filesep +} + proc getblobdiffline {bdf ids} { - global diffids blobdifffd ctext curdifftag curtagstart + global diffids blobdifffd ctext curdiffstart global diffnexthead diffnextnote difffilestart global diffinhdr treediffs @@ -4860,38 +4876,67 @@ proc getblobdiffline {bdf ids} { close $bdf return 0 } - if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} { + if {![string compare -length 11 "diff --git " $line]} { + # trim off "diff --git " + set line [string range $line 11 end] + set diffinhdr 1 # start of a new file $ctext insert end "\n" - $ctext tag add $curdifftag $curtagstart end - set here [$ctext index "end - 1c"] - set curtagstart $here - set header $newname - set i [lsearch -exact $treediffs($ids) $fname] - if {$i >= 0} { - setinlist difffilestart $i $here + set curdiffstart [$ctext index "end - 1c"] + $ctext insert end "\n" filesep + # If the name hasn't changed the length will be odd, + # the middle char will be a space, and the two bits either + # side will be a/name and b/name, or "a/name" and "b/name". + # If the name has changed we'll get "rename from" and + # "rename to" lines following this, and we'll use them + # to get the filenames. + # This complexity is necessary because spaces in the filename(s) + # don't get escaped. + set l [string length $line] + set i [expr {$l / 2}] + if {!(($l & 1) && [string index $line $i] eq " " && + [string range $line 2 [expr {$i - 1}]] eq \ + [string range $line [expr {$i + 3}] end])} { + continue } - if {$newname ne $fname} { - set i [lsearch -exact $treediffs($ids) $newname] - if {$i >= 0} { - setinlist difffilestart $i $here - } + # unescape if quoted and chop off the a/ from the front + if {[string index $line 0] eq "\""} { + set fname [string range [lindex $line 0] 2 end] + } else { + set fname [string range $line 2 [expr {$i - 1}]] } - set curdifftag "f:$fname" - $ctext tag delete $curdifftag - set l [expr {(78 - [string length $header]) / 2}] - set pad [string range "----------------------------------------" \ - 1 $l] - $ctext insert end "$pad $header $pad\n" filesep - set diffinhdr 1 - } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} { - # do nothing - } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} { - set diffinhdr 0 - } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \ + makediffhdr $fname $ids + + } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \ $line match f1l f1c f2l f2c rest]} { $ctext insert end "$line\n" hunksep set diffinhdr 0 + + } elseif {$diffinhdr} { + if {![string compare -length 12 "rename from " $line]} { + set fname [string range $line 12 end] + if {[string index $fname 0] eq "\""} { + set fname [lindex $fname 0] + } + set i [lsearch -exact $treediffs($ids) $fname] + if {$i >= 0} { + setinlist difffilestart $i $curdiffstart + } + } elseif {![string compare -length 10 $line "rename to "]} { + set fname [string range $line 10 end] + if {[string index $fname 0] eq "\""} { + set fname [lindex $fname 0] + } + makediffhdr $fname $ids + } elseif {[string compare -length 3 $line "---"] == 0} { + # do nothing + continue + } elseif {[string compare -length 3 $line "+++"] == 0} { + set diffinhdr 0 + continue + } + $ctext insert end "$line\n" filesep + } else { set x [string range $line 0 0] if {$x == "-" || $x == "+"} { @@ -4899,27 +4944,16 @@ proc getblobdiffline {bdf ids} { $ctext insert end "$line\n" d$tag } elseif {$x == " "} { $ctext insert end "$line\n" - } elseif {$diffinhdr || $x == "\\"} { - # e.g. "\ No newline at end of file" - $ctext insert end "$line\n" filesep } else { - # Something else we don't recognize - if {$curdifftag != "Comments"} { - $ctext insert end "\n" - $ctext tag add $curdifftag $curtagstart end - set curtagstart [$ctext index "end - 1c"] - set curdifftag Comments - } - $ctext insert end "$line\n" filesep + # "\ No newline at end of file", + # or something else we don't recognize + $ctext insert end "$line\n" hunksep } } } $ctext conf -state disabled if {[eof $bdf]} { close $bdf - if {$ids == $diffids && $bdf == $blobdifffd($ids)} { - $ctext tag add $curdifftag $curtagstart end - } return 0 } return [expr {$nr >= 1000? 2: 1}] @@ -5444,7 +5478,6 @@ proc doseldiff {oldid newid} { $ctext insert end [lindex $commitinfo($newid) 0] $ctext insert end "\n" $ctext conf -state disabled - $ctext tag delete Comments $ctext tag remove found 1.0 end startdiff [list $oldid $newid] } -- cgit v1.2.3 From 706d6c3e76fc5f7f988b056015689b489eb8f6b5 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Tue, 26 Jun 2007 11:09:49 +1000 Subject: gitk: Add a progress bar to show progress while resetting Since git reset now gets chatty while resetting, we were getting errors reported when a reset was done using the "reset branch to here" menu item. With this we now read the progress messages from git reset and update a progress bar. Because git reset outputs the progress messages to standard error, and Tcl treats messages to standard error as error messages, we have to invoke git reset via a shell and redirect standard error into standard output. This also fixes a bug in computing descendent heads when head ids are changed via a reset. Signed-off-by: Paul Mackerras --- gitk | 52 +++++++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 45 insertions(+), 7 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 72a914590c..269f9b08a0 100755 --- a/gitk +++ b/gitk @@ -5851,19 +5851,54 @@ proc resethead {} { bind $w "grab $w; focus $w" tkwait window $w if {!$confirm_ok} return - dohidelocalchanges - if {[catch {exec git reset --$resettype $rowmenuid} err]} { + if {[catch {set fd [open \ + [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} { error_popup $err } else { - set oldhead $mainheadid - movedhead $rowmenuid $mainhead - set mainheadid $rowmenuid + dohidelocalchanges + set w ".resetprogress" + filerun $fd [list readresetstat $fd $w] + toplevel $w + wm transient $w + wm title $w "Reset progress" + message $w.m -text "Reset in progress, please wait..." \ + -justify center -aspect 1000 + pack $w.m -side top -fill x -padx 20 -pady 5 + canvas $w.c -width 150 -height 20 -bg white + $w.c create rect 0 0 0 20 -fill green -tags rect + pack $w.c -side top -fill x -padx 20 -pady 5 -expand 1 + nowbusy reset + } +} + +proc readresetstat {fd w} { + global mainhead mainheadid showlocalchanges + + if {[gets $fd line] >= 0} { + if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} { + set x [expr {($m * 150) / $n}] + $w.c coords rect 0 0 $x 20 + } + return 1 + } + destroy $w + notbusy reset + if {[catch {close $fd} err]} { + error_popup $err + } + set oldhead $mainheadid + set newhead [exec git rev-parse HEAD] + if {$newhead ne $oldhead} { + movehead $newhead $mainhead + movedhead $newhead $mainhead + set mainheadid $newhead redrawtags $oldhead - redrawtags $rowmenuid + redrawtags $newhead } if {$showlocalchanges} { doshowlocalchanges } + return 0 } # context menu for a head @@ -6742,7 +6777,10 @@ proc descheads {id} { } foreach a $arcnos($id) { if {$archeads($a) ne {}} { - set ret [concat $ret $archeads($a)] + validate_archeads $a + if {$archeads($a) ne {}} { + set ret [concat $ret $archeads($a)] + } } set d $arcstart($a) if {![info exists seen($d)]} { -- cgit v1.2.3 From 6bc9d1e2e75a68a6027d1f78a95c9ddbbe1d1dfd Mon Sep 17 00:00:00 2001 From: Mark Levedahl Date: Tue, 26 Jun 2007 21:51:35 -0400 Subject: gitk: Use a spinbox for setting tabstop settings The tabstop must be a smallish positive integer, and a spinbox is the accepted UI control to accomplish this limiting rather than the text entry box previously used. Signed-off-by: Mark Levedahl --- gitk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gitk') diff --git a/gitk b/gitk index 269f9b08a0..f1b80ff39a 100755 --- a/gitk +++ b/gitk @@ -6972,7 +6972,7 @@ proc doprefs {} { pack $top.ntag.b $top.ntag.l -side left grid x $top.ntag -sticky w label $top.tabstopl -text "tabstop" -font optionfont - entry $top.tabstop -width 10 -textvariable tabstop + spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop grid x $top.tabstopl $top.tabstop -sticky w label $top.cdisp -text "Colors: press to choose" -- cgit v1.2.3 From 281404ca1db4c921ac162f3c03ae0688d25c5a65 Mon Sep 17 00:00:00 2001 From: Mark Levedahl Date: Tue, 26 Jun 2007 21:51:34 -0400 Subject: gitk: Update selection background colorbar in prefs dialog The callback function was incorrectly set to update the background colorbar when updated the selection background. This did not affect the colors chosen or their use, just their presentation in the preferences dialog box. Signed-off-by: Mark Levedahl --- gitk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gitk') diff --git a/gitk b/gitk index f1b80ff39a..2d6a6ef9ce 100755 --- a/gitk +++ b/gitk @@ -7004,7 +7004,7 @@ proc doprefs {} { grid x $top.hunksepbut $top.hunksep -sticky w label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor button $top.selbgbut -text "Select bg" -font optionfont \ - -command [list choosecolor selectbgcolor 0 $top.bg background setselbg] + -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg] grid x $top.selbgbut $top.selbgsep -sticky w frame $top.buts -- cgit v1.2.3 From 4fb0fa197e14c82d64adb292320f9444d7ac46c5 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Wed, 4 Jul 2007 19:43:51 +1000 Subject: gitk: Fix the find and highlight functions This reworks the way that the "Find" button (and the /, ?, ^F, and ^G keys) works. Previously, pressing the "Find" button would cause gitk to go off and scan through every commit to see which commits matched, and the user interface was completely unreponsive during that time. Now the searching is done in chunks using the scheduler, so the UI still responds, and the search stops as soon as a matching commit is found. The highlighting of matches using a yellow background is now done in the commit-drawing code and the highlighting code. This ensures that all the commits that are visible that match are highlighted without the search code having to find them all. This also fixes a bug where previously-drawn commits that need to be highlighted were not being highlighted. Signed-off-by: Paul Mackerras --- gitk | 323 ++++++++++++++++++++++++++++++++++++++----------------------------- 1 file changed, 185 insertions(+), 138 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 2d6a6ef9ce..d509145490 100755 --- a/gitk +++ b/gitk @@ -1758,7 +1758,7 @@ proc showview {n} { global colormap rowtextx commitrow nextcolor canvxmax global numcommits rowrangelist commitlisted idrowranges rowchk global selectedline currentid canv canvy0 - global matchinglines treediffs + global treediffs global pending_select phase global commitidx rowlaidout rowoptim global commfd @@ -1802,7 +1802,6 @@ proc showview {n} { [list {} $rowidlist $rowoffsets $rowrangelist] } } - catch {unset matchinglines} catch {unset treediffs} clear_display if {[info exists hlview] && $hlview == $n} { @@ -2132,7 +2131,7 @@ proc readfhighlight {} { proc find_change {name ix op} { global nhighlights mainfont boldnamerows - global findstring findpattern findtype + global findstring findpattern findtype markingmatches # delete previous highlights, if any foreach row $boldnamerows { @@ -2141,17 +2140,32 @@ proc find_change {name ix op} { set boldnamerows {} catch {unset nhighlights} unbolden + unmarkmatches if {$findtype ne "Regexp"} { set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \ $findstring] set findpattern "*$e*" } + set markingmatches [expr {$findstring ne {}}] drawvisible } +proc doesmatch {f} { + global findtype findstring findpattern + + if {$findtype eq "Regexp"} { + return [regexp $findstring $f] + } elseif {$findtype eq "IgnCase"} { + return [string match -nocase $findpattern $f] + } else { + return [string match $findpattern $f] + } +} + proc askfindhighlight {row id} { global nhighlights commitinfo iddrawn mainfont - global findstring findtype findloc findpattern + global findloc + global markingmatches if {![info exists commitinfo($id)]} { getcommit $id @@ -2160,35 +2174,47 @@ proc askfindhighlight {row id} { set isbold 0 set fldtypes {Headline Author Date Committer CDate Comments} foreach f $info ty $fldtypes { - if {$findloc ne "All fields" && $findloc ne $ty} { - continue - } - if {$findtype eq "Regexp"} { - set doesmatch [regexp $findstring $f] - } elseif {$findtype eq "IgnCase"} { - set doesmatch [string match -nocase $findpattern $f] - } else { - set doesmatch [string match $findpattern $f] - } - if {$doesmatch} { + if {($findloc eq "All fields" || $findloc eq $ty) && + [doesmatch $f]} { if {$ty eq "Author"} { set isbold 2 - } else { - set isbold 1 + break } + set isbold 1 } } - if {[info exists iddrawn($id)]} { - if {$isbold && ![ishighlighted $row]} { - bolden $row [concat $mainfont bold] + if {$isbold && [info exists iddrawn($id)]} { + set f [concat $mainfont bold] + if {![ishighlighted $row]} { + bolden $row $f + if {$isbold > 1} { + bolden_name $row $f + } } - if {$isbold >= 2} { - bolden_name $row [concat $mainfont bold] + if {$markingmatches} { + markrowmatches $row [lindex $info 0] [lindex $info 1] } } set nhighlights($row) $isbold } +proc markrowmatches {row headline author} { + global canv canv2 linehtag linentag + + $canv delete match$row + $canv2 delete match$row + set m [findmatches $headline] + if {$m ne {}} { + markmatches $canv $row $headline $linehtag($row) $m \ + [$canv itemcget $linehtag($row) -font] + } + set m [findmatches $author] + if {$m ne {}} { + markmatches $canv2 $row $author $linentag($row) $m \ + [$canv2 itemcget $linentag($row) -font] + } +} + proc vrel_change {name ix op} { global highlight_related @@ -3309,7 +3335,7 @@ proc drawcmittext {id row col} { global linespc canv canv2 canv3 canvy0 fgcolor global commitlisted commitinfo rowidlist parentlist global rowtextx idpos idtags idheads idotherrefs - global linehtag linentag linedtag + global linehtag linentag linedtag markingmatches global mainfont canvxmax boldrows boldnamerows fgcolor nullid if {$id eq $nullid} { @@ -3366,6 +3392,9 @@ proc drawcmittext {id row col} { 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 {$markingmatches} { + markrowmatches $row $headline $name + } if {$xr > $canvxmax} { set canvxmax $xr setcanvscroll @@ -3436,9 +3465,7 @@ proc drawcommits {row {endrow {}}} { for {} {$r <= $er} {incr r} { set id [lindex $displayorder $r] set wasdrawn [info exists iddrawn($id)] - if {!$wasdrawn} { - drawcmitrow $r - } + drawcmitrow $r if {$r == $er} break set nextid [lindex $displayorder [expr {$r + 1}]] if {$wasdrawn && [info exists iddrawn($nextid)]} { @@ -3889,101 +3916,166 @@ proc notbusy {what} { } proc findmatches {f} { - global findtype foundstring foundstrlen + global findtype findstring if {$findtype == "Regexp"} { - set matches [regexp -indices -all -inline $foundstring $f] + set matches [regexp -indices -all -inline $findstring $f] } else { + set fs $findstring if {$findtype == "IgnCase"} { - set str [string tolower $f] - } else { - set str $f + set f [string tolower $f] + set fs [string tolower $fs] } set matches {} set i 0 - while {[set j [string first $foundstring $str $i]] >= 0} { - lappend matches [list $j [expr {$j+$foundstrlen-1}]] - set i [expr {$j + $foundstrlen}] + set l [string length $fs] + while {[set j [string first $fs $f $i]] >= 0} { + lappend matches [list $j [expr {$j+$l-1}]] + set i [expr {$j + $l}] } } return $matches } -proc dofind {} { - global findtype findloc findstring markedmatches commitinfo - global numcommits displayorder linehtag linentag linedtag - global mainfont canv canv2 canv3 selectedline - global matchinglines foundstring foundstrlen matchstring - global commitdata +proc dofind {{rev 0}} { + global findstring findstartline findcurline selectedline numcommits stopfindproc unmarkmatches cancel_next_highlight focus . - set matchinglines {} - if {$findtype == "IgnCase"} { - set foundstring [string tolower $findstring] + if {$findstring eq {} || $numcommits == 0} return + if {![info exists selectedline]} { + set findstartline [lindex [visiblerows] $rev] } else { - set foundstring $findstring + set findstartline $selectedline } - set foundstrlen [string length $findstring] - if {$foundstrlen == 0} return - regsub -all {[*?\[\\]} $foundstring {\\&} matchstring - set matchstring "*$matchstring*" - if {![info exists selectedline]} { - set oldsel -1 + set findcurline $findstartline + nowbusy finding + if {!$rev} { + run findmore } else { - set oldsel $selectedline + set findcurline $findstartline + if {$findcurline == 0} { + set findcurline $numcommits + } + incr findcurline -1 + run findmorerev } - set didsel 0 - set fldtypes {Headline Author Date Committer CDate Comments} - set l -1 - foreach id $displayorder { - set d $commitdata($id) - incr l - if {$findtype == "Regexp"} { - set doesmatch [regexp $foundstring $d] - } elseif {$findtype == "IgnCase"} { - set doesmatch [string match -nocase $matchstring $d] +} + +proc findnext {restart} { + global findcurline + if {![info exists findcurline]} { + if {$restart} { + dofind } else { - set doesmatch [string match $matchstring $d] + bell } - if {!$doesmatch} continue + } else { + run findmore + nowbusy finding + } +} + +proc findprev {} { + global findcurline + if {![info exists findcurline]} { + dofind 1 + } else { + run findmorerev + nowbusy finding + } +} + +proc findmore {} { + global commitdata commitinfo numcommits findstring findpattern findloc + global findstartline findcurline markingmatches displayorder + + set fldtypes {Headline Author Date Committer CDate Comments} + set l [expr {$findcurline + 1}] + if {$l >= $numcommits} { + set l 0 + } + if {$l <= $findstartline} { + set lim [expr {$findstartline + 1}] + } else { + set lim $numcommits + } + if {$lim - $l > 500} { + set lim [expr {$l + 500}] + } + set last 0 + for {} {$l < $lim} {incr l} { + set id [lindex $displayorder $l] + if {![doesmatch $commitdata($id)]} continue if {![info exists commitinfo($id)]} { getcommit $id } set info $commitinfo($id) - set doesmatch 0 foreach f $info ty $fldtypes { - if {$findloc != "All fields" && $findloc != $ty} { - continue - } - set matches [findmatches $f] - if {$matches == {}} continue - set doesmatch 1 - if {$ty == "Headline"} { - drawcommits $l - markmatches $canv $l $f $linehtag($l) $matches $mainfont - } elseif {$ty == "Author"} { - drawcommits $l - markmatches $canv2 $l $f $linentag($l) $matches $mainfont - } elseif {$ty == "Date"} { - drawcommits $l - markmatches $canv3 $l $f $linedtag($l) $matches $mainfont + if {($findloc eq "All fields" || $findloc eq $ty) && + [doesmatch $f]} { + set markingmatches 1 + findselectline $l + notbusy finding + return 0 } } - if {$doesmatch} { - lappend matchinglines $l - if {!$didsel && $l > $oldsel} { + } + if {$l == $findstartline + 1} { + bell + unset findcurline + notbusy finding + return 0 + } + set findcurline [expr {$l - 1}] + return 1 +} + +proc findmorerev {} { + global commitdata commitinfo numcommits findstring findpattern findloc + global findstartline findcurline markingmatches displayorder + + set fldtypes {Headline Author Date Committer CDate Comments} + set l $findcurline + if {$l == 0} { + set l $numcommits + } + incr l -1 + if {$l >= $findstartline} { + set lim [expr {$findstartline - 1}] + } else { + set lim -1 + } + if {$l - $lim > 500} { + set lim [expr {$l - 500}] + } + set last 0 + for {} {$l > $lim} {incr l -1} { + set id [lindex $displayorder $l] + if {![doesmatch $commitdata($id)]} continue + if {![info exists commitinfo($id)]} { + getcommit $id + } + set info $commitinfo($id) + foreach f $info ty $fldtypes { + if {($findloc eq "All fields" || $findloc eq $ty) && + [doesmatch $f]} { + set markingmatches 1 findselectline $l - set didsel 1 + notbusy finding + return 0 } } } - if {$matchinglines == {}} { + if {$l == -1} { bell - } elseif {!$didsel} { - findselectline [lindex $matchinglines 0] + unset findcurline + notbusy finding + return 0 } + set findcurline [expr {$l + 1}] + return 1 } proc findselectline {l} { @@ -4001,43 +4093,6 @@ proc findselectline {l} { } } -proc findnext {restart} { - global matchinglines selectedline - if {![info exists matchinglines]} { - if {$restart} { - dofind - } - return - } - if {![info exists selectedline]} return - foreach l $matchinglines { - if {$l > $selectedline} { - findselectline $l - return - } - } - bell -} - -proc findprev {} { - global matchinglines selectedline - if {![info exists matchinglines]} { - dofind - return - } - if {![info exists selectedline]} return - set prev {} - foreach l $matchinglines { - if {$l >= $selectedline} break - set prev $l - } - if {$prev != {}} { - findselectline $prev - } else { - bell - } -} - proc stopfindproc {{done 0}} { global findprocpid findprocfile findids global ctext findoldcursor phase maincursor textcursor @@ -4055,18 +4110,7 @@ proc stopfindproc {{done 0}} { notbusy find } -# mark a commit as matching by putting a yellow background -# behind the headline -proc markheadline {l id} { - global canv mainfont linehtag - - drawcommits $l - set bbox [$canv bbox $linehtag($l)] - set t [$canv create rect $bbox -outline {} -tags matches -fill yellow] - $canv lower $t -} - -# mark the bits of a headline, author or date that match a find string +# mark the bits of a headline or author that match a find string proc markmatches {canv l str tag matches font} { set bbox [$canv bbox $tag] set x0 [lindex $bbox 0] @@ -4080,16 +4124,18 @@ proc markmatches {canv l str tag matches font} { set xlen [font measure $font [string range $str 0 [expr {$end}]]] set t [$canv create rect [expr {$x0+$xoff}] $y0 \ [expr {$x0+$xlen+2}] $y1 \ - -outline {} -tags matches -fill yellow] + -outline {} -tags [list match$l matches] -fill yellow] $canv lower $t } } proc unmarkmatches {} { - global matchinglines findids + global findids markingmatches findcurline + allcanvs delete matches - catch {unset matchinglines} catch {unset findids} + set markingmatches 0 + catch {unset findcurline} } proc selcanvline {w x y} { @@ -7471,6 +7517,7 @@ set searchdirn -forwards set boldrows {} set boldnamerows {} set diffelide {0 0} +set markingmatches 0 set optim_delay 16 -- cgit v1.2.3 From 69c0b5d2408cfe207f2976fc99cbe71208ba83ad Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Wed, 4 Jul 2007 21:57:04 +1000 Subject: gitk: Fix bug in the anc_or_desc routine I missed the case where both nodes have no children and therefore have no incoming arcs. This fixes it. Signed-off-by: Paul Mackerras --- gitk | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'gitk') diff --git a/gitk b/gitk index d509145490..767b0ed8b8 100755 --- a/gitk +++ b/gitk @@ -6261,7 +6261,8 @@ proc anc_or_desc {a b} { # Both are on the same arc(s); either both are the same BMP, # or if one is not a BMP, the other is also not a BMP or is # the BMP at end of the arc (and it only has 1 incoming arc). - if {$a eq $b} { + # Or both can be BMPs with no incoming arcs. + if {$a eq $b || $arcnos($a) eq {}} { return 0 } # assert {[llength $arcnos($a)] == 1} -- cgit v1.2.3 From d36d385efd89d79c9d1f95ab79849ff1478dc425 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Wed, 4 Jul 2007 22:41:19 +1000 Subject: gitk: Remove the unused stopfindproc function This was a hangover from before the "Files" and "Pickaxe" parts of the Find function were moved to the highlight facility in commit 60f7a7dc4904ba4baab44b70e2675a01e6172f54. It serves no useful purpose any more, so this removes it. Signed-off-by: Paul Mackerras --- gitk | 19 ------------------- 1 file changed, 19 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 767b0ed8b8..45e16e4fd5 100755 --- a/gitk +++ b/gitk @@ -1786,7 +1786,6 @@ proc showview {n} { } unselectline normalline - stopfindproc if {$curview >= 0} { set vparentlist($curview) $parentlist set vdisporder($curview) $displayorder @@ -3939,7 +3938,6 @@ proc findmatches {f} { proc dofind {{rev 0}} { global findstring findstartline findcurline selectedline numcommits - stopfindproc unmarkmatches cancel_next_highlight focus . @@ -4093,23 +4091,6 @@ proc findselectline {l} { } } -proc stopfindproc {{done 0}} { - global findprocpid findprocfile findids - global ctext findoldcursor phase maincursor textcursor - global findinprogress - - catch {unset findids} - if {[info exists findprocpid]} { - if {!$done} { - catch {exec kill $findprocpid} - } - catch {close $findprocfile} - unset findprocpid - } - catch {unset findinprogress} - notbusy find -} - # mark the bits of a headline or author that match a find string proc markmatches {canv l str tag matches font} { set bbox [$canv bbox $tag] -- cgit v1.2.3 From 096e96b493bfc30687c87b303b93e75864942786 Mon Sep 17 00:00:00 2001 From: Brian Downing Date: Thu, 5 Jul 2007 06:33:02 -0500 Subject: [PATCH] gitk: Fix for tree view ending in nested directories Unroll the prefix stack when assigning treeheights when leaving proc treeview. Previously, when the ls-tree output ended in multiple nested directories (for instance in a repository with a single file "foo/bar/baz"), $treeheight("foo/bar/") was assigned twice, and $treeheight("foo/") was never assigned. This led to an error when expanding the "foo" directory in the gitk treeview. Signed-off-by: Brian Downing Signed-off-by: Paul Mackerras --- gitk | 3 +++ 1 file changed, 3 insertions(+) (limited to 'gitk') diff --git a/gitk b/gitk index 45e16e4fd5..28a6bac3aa 100755 --- a/gitk +++ b/gitk @@ -1216,6 +1216,9 @@ proc treeview {w l openlevs} { set treeheight($prefix) $ht incr ht [lindex $htstack end] set htstack [lreplace $htstack end end] + set prefixend [lindex $prefendstack end] + set prefendstack [lreplace $prefendstack end end] + set prefix [string range $prefix 0 $prefixend] } $w conf -state disabled } -- cgit v1.2.3 From 8c93917d23ec7ef998154a6b2ac91ed1a1bf5e3a Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Mon, 9 Jul 2007 22:29:24 +1000 Subject: gitk: Fix bug causing "can't read commitrow(0,n)" error In commit 66e46f37de3ed3211a8ae0e8fc09c063bc3a1e08 I changed gitk to store ids in rowrangelist and idrowranges rather than row numbers, but I missed two places in the layouttail procedure. This resulted in occasional errors such as the "can't read "commitrow(0,8572)": no such element in array" error reported by Mark Levedahl. This fixes it by using the id rather than the row number. Signed-off-by: Paul Mackerras --- gitk | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 28a6bac3aa..ee818647c4 100755 --- a/gitk +++ b/gitk @@ -2885,7 +2885,7 @@ proc layouttail {} { set id [lindex $idlist $col] addextraid $id $row unset idinlist($id) - lappend idrowranges($id) $row + lappend idrowranges($id) $id lappend rowrangelist $idrowranges($id) unset idrowranges($id) incr row @@ -2901,7 +2901,7 @@ proc layouttail {} { lset rowidlist $row [list $id] lset rowoffsets $row 0 makeuparrow $id 0 $row 0 - lappend idrowranges($id) $row + lappend idrowranges($id) $id lappend rowrangelist $idrowranges($id) unset idrowranges($id) incr row -- cgit v1.2.3 From c961b228bcab390a1b42d517b6ed5a1edb55efed Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Mon, 9 Jul 2007 22:45:47 +1000 Subject: gitk: Use git log and add support for --left-right This is based on patches from Linus Torvalds and Junio Hamano, so the ideas here are theirs. This makes gitk use "git log -z --pretty=raw" instead of "git rev-list" to generate the list of commits, and also makes it grok the "<" and ">" markers that git log (and git rev-list) output with the --left-right flag to indicate which side of a symmetric diff a commit is reachable from. Left-side commits are drawn with a triangle pointing leftwards instead of a circle, and right-side commits are drawn with a triangle pointing rightwards. The commitlisted list is used to store the left/right information as well as the information about whether each commit is on the boundary. Signed-off-by: Paul Mackerras --- gitk | 46 ++++++++++++++++++++++++++++++++++------------ 1 file changed, 34 insertions(+), 12 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index ee818647c4..468cf32228 100755 --- a/gitk +++ b/gitk @@ -96,8 +96,8 @@ proc start_rev_list {view} { set order "--date-order" } if {[catch { - set fd [open [concat | git rev-list --header $order \ - --parents --boundary --default HEAD $args] r] + set fd [open [concat | git log -z --pretty=raw $order \ + --parents --boundary $args] r] } err]} { puts stderr "Error executing git rev-list: $err" exit 1 @@ -194,10 +194,14 @@ proc getcommitlines {fd view} { set j [string first "\n" $cmit] set ok 0 set listed 1 - if {$j >= 0} { - set ids [string range $cmit 0 [expr {$j - 1}]] - if {[string range $ids 0 0] == "-"} { - set listed 0 + if {$j >= 0 && [string match "commit *" $cmit]} { + set ids [string range $cmit 7 [expr {$j - 1}]] + if {[string match {[-<>]*} $ids]} { + switch -- [string index $ids 0] { + "-" {set listed 0} + "<" {set listed 2} + ">" {set listed 3} + } set ids [string range $ids 1 end] } set ok 1 @@ -213,7 +217,7 @@ proc getcommitlines {fd view} { if {[string length $shortcmit] > 80} { set shortcmit "[string range $shortcmit 0 80]..." } - error_popup "Can't parse git rev-list output: {$shortcmit}" + error_popup "Can't parse git log output: {$shortcmit}" exit 1 } set id [lindex $ids 0] @@ -3334,23 +3338,41 @@ proc drawlines {id} { } proc drawcmittext {id row col} { - global linespc canv canv2 canv3 canvy0 fgcolor + global linespc canv canv2 canv3 canvy0 fgcolor curview global commitlisted commitinfo rowidlist parentlist global rowtextx idpos idtags idheads idotherrefs global linehtag linentag linedtag markingmatches global mainfont canvxmax boldrows boldnamerows fgcolor nullid + # listed is 0 for boundary, 1 for normal, 2 for left, 3 for right + set listed [lindex $commitlisted $row] if {$id eq $nullid} { set ofill red } else { - set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}] + set ofill [expr {$listed != 0? "blue": "white"}] } set x [xc $row $col] set y [yc $row] 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 $fgcolor -width 1 -tags circle] + if {$listed <= 1} { + set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \ + [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \ + -fill $ofill -outline $fgcolor -width 1 -tags circle] + } elseif {$listed == 2} { + # triangle pointing left for left-side commits + set t [$canv create polygon \ + [expr {$x - $orad}] $y \ + [expr {$x + $orad - 1}] [expr {$y - $orad}] \ + [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \ + -fill $ofill -outline $fgcolor -width 1 -tags circle] + } else { + # triangle pointing right for right-side commits + set t [$canv create polygon \ + [expr {$x + $orad - 1}] $y \ + [expr {$x - $orad}] [expr {$y - $orad}] \ + [expr {$x - $orad}] [expr {$y + $orad - 1}] \ + -fill $ofill -outline $fgcolor -width 1 -tags circle] + } $canv raise $t $canv bind $t <1> {selcanvline {} %x %y} set rmx [llength [lindex $rowidlist $row]] -- cgit v1.2.3 From cdaee5db165ba8bae8d3b524950e61666fc36a84 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Thu, 12 Jul 2007 22:29:49 +1000 Subject: gitk: Improve handling of -- and ambiguous arguments This makes gitk more consistent with git rev-list and git log in its handling of arguments that could be either a revision or a filename; now gitk displays an error message and quits, rather than treating it as a revision and getting an error in the underlying git log. Now gitk always passes "--" to git log even if no filenames are being specified. It also makes gitk display errors in invoking git log in a window rather than on stderr, and makes gitk stop looking for a -d flag when it sees a "--" argument. Signed-off-by: Paul Mackerras --- gitk | 49 +++++++++++++++++++++++++++++-------------------- 1 file changed, 29 insertions(+), 20 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 468cf32228..b9219c2c70 100755 --- a/gitk +++ b/gitk @@ -87,19 +87,15 @@ proc start_rev_list {view} { set startmsecs [clock clicks -milliseconds] set commitidx($view) 0 - set args $viewargs($view) - if {$viewfiles($view) ne {}} { - set args [concat $args "--" $viewfiles($view)] - } set order "--topo-order" if {$datemode} { set order "--date-order" } if {[catch { - set fd [open [concat | git log -z --pretty=raw $order \ - --parents --boundary $args] r] + set fd [open [concat | git log -z --pretty=raw $order --parents \ + --boundary $viewargs($view) "--" $viewfiles($view)] r] } err]} { - puts stderr "Error executing git rev-list: $err" + error_popup "Error executing git rev-list: $err" exit 1 } set commfd($view) $fd @@ -7471,35 +7467,48 @@ catch {source ~/.gitk} font create optionfont -family sans-serif -size -12 +# check that we can find a .git directory somewhere... +set gitdir [gitdir] +if {![file isdirectory $gitdir]} { + show_error {} . "Cannot find the git directory \"$gitdir\"." + exit 1 +} + set revtreeargs {} +set cmdline_files {} +set i 0 foreach arg $argv { switch -regexp -- $arg { "^$" { } "^-d" { set datemode 1 } + "--" { + set cmdline_files [lrange $argv [expr {$i + 1}] end] + break + } default { lappend revtreeargs $arg } } + incr i } -# check that we can find a .git directory somewhere... -set gitdir [gitdir] -if {![file isdirectory $gitdir]} { - show_error {} . "Cannot find the git directory \"$gitdir\"." - exit 1 -} - -set cmdline_files {} -set i [lsearch -exact $revtreeargs "--"] -if {$i >= 0} { - set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end] - set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]] -} elseif {$revtreeargs ne {}} { +if {$i >= [llength $argv] && $revtreeargs ne {}} { + # no -- on command line, but some arguments (other than -d) if {[catch { set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs] set cmdline_files [split $f "\n"] set n [llength $cmdline_files] set revtreeargs [lrange $revtreeargs 0 end-$n] + # Unfortunately git rev-parse doesn't produce an error when + # something is both a revision and a filename. To be consistent + # with git log and git rev-list, check revtreeargs for filenames. + foreach arg $revtreeargs { + if {[file exists $arg]} { + show_error {} . "Ambiguous argument '$arg': both revision\ + and filename" + exit 1 + } + } } err]} { # unfortunately we get both stdout and stderr in $err, # so look for "fatal:". -- cgit v1.2.3 From 6ebedabf2d0f77c2c765ecc5effee1a7e3ffdedb Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Fri, 13 Jul 2007 13:45:55 +1000 Subject: gitk: Fix bug introduced by previous commit When I added the "--" case to the code scanning the arguments, I missed the fact that since the switch statement uses -regexp, the "--" case will match any argument containing "--", e.g. "--all". This fixes it by taking out the -regexp (since we don't actually need regular expression matching) and adjusting the match strings. A side effect of this is that previously any argument starting with "-d" would be taken to indicate date mode; now the argument has to be exactly "-d" if you want date mode. Signed-off-by: Paul Mackerras --- gitk | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index b9219c2c70..39e452aba9 100755 --- a/gitk +++ b/gitk @@ -7478,9 +7478,9 @@ set revtreeargs {} set cmdline_files {} set i 0 foreach arg $argv { - switch -regexp -- $arg { - "^$" { } - "^-d" { set datemode 1 } + switch -- $arg { + "" { } + "-d" { set datemode 1 } "--" { set cmdline_files [lrange $argv [expr {$i + 1}] end] break -- cgit v1.2.3 From 8f4893639129acfc866c71583317090aa2a46eab Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Fri, 13 Jul 2007 19:49:37 +1000 Subject: gitk: Show changes in index and changes in working directory separately This makes gitk show up to two fake commits when there are local changes in the repository; one to represent the state of the index and one to represent the state of the working directory. The commit representing the working directory is colored red as before; the commit representing the index state is colored magenta (as being between red and blue in some sense). Signed-off-by: Paul Mackerras --- gitk | 195 +++++++++++++++++++++++++++++++++++++++++++++++-------------------- 1 file changed, 138 insertions(+), 57 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 39e452aba9..7ce86b849e 100755 --- a/gitk +++ b/gitk @@ -262,11 +262,11 @@ proc chewcommits {view} { set tlimit [expr {[clock clicks -milliseconds] + 50}] set more [layoutmore $tlimit $allread] if {$allread && !$more} { - global displayorder nullid commitidx phase + global displayorder commitidx phase global numcommits startmsecs if {[info exists pending_select]} { - set row [expr {[lindex $displayorder 0] eq $nullid}] + set row [first_real_row] selectline $row 1 } if {$commitidx($curview) > 0} { @@ -437,6 +437,19 @@ proc readrefs {} { } } +# skip over fake commits +proc first_real_row {} { + global nullid nullid2 displayorder numcommits + + for {set row 0} {$row < $numcommits} {incr row} { + set id [lindex $displayorder $row] + if {$id ne $nullid && $id ne $nullid2} { + break + } + } + return $row +} + # update things for a head moved to a child of its previous location proc movehead {id name} { global headids idheads @@ -1871,7 +1884,7 @@ proc showview {n} { } elseif {$selid ne {}} { set pending_select $selid } else { - set row [expr {[lindex $displayorder 0] eq $nullid}] + set row [first_real_row] if {$row < $numcommits} { selectline $row 0 } else { @@ -2643,7 +2656,7 @@ proc layoutmore {tmax allread} { proc showstuff {canshow last} { global numcommits commitrow pending_select selectedline curview - global lookingforhead mainheadid displayorder nullid selectfirst + global lookingforhead mainheadid displayorder selectfirst global lastscrollset if {$numcommits == 0} { @@ -2676,7 +2689,7 @@ proc showstuff {canshow last} { if {[info exists selectedline] || [info exists pending_select]} { set selectfirst 0 } else { - set l [expr {[lindex $displayorder 0] eq $nullid}] + set l [first_real_row] selectline $l 1 set selectfirst 0 } @@ -2700,48 +2713,93 @@ proc doshowlocalchanges {} { } proc dohidelocalchanges {} { - global lookingforhead localrow lserial + global lookingforhead localfrow localirow lserial set lookingforhead 0 - if {$localrow >= 0} { - removerow $localrow - set localrow -1 + if {$localfrow >= 0} { + removerow $localfrow + set localfrow -1 + if {$localirow > 0} { + incr localirow -1 + } + } + if {$localirow >= 0} { + removerow $localirow + set localirow -1 } incr lserial } -# spawn off a process to do git diff-index HEAD +# spawn off a process to do git diff-index --cached HEAD proc dodiffindex {} { - global localrow lserial + global localirow localfrow lserial incr lserial - set localrow -1 - set fd [open "|git diff-index HEAD" r] + set localfrow -1 + set localirow -1 + set fd [open "|git diff-index --cached HEAD" r] fconfigure $fd -blocking 0 filerun $fd [list readdiffindex $fd $lserial] } proc readdiffindex {fd serial} { - global localrow commitrow mainheadid nullid curview + global localirow commitrow mainheadid nullid2 curview global commitinfo commitdata lserial + set isdiff 1 if {[gets $fd line] < 0} { - if {[eof $fd]} { - close $fd - return 0 + if {![eof $fd]} { + return 1 } - return 1 + set isdiff 0 } # we only need to see one line and we don't really care what it says... close $fd - if {$serial == $lserial && $localrow == -1} { + # now see if there are any local changes not checked in to the index + if {$serial == $lserial} { + set fd [open "|git diff-files" r] + fconfigure $fd -blocking 0 + filerun $fd [list readdifffiles $fd $serial] + } + + if {$isdiff && $serial == $lserial && $localirow == -1} { + # add the line for the changes in the index to the graph + set localirow $commitrow($curview,$mainheadid) + set hl "Local changes checked in to index but not committed" + set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"] + set commitdata($nullid2) "\n $hl\n" + insertrow $localirow $nullid2 + } + return 0 +} + +proc readdifffiles {fd serial} { + global localirow localfrow commitrow mainheadid nullid curview + global commitinfo commitdata lserial + + set isdiff 1 + if {[gets $fd line] < 0} { + if {![eof $fd]} { + return 1 + } + set isdiff 0 + } + # we only need to see one line and we don't really care what it says... + close $fd + + if {$isdiff && $serial == $lserial && $localfrow == -1} { # add the line for the local diff to the graph - set localrow $commitrow($curview,$mainheadid) - set hl "Local uncommitted changes" + if {$localirow >= 0} { + set localfrow $localirow + incr localirow + } else { + set localfrow $commitrow($curview,$mainheadid) + } + set hl "Local uncommitted changes, not checked in to index" set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"] set commitdata($nullid) "\n $hl\n" - insertrow $localrow $nullid + insertrow $localfrow $nullid } return 0 } @@ -3338,12 +3396,14 @@ proc drawcmittext {id row col} { global commitlisted commitinfo rowidlist parentlist global rowtextx idpos idtags idheads idotherrefs global linehtag linentag linedtag markingmatches - global mainfont canvxmax boldrows boldnamerows fgcolor nullid + global mainfont canvxmax boldrows boldnamerows fgcolor nullid nullid2 # listed is 0 for boundary, 1 for normal, 2 for left, 3 for right set listed [lindex $commitlisted $row] if {$id eq $nullid} { set ofill red + } elseif {$id eq $nullid2} { + set ofill magenta } else { set ofill [expr {$listed != 0? "blue": "white"}] } @@ -4582,16 +4642,19 @@ proc goforw {} { } proc gettree {id} { - global treefilelist treeidlist diffids diffmergeid treepending nullid + global treefilelist treeidlist diffids diffmergeid treepending + global nullid nullid2 set diffids $id catch {unset diffmergeid} if {![info exists treefilelist($id)]} { if {![info exists treepending]} { - if {$id ne $nullid} { - set cmd [concat | git ls-tree -r $id] + if {$id eq $nullid} { + set cmd [list | git ls-files] + } elseif {$id eq $nullid2} { + set cmd [list | git ls-files --stage -t] } else { - set cmd [concat | git ls-files] + set cmd [list | git ls-tree -r $id] } if {[catch {set gtf [open $cmd r]}]} { return @@ -4608,12 +4671,14 @@ proc gettree {id} { } proc gettreeline {gtf id} { - global treefilelist treeidlist treepending cmitmode diffids nullid + global treefilelist treeidlist treepending cmitmode diffids nullid nullid2 set nl 0 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} { - if {$diffids ne $nullid} { - if {[lindex $line 1] ne "blob"} continue + if {$diffids eq $nullid} { + set fname $line + } else { + if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue set i [string first "\t" $line] if {$i < 0} continue set sha1 [lindex $line 2] @@ -4622,8 +4687,6 @@ proc gettreeline {gtf id} { set fname [lindex $fname 0] } lappend treeidlist($id) $sha1 - } else { - set fname $line } lappend treefilelist($id) $fname } @@ -4645,7 +4708,7 @@ proc gettreeline {gtf id} { } proc showfile {f} { - global treefilelist treeidlist diffids nullid + global treefilelist treeidlist diffids nullid nullid2 global ctext commentend set i [lsearch -exact $treefilelist($diffids) $f] @@ -4653,15 +4716,15 @@ proc showfile {f} { puts "oops, $f not in list for id $diffids" return } - if {$diffids ne $nullid} { - set blob [lindex $treeidlist($diffids) $i] - if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} { - puts "oops, error reading blob $blob: $err" + if {$diffids eq $nullid} { + if {[catch {set bf [open $f r]} err]} { + puts "oops, can't read $f: $err" return } } else { - if {[catch {set bf [open $f r]} err]} { - puts "oops, can't read $f: $err" + set blob [lindex $treeidlist($diffids) $i] + if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} { + puts "oops, error reading blob $blob: $err" return } } @@ -4789,11 +4852,13 @@ proc getmergediffline {mdf id np} { } proc startdiff {ids} { - global treediffs diffids treepending diffmergeid nullid + global treediffs diffids treepending diffmergeid nullid nullid2 set diffids $ids catch {unset diffmergeid} - if {![info exists treediffs($ids)] || [lsearch -exact $ids $nullid] >= 0} { + if {![info exists treediffs($ids)] || + [lsearch -exact $ids $nullid] >= 0 || + [lsearch -exact $ids $nullid2] >= 0} { if {![info exists treepending]} { gettreediffs $ids } @@ -4809,22 +4874,41 @@ proc addtocflist {ids} { } proc diffcmd {ids flags} { - global nullid + global nullid nullid2 set i [lsearch -exact $ids $nullid] + set j [lsearch -exact $ids $nullid2] if {$i >= 0} { - set cmd [concat | git diff-index $flags] + if {[llength $ids] > 1 && $j < 0} { + # comparing working directory with some specific revision + set cmd [concat | git diff-index $flags] + if {$i == 0} { + lappend cmd -R [lindex $ids 1] + } else { + lappend cmd [lindex $ids 0] + } + } else { + # comparing working directory with index + set cmd [concat | git diff-files $flags] + if {$j == 1} { + lappend cmd -R + } + } + } elseif {$j >= 0} { + set cmd [concat | git diff-index --cached $flags] if {[llength $ids] > 1} { + # comparing index with specific revision if {$i == 0} { lappend cmd -R [lindex $ids 1] } else { lappend cmd [lindex $ids 0] } } else { + # comparing index with HEAD lappend cmd HEAD } } else { - set cmd [concat | git diff-tree --no-commit-id -r $flags $ids] + set cmd [concat | git diff-tree -r $flags $ids] } return $cmd } @@ -4834,7 +4918,7 @@ proc gettreediffs {ids} { set treepending $ids set treediff {} - if {[catch {set gdtf [open [diffcmd $ids {}] r]}]} return + if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return fconfigure $gdtf -blocking 0 filerun $gdtf [list gettreediffline $gdtf $ids] } @@ -4877,7 +4961,7 @@ proc getblobdiffs {ids} { global diffinhdr treediffs set env(GIT_DIFF_OPTS) $diffopts - if {[catch {set bdf [open [diffcmd $ids {-p -C}] r]} err]} { + if {[catch {set bdf [open [diffcmd $ids {-p -C --no-commit-id}] r]} err]} { puts "error getting diffs: $err" return } @@ -5468,7 +5552,7 @@ proc mstime {} { proc rowmenu {x y id} { global rowctxmenu commitrow selectedline rowmenuid curview - global nullid fakerowmenu mainhead + global nullid nullid2 fakerowmenu mainhead set rowmenuid $id if {![info exists selectedline] @@ -5477,7 +5561,7 @@ proc rowmenu {x y id} { } else { set state normal } - if {$id ne $nullid} { + if {$id ne $nullid && $id ne $nullid2} { set menu $rowctxmenu $menu entryconfigure 7 -label "Reset $mainhead branch to here" } else { @@ -5596,18 +5680,12 @@ proc mkpatchrev {} { } proc mkpatchgo {} { - global patchtop nullid + global patchtop nullid nullid2 set oldid [$patchtop.fromsha1 get] set newid [$patchtop.tosha1 get] set fname [$patchtop.fname get] - if {$newid eq $nullid} { - set cmd [list git diff-index -p $oldid] - } elseif {$oldid eq $nullid} { - set cmd [list git diff-index -p -R $newid] - } else { - set cmd [list git diff-tree -p $oldid $newid] - } + set cmd [diffcmd [list $oldid $newid] -p] lappend cmd >$fname & if {[catch {eval exec $cmd} err]} { error_popup "Error creating patch: $err" @@ -7522,6 +7600,8 @@ if {$i >= [llength $argv] && $revtreeargs ne {}} { } set nullid "0000000000000000000000000000000000000000" +set nullid2 "0000000000000000000000000000000000000001" + set runq {} set history {} @@ -7550,7 +7630,8 @@ set stopped 0 set stuffsaved 0 set patchnum 0 set lookingforhead 0 -set localrow -1 +set localirow -1 +set localfrow -1 set lserial 0 setcoords makewindow -- cgit v1.2.3 From ef3192b8345ba73c1d7c86ed0a1f318f26d97dc6 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Sun, 22 Jul 2007 22:05:30 +1000 Subject: gitk: Make the fake commit for the index changes green rather than magenta The magenta was a bit close in color to the normal blue commits. This makes them green instead as suggested by Linus. Signed-off-by: Paul Mackerras --- gitk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gitk') diff --git a/gitk b/gitk index 7ce86b849e..995833fa52 100755 --- a/gitk +++ b/gitk @@ -3403,7 +3403,7 @@ proc drawcmittext {id row col} { if {$id eq $nullid} { set ofill red } elseif {$id eq $nullid2} { - set ofill magenta + set ofill green } else { set ofill [expr {$listed != 0? "blue": "white"}] } -- cgit v1.2.3 From 86da5b6c978be1e64ec42c8b08e815a83f02493e Mon Sep 17 00:00:00 2001 From: Mark Levedahl Date: Tue, 17 Jul 2007 18:42:04 -0400 Subject: [PATCH] gitk: Ignore ctrl-z as EOF on windows Cygwin's Tcl is configured to honor any occurence of ctrl-z as an end-of-file marker, while some commits in the git repository and possibly elsewhere include that character in the commit comment. This causes gitk ignore commit history following such a comment and incorrect graphs. This change affects only Windows as Tcl on other platforms already has eofchar == {}. This fixes problems noted by me and by Ray Lehtiniemi, and the fix was suggested by Shawn Pierce. Signed-off-by: Mark Levedahl Signed-off-by: Paul Mackerras --- gitk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gitk') diff --git a/gitk b/gitk index 995833fa52..d6f62b2a0f 100755 --- a/gitk +++ b/gitk @@ -101,7 +101,7 @@ proc start_rev_list {view} { set commfd($view) $fd set leftover($view) {} set lookingforhead $showlocalchanges - fconfigure $fd -blocking 0 -translation lf + fconfigure $fd -blocking 0 -translation lf -eofchar {} if {$tclencoding != {}} { fconfigure $fd -encoding $tclencoding } -- cgit v1.2.3 From d23d98d3ba21b2a7a1d30be049bfb5d9c0a4e943 Mon Sep 17 00:00:00 2001 From: "Shawn O. Pearce" Date: Thu, 19 Jul 2007 00:37:58 -0400 Subject: [PATCH] gitk: Bind keyboard actions to the command key on Mac OS git-gui already uses the command key for accelerators, but gitk has never done so. I'm actually finding it very hard to move back and forth between the two applications as git-gui is following the Mac OS X conventions and gitk is not. This trick is the same one that git-gui uses to determine which key to bind actions to. Signed-off-by: Shawn O. Pearce Signed-off-by: Paul Mackerras --- gitk | 75 +++++++++++++++++++++++++++++++++++++++----------------------------- 1 file changed, 43 insertions(+), 32 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index d6f62b2a0f..66e4a643d6 100755 --- a/gitk +++ b/gitk @@ -809,6 +809,12 @@ proc makewindow {} { wm geometry . "$geometry(main)" } + if {[tk windowingsystem] eq {aqua}} { + set M1B M1 + } else { + set M1B Control + } + bind .pwbottom {resizecdetpanes %W %w} pack .ctop -fill both -expand 1 bindall <1> {selcanvline %W %x %y} @@ -827,12 +833,12 @@ proc makewindow {} { bindkey "goback" bind . "selnextpage -1" bind . "selnextpage 1" - bind . "allcanvs yview moveto 0.0" - bind . "allcanvs yview moveto 1.0" - bind . "allcanvs yview scroll -1 units" - bind . "allcanvs yview scroll 1 units" - bind . "allcanvs yview scroll -1 pages" - bind . "allcanvs yview scroll 1 pages" + bind . <$M1B-Home> "allcanvs yview moveto 0.0" + bind . <$M1B-End> "allcanvs yview moveto 1.0" + bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units" + bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units" + bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages" + bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages" bindkey "$ctext yview scroll -1 pages" bindkey "$ctext yview scroll -1 pages" bindkey "$ctext yview scroll 1 pages" @@ -852,15 +858,15 @@ proc makewindow {} { bindkey ? findprev bindkey f nextfile bindkey updatecommits - bind . doquit - bind . dofind - bind . {findnext 0} - bind . dosearchback - bind . dosearch - bind . {incrfont 1} - bind . {incrfont 1} - bind . {incrfont -1} - bind . {incrfont -1} + bind . <$M1B-q> doquit + bind . <$M1B-f> dofind + bind . <$M1B-g> {findnext 0} + bind . <$M1B-r> dosearchback + bind . <$M1B-s> dosearch + bind . <$M1B-equal> {incrfont 1} + bind . <$M1B-KP_Add> {incrfont 1} + bind . <$M1B-minus> {incrfont -1} + bind . <$M1B-KP_Subtract> {incrfont -1} wm protocol . WM_DELETE_WINDOW doquit bind . "click %W" bind $fstring dofind @@ -1101,12 +1107,17 @@ proc keys {} { raise $w return } + if {[tk windowingsystem] eq {aqua}} { + set M1T Cmd + } else { + set M1T Ctrl + } toplevel $w wm title $w "Gitk key bindings" - message $w.m -text { + message $w.m -text " Gitk key bindings: - Quit +<$M1T-Q> Quit Move to first commit Move to last commit , p, i Move up one commit @@ -1115,12 +1126,12 @@ Gitk key bindings: , x, l Go forward in history list Move up one page in commit list Move down one page in commit list - Scroll to top of commit list - Scroll to bottom of commit list - Scroll commit list up one line - Scroll commit list down one line - Scroll commit list up one page - Scroll commit list down one page +<$M1T-Home> Scroll to top of commit list +<$M1T-End> Scroll to bottom of commit list +<$M1T-Up> Scroll commit list up one line +<$M1T-Down> Scroll commit list down one line +<$M1T-PageUp> Scroll commit list up one page +<$M1T-PageDown> Scroll commit list down one page Move to previous highlighted line Move to next highlighted line , b Scroll diff view up one page @@ -1128,20 +1139,20 @@ Gitk key bindings: Scroll diff view down one page u Scroll diff view up 18 lines d Scroll diff view down 18 lines - Find - Move to next find hit +<$M1T-F> Find +<$M1T-G> Move to next find hit Move to next find hit / Move to next find hit, or redo find ? Move to previous find hit f Scroll diff view to next file - Search for next hit in diff view - Search for previous hit in diff view - Increase font size - Increase font size - Decrease font size - Decrease font size +<$M1T-S> Search for next hit in diff view +<$M1T-R> Search for previous hit in diff view +<$M1T-KP+> Increase font size +<$M1T-plus> Increase font size +<$M1T-KP-> Decrease font size +<$M1T-minus> Decrease font size Update -} \ +" \ -justify left -bg white -border 2 -relief groove pack $w.m -side top -fill both -padx 2 -pady 2 $w.m configure -font $uifont -- cgit v1.2.3 From 0eafba1405bf4db29bca0b535477beb3046441bf Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Mon, 23 Jul 2007 21:35:03 +1000 Subject: gitk: Wait for the window to become visible after creating it When the git log process returned an error immediately, we were sometimes getting no main window and no error window displayed, with the gitk process just hanging waiting for something. It appears that the tkwait in show_error, which waits for the error window to be destroyed, wasn't sufficient to allow the main window or the error window to be mapped. This adds a wait in the main startup code after the main window has been created to wait until it is visible. This seems to fix the problem. Signed-off-by: Paul Mackerras --- gitk | 2 ++ 1 file changed, 2 insertions(+) (limited to 'gitk') diff --git a/gitk b/gitk index 66e4a643d6..5cfb1cc391 100755 --- a/gitk +++ b/gitk @@ -7646,6 +7646,8 @@ set localfrow -1 set lserial 0 setcoords makewindow +# wait for the window to become visible +tkwait visibility . wm title . "[file tail $argv0]: [file tail [pwd]]" readrefs -- cgit v1.2.3 From 005a2f4e6df7060561817828d4fa4245f87ccadf Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Thu, 26 Jul 2007 22:36:39 +1000 Subject: gitk: Fix bugs in the Find function This fixes the problem reported by Brian Downing where searching for a string that doesn't exist would give a Tcl error. The basic problem was that we weren't reading the data for the last commit since it wasn't terminated with a null. This effectively adds a null on the end (if there isn't one already) to make sure we process the last commit. This also makes the yellow background behind instances of the search string appear more consistently, and fixes a bug where the "/" key would just find the same commit again and again instead of advancing. Signed-off-by: Paul Mackerras --- gitk | 88 +++++++++++++++++++++++++++++++++++++++++--------------------------- 1 file changed, 53 insertions(+), 35 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 5cfb1cc391..f74ce51379 100755 --- a/gitk +++ b/gitk @@ -139,6 +139,10 @@ proc getcommitlines {fd view} { global vparentlist vdisporder vcmitlisted set stuff [read $fd 500000] + # git log doesn't terminate the last commit with a null... + if {$stuff == {} && $leftover($view) ne {} && [eof $fd]} { + set stuff "\0" + } if {$stuff == {}} { if {![eof $fd]} { return 1 @@ -2157,7 +2161,7 @@ proc readfhighlight {} { proc find_change {name ix op} { global nhighlights mainfont boldnamerows - global findstring findpattern findtype markingmatches + global findstring findpattern findtype # delete previous highlights, if any foreach row $boldnamerows { @@ -2172,7 +2176,6 @@ proc find_change {name ix op} { $findstring] set findpattern "*$e*" } - set markingmatches [expr {$findstring ne {}}] drawvisible } @@ -2218,26 +2221,32 @@ proc askfindhighlight {row id} { } } if {$markingmatches} { - markrowmatches $row [lindex $info 0] [lindex $info 1] + markrowmatches $row $id } } set nhighlights($row) $isbold } -proc markrowmatches {row headline author} { - global canv canv2 linehtag linentag +proc markrowmatches {row id} { + global canv canv2 linehtag linentag commitinfo findloc + set headline [lindex $commitinfo($id) 0] + set author [lindex $commitinfo($id) 1] $canv delete match$row $canv2 delete match$row - set m [findmatches $headline] - if {$m ne {}} { - markmatches $canv $row $headline $linehtag($row) $m \ - [$canv itemcget $linehtag($row) -font] + if {$findloc eq "All fields" || $findloc eq "Headline"} { + set m [findmatches $headline] + if {$m ne {}} { + markmatches $canv $row $headline $linehtag($row) $m \ + [$canv itemcget $linehtag($row) -font] $row + } } - set m [findmatches $author] - if {$m ne {}} { - markmatches $canv2 $row $author $linentag($row) $m \ - [$canv2 itemcget $linentag($row) -font] + if {$findloc eq "All fields" || $findloc eq "Author"} { + set m [findmatches $author] + if {$m ne {}} { + markmatches $canv2 $row $author $linentag($row) $m \ + [$canv2 itemcget $linentag($row) -font] $row + } } } @@ -3406,7 +3415,7 @@ proc drawcmittext {id row col} { global linespc canv canv2 canv3 canvy0 fgcolor curview global commitlisted commitinfo rowidlist parentlist global rowtextx idpos idtags idheads idotherrefs - global linehtag linentag linedtag markingmatches + global linehtag linentag linedtag global mainfont canvxmax boldrows boldnamerows fgcolor nullid nullid2 # listed is 0 for boundary, 1 for normal, 2 for left, 3 for right @@ -3483,9 +3492,6 @@ proc drawcmittext {id row col} { 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 {$markingmatches} { - markrowmatches $row $headline $name - } if {$xr > $canvxmax} { set canvxmax $xr setcanvscroll @@ -3494,7 +3500,7 @@ proc drawcmittext {id row col} { proc drawcmitrow {row} { global displayorder rowidlist - global iddrawn + global iddrawn markingmatches global commitinfo parentlist numcommits global filehighlight fhighlights findstring nhighlights global hlview vhighlights @@ -3515,18 +3521,22 @@ proc drawcmitrow {row} { if {$highlight_related ne "None" && ![info exists rhighlights($row)]} { askrelhighlight $row $id } - if {[info exists iddrawn($id)]} return - set col [lsearch -exact [lindex $rowidlist $row] $id] - if {$col < 0} { - puts "oops, row $row id $id not in list" - return + if {![info exists iddrawn($id)]} { + set col [lsearch -exact [lindex $rowidlist $row] $id] + if {$col < 0} { + puts "oops, row $row id $id not in list" + return + } + if {![info exists commitinfo($id)]} { + getcommit $id + } + assigncolor $id + drawcmittext $id $row $col + set iddrawn($id) 1 } - if {![info exists commitinfo($id)]} { - getcommit $id + if {$markingmatches} { + markrowmatches $row $id } - assigncolor $id - drawcmittext $id $row $col - set iddrawn($id) 1 } proc drawcommits {row {endrow {}}} { @@ -4044,7 +4054,6 @@ proc dofind {{rev 0}} { if {!$rev} { run findmore } else { - set findcurline $findstartline if {$findcurline == 0} { set findcurline $numcommits } @@ -4079,7 +4088,7 @@ proc findprev {} { proc findmore {} { global commitdata commitinfo numcommits findstring findpattern findloc - global findstartline findcurline markingmatches displayorder + global findstartline findcurline displayorder set fldtypes {Headline Author Date Committer CDate Comments} set l [expr {$findcurline + 1}] @@ -4097,6 +4106,8 @@ proc findmore {} { set last 0 for {} {$l < $lim} {incr l} { set id [lindex $displayorder $l] + # shouldn't happen unless git log doesn't give all the commits... + if {![info exists commitdata($id)]} continue if {![doesmatch $commitdata($id)]} continue if {![info exists commitinfo($id)]} { getcommit $id @@ -4105,7 +4116,6 @@ proc findmore {} { foreach f $info ty $fldtypes { if {($findloc eq "All fields" || $findloc eq $ty) && [doesmatch $f]} { - set markingmatches 1 findselectline $l notbusy finding return 0 @@ -4124,7 +4134,7 @@ proc findmore {} { proc findmorerev {} { global commitdata commitinfo numcommits findstring findpattern findloc - global findstartline findcurline markingmatches displayorder + global findstartline findcurline displayorder set fldtypes {Headline Author Date Committer CDate Comments} set l $findcurline @@ -4151,7 +4161,6 @@ proc findmorerev {} { foreach f $info ty $fldtypes { if {($findloc eq "All fields" || $findloc eq $ty) && [doesmatch $f]} { - set markingmatches 1 findselectline $l notbusy finding return 0 @@ -4169,7 +4178,10 @@ proc findmorerev {} { } proc findselectline {l} { - global findloc commentend ctext + global findloc commentend ctext findcurline markingmatches + + set markingmatches 1 + set findcurline $l selectline $l 1 if {$findloc == "All fields" || $findloc == "Comments"} { # highlight the matches in the comments @@ -4181,10 +4193,13 @@ proc findselectline {l} { $ctext tag add found "1.0 + $start c" "1.0 + $end c" } } + drawvisible } # mark the bits of a headline or author that match a find string -proc markmatches {canv l str tag matches font} { +proc markmatches {canv l str tag matches font row} { + global selectedline + set bbox [$canv bbox $tag] set x0 [lindex $bbox 0] set y0 [lindex $bbox 1] @@ -4199,6 +4214,9 @@ proc markmatches {canv l str tag matches font} { [expr {$x0+$xlen+2}] $y1 \ -outline {} -tags [list match$l matches] -fill yellow] $canv lower $t + if {[info exists selectedline] && $row == $selectedline} { + $canv raise $t secsel + } } } -- cgit v1.2.3 From 3244729aac7515ccda651d40f41cef94517ac089 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Fri, 27 Jul 2007 22:30:15 +1000 Subject: gitk: Add a context menu for file list entries At the moment this just has two entries, which allow you to add the file that you clicked on to the list of filenames to highlight, or replace the list with the file. Signed-off-by: Paul Mackerras --- gitk | 36 ++++++++++++++++++++++++++++++++++++ 1 file changed, 36 insertions(+) (limited to 'gitk') diff --git a/gitk b/gitk index f74ce51379..6c2be3b727 100755 --- a/gitk +++ b/gitk @@ -879,6 +879,7 @@ proc makewindow {} { bind $cflist <1> {sel_flist %W %x %y; break} bind $cflist {sel_flist %W %x %y; break} bind $cflist {treeclick %W %x %y} + bind $cflist {pop_flist_menu %W %X %Y %x %y} set maincursor [. cget -cursor] set textcursor [$ctext cget -cursor] @@ -916,6 +917,14 @@ proc makewindow {} { -command cobranch $headctxmenu add command -label "Remove this branch" \ -command rmbranch + + global flist_menu + set flist_menu .flistctxmenu + menu $flist_menu -tearoff 0 + $flist_menu add command -label "Highlight this too" \ + -command {flist_hl 0} + $flist_menu add command -label "Highlight this only" \ + -command {flist_hl 1} } # mouse-2 makes all windows scan vertically, but only the one @@ -1499,6 +1508,33 @@ proc sel_flist {w x y} { } } +proc pop_flist_menu {w X Y x y} { + global ctext cflist cmitmode flist_menu flist_menu_file + global treediffs diffids + + set l [lindex [split [$w index "@$x,$y"] "."] 0] + if {$l <= 1} return + if {$cmitmode eq "tree"} { + set e [linetoelt $l] + if {[string index $e end] eq "/"} return + } else { + set e [lindex $treediffs($diffids) [expr {$l-2}]] + } + set flist_menu_file $e + tk_popup $flist_menu $X $Y +} + +proc flist_hl {only} { + global flist_menu_file highlight_files + + set x [shellquote $flist_menu_file] + if {$only || $highlight_files eq {}} { + set highlight_files $x + } else { + append highlight_files " " $x + } +} + # Functions for adding and removing shell-type quoting proc shellquote {str} { -- cgit v1.2.3 From 6e8c87070306a757c4d7fd2c55cca3a90fe140c7 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Tue, 31 Jul 2007 21:03:06 +1000 Subject: gitk: Establish and use global left-to-right ordering for commits This creates an "ordering token" for each commit which establishes a total ordering for commits and is used to order the commits from left to right on a row. The ordering token is assigned when a commit is first encountered or when it is first listed as a parent of some other commit, whichever comes first. The ordering token is a string of variable length. Parents that don't already have an ordering token are assigned one by appending to the child's token; the first parent gets a "0" on the end, the second "1" and so on. As an optimization, the "0" isn't appended if the child only has one parent. When inserting a new commit into an element of rowidlist, it is inserted in the position which makes the ordering tokens increase from left to right. This also simplifies the layout code by getting rid of the rowoffsets variable, and terminates lines with an arrow after 5 rows if the line would be longer than about 110 rows (rather than letting them go on and terminating them later with an arrow if the graph gets too wide). The effect of having the total ordering, and terminating the lines early, is that it will be possible to lay out only a part of the graph rather than having to do the whole thing top to bottom. Signed-off-by: Paul Mackerras --- gitk | 353 ++++++++++++++++++++++++++++--------------------------------------- 1 file changed, 149 insertions(+), 204 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 6c2be3b727..40e5d31749 100755 --- a/gitk +++ b/gitk @@ -82,11 +82,12 @@ proc dorunq {} { proc start_rev_list {view} { global startmsecs global commfd leftover tclencoding datemode - global viewargs viewfiles commitidx + global viewargs viewfiles commitidx vnextroot global lookingforhead showlocalchanges set startmsecs [clock clicks -milliseconds] set commitidx($view) 0 + set vnextroot($view) 0 set order "--topo-order" if {$datemode} { set order "--date-order" @@ -131,12 +132,26 @@ proc getcommits {} { show_status "Reading commits..." } +# This makes a string representation of a positive integer which +# sorts as a string in numerical order +proc strrep {n} { + if {$n < 16} { + return [format "%x" $n] + } elseif {$n < 256} { + return [format "x%.2x" $n] + } elseif {$n < 65536} { + return [format "y%.4x" $n] + } + return [format "z%.8x" $n] +} + proc getcommitlines {fd view} { global commitlisted global leftover commfd global displayorder commitidx commitrow commitdata global parentlist children curview hlview global vparentlist vdisporder vcmitlisted + global ordertok vnextroot set stuff [read $fd 500000] # git log doesn't terminate the last commit with a null... @@ -221,14 +236,32 @@ proc getcommitlines {fd view} { exit 1 } set id [lindex $ids 0] + if {![info exists ordertok($view,$id)]} { + set otok "o[strrep $vnextroot($view)]" + incr vnextroot($view) + set ordertok($view,$id) $otok + } else { + set otok $ordertok($view,$id) + } if {$listed} { set olds [lrange $ids 1 end] - set i 0 - foreach p $olds { - if {$i == 0 || [lsearch -exact $olds $p] >= $i} { - lappend children($view,$p) $id + if {[llength $olds] == 1} { + set p [lindex $olds 0] + lappend children($view,$p) $id + if {![info exists ordertok($view,$p)]} { + set ordertok($view,$p) $ordertok($view,$id) + } + } else { + set i 0 + foreach p $olds { + if {$i == 0 || [lsearch -exact $olds $p] >= $i} { + lappend children($view,$p) $id + } + if {![info exists ordertok($view,$p)]} { + set ordertok($view,$p) "$otok[strrep $i]]" + } + incr i } - incr i } } else { set olds {} @@ -1821,7 +1854,7 @@ proc unflatten {var l} { proc showview {n} { global curview viewdata viewfiles - global displayorder parentlist rowidlist rowoffsets + global displayorder parentlist rowidlist global colormap rowtextx commitrow nextcolor canvxmax global numcommits rowrangelist commitlisted idrowranges rowchk global selectedline currentid canv canvy0 @@ -1859,13 +1892,13 @@ proc showview {n} { set vcmitlisted($curview) $commitlisted if {$phase ne {}} { set viewdata($curview) \ - [list $phase $rowidlist $rowoffsets $rowrangelist \ + [list $phase $rowidlist {} $rowrangelist \ [flatten idrowranges] [flatten idinlist] \ $rowlaidout $rowoptim $numcommits] } elseif {![info exists viewdata($curview)] || [lindex $viewdata($curview) 0] ne {}} { set viewdata($curview) \ - [list {} $rowidlist $rowoffsets $rowrangelist] + [list {} $rowidlist {} $rowrangelist] } } catch {unset treediffs} @@ -1894,7 +1927,6 @@ proc showview {n} { set parentlist $vparentlist($n) set commitlisted $vcmitlisted($n) set rowidlist [lindex $v 1] - set rowoffsets [lindex $v 2] set rowrangelist [lindex $v 3] if {$phase eq {}} { set numcommits [llength $displayorder] @@ -2542,67 +2574,43 @@ proc usedinrange {id l1 l2} { return 0 } -proc sanity {row {full 0}} { - global rowidlist rowoffsets +# Work out where id should go in idlist so that order-token +# values increase from left to right +proc idcol {idlist id {i 0}} { + global ordertok curview - set col -1 - set ids [lindex $rowidlist $row] - foreach id $ids { - incr col - if {$id eq {}} continue - if {$col < [llength $ids] - 1 && - [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} { - puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}" - } - set o [lindex $rowoffsets $row $col] - set y $row - set x $col - while {$o ne {}} { - incr y -1 - incr x $o - if {[lindex $rowidlist $y $x] != $id} { - puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]" - puts " id=[shortids $id] check started at row $row" - for {set i $row} {$i >= $y} {incr i -1} { - puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}" - } - break - } - if {!$full} break - set o [lindex $rowoffsets $y $x] + set t $ordertok($curview,$id) + if {$i >= [llength $idlist] || + $t < $ordertok($curview,[lindex $idlist $i])} { + if {$i > [llength $idlist]} { + set i [llength $idlist] + } + while {[incr i -1] >= 0 && + $t < $ordertok($curview,[lindex $idlist $i])} {} + incr i + } else { + if {$t > $ordertok($curview,[lindex $idlist $i])} { + while {[incr i] < [llength $idlist] && + $t >= $ordertok($curview,[lindex $idlist $i])} {} } } + return $i } -proc makeuparrow {oid x y z} { - global rowidlist rowoffsets uparrowlen idrowranges displayorder +proc makeuparrow {oid y x} { + global rowidlist uparrowlen idrowranges displayorder for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} { incr y -1 - incr x $z - set off0 [lindex $rowoffsets $y] - for {set x0 $x} {1} {incr x0} { - if {$x0 >= [llength $off0]} { - set x0 [llength [lindex $rowoffsets [expr {$y-1}]]] - break - } - set z [lindex $off0 $x0] - if {$z ne {}} { - incr x0 $z - break - } - } - set z [expr {$x0 - $x}] - lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid] - lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z] + set idl [lindex $rowidlist $y] + set x [idcol $idl $oid $x] + lset rowidlist $y [linsert $idl $x $oid] } - set tmp [lreplace [lindex $rowoffsets $y] $x $x {}] - lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1] lappend idrowranges($oid) [lindex $displayorder $y] } proc initlayout {} { - global rowidlist rowoffsets displayorder commitlisted + global rowidlist displayorder commitlisted global rowlaidout rowoptim global idinlist rowchk rowrangelist idrowranges global numcommits canvxmax canv @@ -2618,7 +2626,6 @@ proc initlayout {} { set rowrangelist {} set nextcolor 0 set rowidlist {{}} - set rowoffsets {{}} catch {unset idinlist} catch {unset rowchk} set rowlaidout 0 @@ -2679,8 +2686,8 @@ proc layoutmore {tmax allread} { set nr [expr {$commitidx($curview) - $rowlaidout}] # may need to increase this threshold if uparrowlen or # mingaplen are increased... - if {$nr > 150} { - set nr 150 + if {$nr > 200} { + set nr 200 } set row $rowlaidout set rowlaidout [layoutrows $row [expr {$row + $nr}] $allread] @@ -2861,7 +2868,7 @@ proc readdifffiles {fd serial} { } proc layoutrows {row endrow last} { - global rowidlist rowoffsets displayorder + global rowidlist displayorder global uparrowlen downarrowlen maxwidth mingaplen global children parentlist global idrowranges @@ -2869,12 +2876,12 @@ proc layoutrows {row endrow last} { global idinlist rowchk rowrangelist set idlist [lindex $rowidlist $row] - set offs [lindex $rowoffsets $row] while {$row < $endrow} { set id [lindex $displayorder $row] set oldolds {} set newolds {} - foreach p [lindex $parentlist $row] { + set olds [lindex $parentlist $row] + foreach p $olds { if {![info exists idinlist($p)]} { lappend newolds $p } elseif {!$idinlist($p)} { @@ -2883,7 +2890,7 @@ proc layoutrows {row endrow last} { } set nev [expr {[llength $idlist] + [llength $newolds] + [llength $oldolds] - $maxwidth + 1}] - if {$nev > 0} { + if {1 || $nev > 0} { if {!$last && $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break for {set x [llength $idlist]} {[incr x -1] >= 0} {} { @@ -2893,34 +2900,25 @@ proc layoutrows {row endrow last} { [expr {$row + $uparrowlen + $mingaplen}]] if {$r == 0} { set idlist [lreplace $idlist $x $x] - set offs [lreplace $offs $x $x] - set offs [incrange $offs $x 1] set idinlist($i) 0 set rm1 [expr {$row - 1}] lappend idrowranges($i) [lindex $displayorder $rm1] - if {[incr nev -1] <= 0} break + #if {[incr nev -1] <= 0} break continue } set rowchk($id) [expr {$row + $r}] } } lset rowidlist $row $idlist - lset rowoffsets $row $offs } set col [lsearch -exact $idlist $id] if {$col < 0} { - set col [llength $idlist] - lappend idlist $id + set col [idcol $idlist $id] + set idlist [linsert $idlist $col $id] lset rowidlist $row $idlist - set z {} if {$children($curview,$id) ne {}} { - set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}] unset idinlist($id) - } - lappend offs $z - lset rowoffsets $row $offs - if {$z ne {}} { - makeuparrow $id $col $row $z + makeuparrow $id $row $col } } else { unset idinlist($id) @@ -2933,38 +2931,21 @@ proc layoutrows {row endrow last} { } lappend rowrangelist $ranges incr row - set offs [ntimes [llength $idlist] 0] - set l [llength $newolds] - set idlist [eval lreplace \$idlist $col $col $newolds] - set o 0 - if {$l != 1} { - set offs [lrange $offs 0 [expr {$col - 1}]] - foreach x $newolds { - lappend offs {} - incr o -1 - } - incr o - set tmp [expr {[llength $idlist] - [llength $offs]}] - if {$tmp > 0} { - set offs [concat $offs [ntimes $tmp $o]] - } - } else { - lset offs $col {} - } + set idlist [lreplace $idlist $col $col] + set x $col foreach i $newolds { + set x [idcol $idlist $i $x] + set idlist [linsert $idlist $x $i] set idinlist($i) 1 set idrowranges($i) $id } - incr col $l foreach oid $oldolds { set idinlist($oid) 1 - set idlist [linsert $idlist $col $oid] - set offs [linsert $offs $col $o] - makeuparrow $oid $col $row $o - incr col + set x [idcol $idlist $oid $x] + set idlist [linsert $idlist $x $oid] + makeuparrow $oid $row $x } lappend rowidlist $idlist - lappend rowoffsets $offs } return $row } @@ -2989,7 +2970,7 @@ proc addextraid {id row} { } proc layouttail {} { - global rowidlist rowoffsets idinlist commitidx curview + global rowidlist idinlist commitidx curview global idrowranges rowrangelist set row $commitidx($curview) @@ -3003,56 +2984,70 @@ proc layouttail {} { lappend rowrangelist $idrowranges($id) unset idrowranges($id) incr row - set offs [ntimes $col 0] set idlist [lreplace $idlist $col $col] lappend rowidlist $idlist - lappend rowoffsets $offs } foreach id [array names idinlist] { unset idinlist($id) addextraid $id $row lset rowidlist $row [list $id] - lset rowoffsets $row 0 - makeuparrow $id 0 $row 0 + makeuparrow $id $row 0 lappend idrowranges($id) $id lappend rowrangelist $idrowranges($id) unset idrowranges($id) incr row lappend rowidlist {} - lappend rowoffsets {} } } proc insert_pad {row col npad} { - global rowidlist rowoffsets + global rowidlist set pad [ntimes $npad {}] lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad] - set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad] - lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]] } proc optimize_rows {row col endrow} { - global rowidlist rowoffsets displayorder + global rowidlist displayorder + if {$row < 1} { + set row 1 + } + set idlist [lindex $rowidlist [expr {$row - 1}]] + if {$row >= 2} { + set previdlist [lindex $rowidlist [expr {$row - 2}]] + } else { + set previdlist {} + } for {} {$row < $endrow} {incr row} { + set pprevidlist $previdlist + set previdlist $idlist set idlist [lindex $rowidlist $row] - set offs [lindex $rowoffsets $row] set haspad 0 - for {} {$col < [llength $offs]} {incr col} { - if {[lindex $idlist $col] eq {}} { + set y0 [expr {$row - 1}] + set ym [expr {$row - 2}] + set x0 -1 + set xm -1 + for {} {$col < [llength $idlist]} {incr col} { + set id [lindex $idlist $col] + if {[lindex $previdlist $col] eq $id} continue + if {$id eq {}} { set haspad 1 continue } - set z [lindex $offs $col] - if {$z eq {}} continue + set x0 [lsearch -exact $previdlist $id] + if {$x0 < 0} continue + set z [expr {$x0 - $col}] set isarrow 0 - set x0 [expr {$col + $z}] - set y0 [expr {$row - 1}] - set z0 [lindex $rowoffsets $y0 $x0] + set z0 {} + if {$ym >= 0} { + set xm [lsearch -exact $pprevidlist $id] + if {$xm >= 0} { + set z0 [expr {$xm - $x0}] + } + } if {$z0 eq {}} { - set id [lindex $idlist $col] set ranges [rowranges $id] if {$ranges ne {} && $y0 > [lindex $ranges 0]} { set isarrow 1 @@ -3066,43 +3061,32 @@ proc optimize_rows {row col endrow} { # Line currently goes left too much; # insert pads in the previous row, then optimize it set npad [expr {-1 - $z + $isarrow}] - set offs [incrange $offs $col $npad] insert_pad $y0 $x0 $npad if {$y0 > 0} { optimize_rows $y0 $x0 $row } - set z [lindex $offs $col] - set x0 [expr {$col + $z}] - set z0 [lindex $rowoffsets $y0 $x0] + set previdlist [lindex $rowidlist $y0] + set x0 [lsearch -exact $previdlist $id] + set z [expr {$x0 - $col}] + if {$z0 ne {}} { + set pprevidlist [lindex $rowidlist $ym] + set xm [lsearch -exact $pprevidlist $id] + set z0 [expr {$xm - $x0}] + } } elseif {$z > 1 || ($z > 0 && $isarrow)} { # Line currently goes right too much; - # insert pads in this line and adjust the next's rowoffsets + # insert pads in this line set npad [expr {$z - 1 + $isarrow}] - set y1 [expr {$row + 1}] - set offs2 [lindex $rowoffsets $y1] - set x1 -1 - foreach z $offs2 { - incr x1 - if {$z eq {} || $x1 + $z < $col} continue - if {$x1 + $z > $col} { - incr npad - } - lset rowoffsets $y1 [incrange $offs2 $x1 $npad] - break - } set pad [ntimes $npad {}] set idlist [eval linsert \$idlist $col $pad] - set tmp [eval linsert \$offs $col $pad] incr col $npad - set offs [incrange $tmp $col [expr {-$npad}]] - set z [lindex $offs $col] + set z [expr {$x0 - $col}] set haspad 1 } - if {$z0 eq {} && !$isarrow} { + if {$z0 eq {} && !$isarrow && $ym >= 0} { # this line links to its first child on row $row-2 - set rm2 [expr {$row - 2}] - set id [lindex $displayorder $rm2] - set xc [lsearch -exact [lindex $rowidlist $rm2] $id] + set id [lindex $displayorder $ym] + set xc [lsearch -exact $pprevidlist $id] if {$xc >= 0} { set z0 [expr {$xc - $x0}] } @@ -3110,51 +3094,36 @@ proc optimize_rows {row col endrow} { # avoid lines jigging left then immediately right if {$z0 ne {} && $z < 0 && $z0 > 0} { insert_pad $y0 $x0 1 - set offs [incrange $offs $col 1] - optimize_rows $y0 [expr {$x0 + 1}] $row + incr x0 + optimize_rows $y0 $x0 $row + set previdlist [lindex $rowidlist $y0] + set pprevidlist [lindex $rowidlist $ym] } } if {!$haspad} { - set o {} # Find the first column that doesn't have a line going right for {set col [llength $idlist]} {[incr col -1] >= 0} {} { - set o [lindex $offs $col] - if {$o eq {}} { + set id [lindex $idlist $col] + if {$id eq {}} break + set x0 [lsearch -exact $previdlist $id] + if {$x0 < 0} { # check if this is the link to the first child - set id [lindex $idlist $col] set ranges [rowranges $id] if {$ranges ne {} && $row == [lindex $ranges 0]} { # it is, work out offset to child - set y0 [expr {$row - 1}] set id [lindex $displayorder $y0] - set x0 [lsearch -exact [lindex $rowidlist $y0] $id] - if {$x0 >= 0} { - set o [expr {$x0 - $col}] - } + set x0 [lsearch -exact $previdlist $id] } } - if {$o eq {} || $o <= 0} break + if {$x0 <= $col} break } # Insert a pad at that column as long as it has a line and - # isn't the last column, and adjust the next row' offsets - if {$o ne {} && [incr col] < [llength $idlist]} { - set y1 [expr {$row + 1}] - set offs2 [lindex $rowoffsets $y1] - set x1 -1 - foreach z $offs2 { - incr x1 - if {$z eq {} || $x1 + $z < $col} continue - lset rowoffsets $y1 [incrange $offs2 $x1 1] - break - } + # isn't the last column + if {$x0 >= 0 && [incr col] < [llength $idlist]} { set idlist [linsert $idlist $col {}] - set tmp [linsert $offs $col {}] - incr col - set offs [incrange $tmp $col -1] } } lset rowidlist $row $idlist - lset rowoffsets $row $offs set col 0 } } @@ -3669,7 +3638,7 @@ proc clear_display {} { } proc findcrossings {id} { - global rowidlist parentlist numcommits rowoffsets displayorder + global rowidlist parentlist numcommits displayorder set cross {} set ccross {} @@ -3678,12 +3647,9 @@ proc findcrossings {id} { 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 x [lsearch -exact [lindex $rowidlist $row] $id] + if {$x < 0} break set olds [lindex $parentlist $row] set kid [lindex $displayorder $row] set kidx [lsearch -exact [lindex $rowidlist $row] $kid] @@ -3701,9 +3667,6 @@ proc findcrossings {id} { } } } - set inc [lindex $rowoffsets $row $x] - if {$inc eq {}} break - incr x $inc } } return [concat $ccross {{}} $cross] @@ -3893,7 +3856,7 @@ proc show_status {msg} { # on that row and below will move down one row. proc insertrow {row newcmit} { global displayorder parentlist commitlisted children - global commitrow curview rowidlist rowoffsets numcommits + global commitrow curview rowidlist numcommits global rowrangelist rowlaidout rowoptim numcommits global selectedline rowchk commitidx @@ -3917,26 +3880,14 @@ proc insertrow {row newcmit} { incr commitidx($curview) 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 {}] if {[llength $kids] > 1} { @@ -3965,7 +3916,7 @@ proc insertrow {row newcmit} { # Remove a commit that was inserted with insertrow on row $row. proc removerow {row} { global displayorder parentlist commitlisted children - global commitrow curview rowidlist rowoffsets numcommits + global commitrow curview rowidlist numcommits global rowrangelist idrowranges rowlaidout rowoptim numcommits global linesegends selectedline rowchk commitidx @@ -3993,12 +3944,6 @@ proc removerow {row} { incr commitidx($curview) -1 set rowidlist [lreplace $rowidlist $row $row] - set rowoffsets [lreplace $rowoffsets $rp1 $rp1] - if {$kids ne {}} { - set offs [lindex $rowoffsets $row] - set offs [lreplace $offs end end] - lset rowoffsets $row $offs - } set rowrangelist [lreplace $rowrangelist $row $row] if {[llength $kids] > 0} { @@ -7590,9 +7535,9 @@ set maxgraphpct 50 set maxwidth 16 set revlistorder 0 set fastdate 0 -set uparrowlen 7 -set downarrowlen 7 -set mingaplen 30 +set uparrowlen 5 +set downarrowlen 5 +set mingaplen 100 set cmitmode "patch" set wrapcomment "none" set showneartags 1 -- cgit v1.2.3 From 513a54dc212044596d932dcc9468e0774c1ee2c1 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Wed, 1 Aug 2007 22:27:57 +1000 Subject: gitk: Improve the drawing of links to parent lines The way gitk used to draw the lines joining a commit to the lines representing its parents was sometimes visually ambiguous, especially when the line to the parent had a corner that coincided with a corner on another line. This improves things by using a smaller slanting section on the line joining a commit to a parent line if the parent line is vertical where it joins on. It also optimizes the drawing a little in the case where the parent line slants towards this commit already. Signed-off-by: Paul Mackerras --- gitk | 34 +++++++++++++++++++++++++++------- 1 file changed, 27 insertions(+), 7 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 40e5d31749..bc3022e69f 100755 --- a/gitk +++ b/gitk @@ -3363,7 +3363,7 @@ proc drawlineseg {id row endrow arrowlow} { proc drawparentlinks {id row} { global rowidlist canv colormap curview parentlist - global idpos + global idpos linespc set rowids [lindex $rowidlist $row] set col [lsearch -exact $rowids $id] @@ -3373,6 +3373,8 @@ proc drawparentlinks {id row} { set x [xc $row $col] set y [yc $row] set y2 [yc $row2] + set d [expr {int(0.4 * $linespc)}] + set ymid [expr {$y + $d}] set ids [lindex $rowidlist $row2] # rmx = right-most X coord used set rmx 0 @@ -3386,19 +3388,37 @@ proc drawparentlinks {id row} { if {$x2 > $rmx} { set rmx $x2 } - if {[lsearch -exact $rowids $p] < 0} { + set j [lsearch -exact $rowids $p] + if {$j < 0} { # drawlineseg will do this one for us continue } assigncolor $p # should handle duplicated parents here... set coords [list $x $y] - if {$i < $col - 1} { - lappend coords [xc $row [expr {$i + 1}]] $y - } elseif {$i > $col + 1} { - lappend coords [xc $row [expr {$i - 1}]] $y + if {$i != $col} { + # if attaching to a vertical segment, draw a smaller + # slant for visual distinctness + if {$i == $j} { + if {$i < $col} { + lappend coords [expr {$x2 + $d}] $y $x2 $ymid + } else { + lappend coords [expr {$x2 - $d}] $y $x2 $ymid + } + } elseif {$i < $col && $i < $j} { + # segment slants towards us already + lappend coords [xc $row $j] $y + } else { + if {$i < $col - 1} { + lappend coords [expr {$x2 + $linespc}] $y + } elseif {$i > $col + 1} { + lappend coords [expr {$x2 - $linespc}] $y + } + lappend coords $x2 $y2 + } + } else { + lappend coords $x2 $y2 } - lappend coords $x2 $y2 set t [$canv create line $coords -width [linewidth $p] \ -fill $colormap($p) -tags lines.$p] $canv lower $t -- cgit v1.2.3 From e341c06d8140b689001ddc183ec3476c1ede264a Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Sun, 12 Aug 2007 12:42:57 +1000 Subject: gitk: Eliminate diagonal arrows This changes the optimizer to insert pads to straighten downward pointing arrows so they point straight down. When drawing the parent link to the first child in drawlineseg, this draws it with 3 segments like other parent links if it is only one row high with an arrow. These two things mean we can dispense with the workarounds for arrows on diagonal segments. This also fixes a couple of other minor bugs. Signed-off-by: Paul Mackerras --- gitk | 87 ++++++++++++++++++++++++++++---------------------------------------- 1 file changed, 36 insertions(+), 51 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index bc3022e69f..7b62e98ec1 100755 --- a/gitk +++ b/gitk @@ -2600,7 +2600,7 @@ proc idcol {idlist id {i 0}} { proc makeuparrow {oid y x} { global rowidlist uparrowlen idrowranges displayorder - for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} { + for {set i 0} {$i < $uparrowlen && $y > 1} {incr i} { incr y -1 set idl [lindex $rowidlist $y] set x [idcol $idl $oid $x] @@ -3005,7 +3005,14 @@ proc insert_pad {row col npad} { global rowidlist set pad [ntimes $npad {}] - lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad] + set idlist [lindex $rowidlist $row] + set bef [lrange $idlist 0 [expr {$col - 1}]] + set aft [lrange $idlist $col end] + set i [lsearch -exact $aft {}] + if {$i > 0} { + set aft [lreplace $aft $i $i] + } + lset rowidlist $row [concat $bef $pad $aft] } proc optimize_rows {row col endrow} { @@ -3053,6 +3060,10 @@ proc optimize_rows {row col endrow} { set isarrow 1 } } + if {!$isarrow && $id ne [lindex $displayorder $row] && + [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} { + set isarrow 1 + } # Looking at lines from this row to the previous row, # make them go straight up if they end in an arrow on # the previous row; otherwise make them go straight up @@ -3077,8 +3088,8 @@ proc optimize_rows {row col endrow} { # Line currently goes right too much; # insert pads in this line set npad [expr {$z - 1 + $isarrow}] - set pad [ntimes $npad {}] - set idlist [eval linsert \$idlist $col $pad] + insert_pad $row $col $npad + set idlist [lindex $rowidlist $row] incr col $npad set z [expr {$x0 - $col}] set haspad 1 @@ -3169,31 +3180,9 @@ proc rowranges {id} { return $linenos } -# work around tk8.4 refusal to draw arrows on diagonal segments -proc adjarrowhigh {coords} { - global linespc - - set x0 [lindex $coords 0] - set x1 [lindex $coords 2] - if {$x0 != $x1} { - set y0 [lindex $coords 1] - set y1 [lindex $coords 3] - if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} { - # we have a nearby vertical segment, just trim off the diag bit - set coords [lrange $coords 2 end] - } else { - set slope [expr {($x0 - $x1) / ($y0 - $y1)}] - set xi [expr {$x0 - $slope * $linespc / 2}] - set yi [expr {$y0 - $linespc / 2}] - set coords [lreplace $coords 0 1 $xi $y0 $xi $yi] - } - } - return $coords -} - proc drawlineseg {id row endrow arrowlow} { global rowidlist displayorder iddrawn linesegs - global canv colormap linespc curview maxlinelen + global canv colormap linespc curview maxlinelen parentlist set cols [list [lsearch -exact [lindex $rowidlist $row] $id]] set le [expr {$row + 1}] @@ -3268,9 +3257,11 @@ proc drawlineseg {id row endrow arrowlow} { set itl [lindex $lines [expr {$i-1}] 2] set al [$canv itemcget $itl -arrow] set arrowlow [expr {$al eq "last" || $al eq "both"}] - } elseif {$arrowlow && - [lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0} { - set arrowlow 0 + } elseif {$arrowlow} { + if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 || + [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} { + set arrowlow 0 + } } set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]] for {set y $le} {[incr y -1] > $row} {} { @@ -3289,8 +3280,19 @@ proc drawlineseg {id row endrow arrowlow} { set xc [lsearch -exact [lindex $rowidlist $row] $ch] if {$xc < 0} { puts "oops: drawlineseg: child $ch not on row $row" - } else { - if {$xc < $x - 1} { + } elseif {$xc != $x} { + if {($arrowhigh && $le == $row + 1) || $dir == 0} { + set d [expr {int(0.5 * $linespc)}] + set x1 [xc $row $x] + if {$xc < $x} { + set x2 [expr {$x1 - $d}] + } else { + set x2 [expr {$x1 + $d}] + } + set y2 [yc $row] + set y1 [expr {$y2 + $d}] + lappend coords $x1 $y1 $x2 $y2 + } elseif {$xc < $x - 1} { lappend coords [xc $row [expr {$x-1}]] [yc $row] } elseif {$xc > $x + 1} { lappend coords [xc $row [expr {$x+1}]] [yc $row] @@ -3301,23 +3303,9 @@ proc drawlineseg {id row endrow arrowlow} { } else { set xn [xc $row $xp] set yn [yc $row] - # work around tk8.4 refusal to draw arrows on diagonal segments - if {$arrowlow && $xn != [lindex $coords end-1]} { - if {[llength $coords] < 4 || - [lindex $coords end-3] != [lindex $coords end-1] || - [lindex $coords end] - $yn > 2 * $linespc} { - set xn [xc $row [expr {$xp - 0.5 * $dir}]] - set yo [yc [expr {$row + 0.5}]] - lappend coords $xn $yo $xn $yn - } - } else { - lappend coords $xn $yn - } + lappend coords $xn $yn } if {!$joinhigh} { - if {$arrowhigh} { - set coords [adjarrowhigh $coords] - } assigncolor $id set t [$canv create line $coords -width [linewidth $id] \ -fill $colormap($id) -tags lines.$id -arrow $arrow] @@ -3341,9 +3329,6 @@ proc drawlineseg {id row endrow arrowlow} { set coords [concat $coords $clow] if {!$joinhigh} { lset lines [expr {$i-1}] 1 $le - if {$arrowhigh} { - set coords [adjarrowhigh $coords] - } } else { # coalesce two pieces $canv delete $ith @@ -3373,7 +3358,7 @@ proc drawparentlinks {id row} { set x [xc $row $col] set y [yc $row] set y2 [yc $row2] - set d [expr {int(0.4 * $linespc)}] + set d [expr {int(0.5 * $linespc)}] set ymid [expr {$y + $d}] set ids [lindex $rowidlist $row2] # rmx = right-most X coord used -- cgit v1.2.3 From 67a4f1a7f5c778ffa23d1e562feb4cc6d52c9414 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Sun, 12 Aug 2007 17:23:47 +1000 Subject: gitk: Fix bug causing the "can't unset idinlist(...)" error Under some circumstances, having duplicate parents in a commit could trigger a "can't unset idinlist" Tcl error. This fixes the cause (the logic in layoutrows could end up putting the same commit into rowidlist twice) and also puts a catch around the unset to ignore the error. Thanks to Jeff King for coming up with a test script to generate a repo that shows the problem. Signed-off-by: Paul Mackerras --- gitk | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 6c2be3b727..44b04f017a 100755 --- a/gitk +++ b/gitk @@ -2880,6 +2880,7 @@ proc layoutrows {row endrow last} { } elseif {!$idinlist($p)} { lappend oldolds $p } + set idinlist($p) 1 } set nev [expr {[llength $idlist] + [llength $newolds] + [llength $oldolds] - $maxwidth + 1}] @@ -2952,12 +2953,10 @@ proc layoutrows {row endrow last} { lset offs $col {} } foreach i $newolds { - set idinlist($i) 1 set idrowranges($i) $id } incr col $l foreach oid $oldolds { - set idinlist($oid) 1 set idlist [linsert $idlist $col $oid] set offs [linsert $offs $col $o] makeuparrow $oid $col $row $o @@ -2998,7 +2997,7 @@ proc layouttail {} { set col [expr {[llength $idlist] - 1}] set id [lindex $idlist $col] addextraid $id $row - unset idinlist($id) + catch {unset idinlist($id)} lappend idrowranges($id) $id lappend rowrangelist $idrowranges($id) unset idrowranges($id) -- cgit v1.2.3 From bd441de4df68c4144425b1c18d323fd90f3f9617 Mon Sep 17 00:00:00 2001 From: Mark Levedahl Date: Tue, 7 Aug 2007 21:40:34 -0400 Subject: [PATCH] gitk: Enable selected patch text on Windows On windows, mouse input follows the keyboard focus, so to allow selecting text from the patch canvas we must not shift focus back to the top level. This change has no negative impact on X, so we don't explicitly test for Win32 on this change. This provides similar selection capability as already available using X-Windows. Signed-off-by: Mark Levedahl Signed-off-by: Paul Mackerras --- gitk | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 44b04f017a..32206a68f0 100755 --- a/gitk +++ b/gitk @@ -964,8 +964,8 @@ proc bindkey {ev script} { # set the focus back to the toplevel for any click outside # the entry widgets proc click {w} { - global entries - foreach e $entries { + global ctext entries + foreach e [concat $entries $ctext] { if {$w == $e} return } focus . @@ -4600,6 +4600,7 @@ proc sellastline {} { proc selnextline {dir} { global selectedline + focus . if {![info exists selectedline]} return set l [expr {$selectedline + $dir}] unmarkmatches @@ -4680,6 +4681,7 @@ proc godo {elt} { proc goback {} { global history historyindex + focus . if {$historyindex > 1} { incr historyindex -1 @@ -4693,6 +4695,7 @@ proc goback {} { proc goforw {} { global history historyindex + focus . if {$historyindex < [llength $history]} { set cmd [lindex $history $historyindex] -- cgit v1.2.3 From 314c30936f505f70534c619a48d99afb93451cb2 Mon Sep 17 00:00:00 2001 From: Mark Levedahl Date: Tue, 7 Aug 2007 21:40:35 -0400 Subject: [PATCH] gitk: Handle MouseWheel events on Windows Windows, unlike X-Windows, sends mousewheel events by default to the window that has keyboard focus and uses the MouseWheel event to do so. The window to be scrolled must be able to take focus, but gitk's panels are disabled so cannot take focus. For all these reasons, a different design is needed to use the mousewheel on Windows. The approach here is to bind the mousewheel events to the top level window and redirect them based upon the current mouse position. Signed-off-by: Mark Levedahl Signed-off-by: Paul Mackerras --- gitk | 27 +++++++++++++++++++++++++-- 1 file changed, 25 insertions(+), 2 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 32206a68f0..9000383235 100755 --- a/gitk +++ b/gitk @@ -823,8 +823,13 @@ proc makewindow {} { pack .ctop -fill both -expand 1 bindall <1> {selcanvline %W %x %y} #bindall {selcanvline %W %x %y} - bindall "allcanvs yview scroll -5 units" - bindall "allcanvs yview scroll 5 units" + if {[tk windowingsystem] == "win32"} { + bind . { windows_mousewheel_redirector %W %X %Y %D } + bind $ctext { windows_mousewheel_redirector %W %X %Y %D ; break } + } else { + bindall "allcanvs yview scroll -5 units" + bindall "allcanvs yview scroll 5 units" + } bindall <2> "canvscan mark %W %x %y" bindall "canvscan dragto %W %x %y" bindkey selfirstline @@ -927,6 +932,24 @@ proc makewindow {} { -command {flist_hl 1} } +# Windows sends all mouse wheel events to the current focused window, not +# the one where the mouse hovers, so bind those events here and redirect +# to the correct window +proc windows_mousewheel_redirector {W X Y D} { + global canv canv2 canv3 + set w [winfo containing -displayof $W $X $Y] + if {$w ne ""} { + set u [expr {$D < 0 ? 5 : -5}] + if {$w == $canv || $w == $canv2 || $w == $canv3} { + allcanvs yview scroll $u units + } else { + catch { + $w yview scroll $u units + } + } + } +} + # mouse-2 makes all windows scan vertically, but only the one # the cursor is in scans horizontally proc canvscan {op w x y} { -- cgit v1.2.3 From 062d671f57a422863416ee4c746ef74c1cc45c19 Mon Sep 17 00:00:00 2001 From: Alex Riesen Date: Sun, 29 Jul 2007 22:28:40 +0200 Subject: [PATCH] gitk: Continue and show error message in new repos If there is no commit made yet, gitk just dumps a Tcl error on stderr, which sometimes is hard to see. Noticed when gitk was run from Xfce file manager (thunar's custom action). Signed-off-by: Alex Riesen Signed-off-by: Paul Mackerras --- gitk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gitk') diff --git a/gitk b/gitk index 9000383235..b0a76dd225 100755 --- a/gitk +++ b/gitk @@ -427,7 +427,7 @@ proc readrefs {} { lappend idotherrefs($id) $name } } - close $refd + catch {close $refd} set mainhead {} set mainheadid {} catch { -- cgit v1.2.3 From 6c87d60cc6202d4de5ac6d136394602feefeafc6 Mon Sep 17 00:00:00 2001 From: Alex Riesen Date: Sun, 29 Jul 2007 22:29:45 +0200 Subject: [PATCH] gitk: Show an error and exit if no .git could be found This is to help people starting gitk from graphical file managers where the stderr output is hidden. Signed-off-by: Alex Riesen Signed-off-by: Paul Mackerras --- gitk | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'gitk') diff --git a/gitk b/gitk index b0a76dd225..769c79ab07 100755 --- a/gitk +++ b/gitk @@ -7636,7 +7636,10 @@ catch {source ~/.gitk} font create optionfont -family sans-serif -size -12 # check that we can find a .git directory somewhere... -set gitdir [gitdir] +if {[catch {set gitdir [gitdir]}]} { + show_error {} . "Cannot find a git repository here." + exit 1 +} if {![file isdirectory $gitdir]} { show_error {} . "Cannot find the git directory \"$gitdir\"." exit 1 -- cgit v1.2.3 From 7b459a1c1cc5401295e3adb12031e39e35712f4a Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Mon, 13 Aug 2007 14:52:00 +1000 Subject: gitk: Fix bug introduced in commit 67a4f1a7 In fixing the "can't unset idinlist" error, I moved the setting of idinlist into the loop that splits the parents into "new" parents (i.e. those of which this is the first child) and "old" parents. Unfortunately this is incorrect in the case where we hit the break statement a few lines further down, since when we come back in, we'll see idinlist($p) set for some parents that aren't in the list. This fixes it by moving the loop that sets up newolds and oldolds further down. Signed-off-by: Paul Mackerras --- gitk | 24 ++++++++++++++---------- 1 file changed, 14 insertions(+), 10 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 769c79ab07..666a545751 100755 --- a/gitk +++ b/gitk @@ -2895,18 +2895,12 @@ proc layoutrows {row endrow last} { set offs [lindex $rowoffsets $row] while {$row < $endrow} { set id [lindex $displayorder $row] - set oldolds {} - set newolds {} + set nev [expr {[llength $idlist] - $maxwidth + 1}] foreach p [lindex $parentlist $row] { - if {![info exists idinlist($p)]} { - lappend newolds $p - } elseif {!$idinlist($p)} { - lappend oldolds $p + if {![info exists idinlist($p)] || !$idinlist($p)} { + incr nev } - set idinlist($p) 1 } - set nev [expr {[llength $idlist] + [llength $newolds] - + [llength $oldolds] - $maxwidth + 1}] if {$nev > 0} { if {!$last && $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break @@ -2925,12 +2919,22 @@ proc layoutrows {row endrow last} { if {[incr nev -1] <= 0} break continue } - set rowchk($id) [expr {$row + $r}] + set rowchk($i) [expr {$row + $r}] } } lset rowidlist $row $idlist lset rowoffsets $row $offs } + set oldolds {} + set newolds {} + foreach p [lindex $parentlist $row] { + if {![info exists idinlist($p)]} { + lappend newolds $p + } elseif {!$idinlist($p)} { + lappend oldolds $p + } + set idinlist($p) 1 + } set col [lsearch -exact $idlist $id] if {$col < 0} { set col [llength $idlist] -- cgit v1.2.3 From a69b2d1a8bf335ddbf0929c609b2daa523c7ede0 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Mon, 13 Aug 2007 15:02:02 +1000 Subject: gitk: Fix bug causing Tcl error when updating graph If "Show nearby tags" is turned off, selecting "Update" from the File menu will cause a Tcl error. This fixes it. The problem was that we were calling regetallcommits unconditionally, but it assumed that getallcommits had been called previously. This also restructures {re,}getallcommits to be a bit simpler. Signed-off-by: Paul Mackerras --- gitk | 24 +++++++++++------------- 1 file changed, 11 insertions(+), 13 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 666a545751..57617d58b0 100755 --- a/gitk +++ b/gitk @@ -296,7 +296,7 @@ proc readcommit {id} { proc updatecommits {} { global viewdata curview phase displayorder - global children commitrow selectedline thickerline + global children commitrow selectedline thickerline showneartags if {$phase ne {}} { stop_rev_list @@ -313,7 +313,9 @@ proc updatecommits {} { catch {unset viewdata($n)} readrefs changedrefs - regetallcommits + if {$showneartags} { + getallcommits + } showview $n } @@ -6199,17 +6201,13 @@ proc rmbranch {} { proc getallcommits {} { global allcommits allids nbmp nextarc seeds - set allids {} - set nbmp 0 - set nextarc 0 - set allcommits 0 - set seeds {} - regetallcommits -} - -# Called when the graph might have changed -proc regetallcommits {} { - global allcommits seeds + if {![info exists allcommits]} { + set allids {} + set nbmp 0 + set nextarc 0 + set allcommits 0 + set seeds {} + } set cmd [concat | git rev-list --all --parents] foreach id $seeds { -- cgit v1.2.3 From b1054ac985aebc90c0a78202dab8477b74d7818a Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Wed, 15 Aug 2007 10:09:47 +1000 Subject: gitk: Fix warning when removing a branch When we had two heads on the same commit, and the user tried to remove one of them, gitk was sometimes incorrectly saying that the commits on that branch weren't on any other branch. This fixes it. Signed-off-by: Paul Mackerras --- gitk | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 57617d58b0..6faa7f7ef1 100755 --- a/gitk +++ b/gitk @@ -6168,7 +6168,7 @@ proc cobranch {} { proc rmbranch {} { global headmenuid headmenuhead mainhead - global headids idheads + global idheads set head $headmenuhead set id $headmenuid @@ -6178,7 +6178,7 @@ proc rmbranch {} { return } set dheads [descheads $id] - if {$dheads eq $headids($head)} { + if {$idheads($dheads) 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 -- cgit v1.2.3 From 890fae7041bb0607f386ac1a996a49530f1cd86f Mon Sep 17 00:00:00 2001 From: Steffen Prohaska Date: Sun, 12 Aug 2007 12:05:46 +0200 Subject: [PATCH] gitk: Let user easily specify lines of context in diff view More lines of context sometimes help to better understand a diff. This patch introduces a text field above the box displaying the blobdiffs. You can type in the number of lines of context that you wish to view. The number of lines of context is saved to ~/.gitk. Signed-off-by: Steffen Prohaska Signed-off-by: Paul Mackerras --- gitk | 34 ++++++++++++++++++++++++++++++++-- 1 file changed, 32 insertions(+), 2 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 6faa7f7ef1..15e4a94ebf 100755 --- a/gitk +++ b/gitk @@ -519,6 +519,7 @@ proc makewindow {} { global textfont mainfont uifont tabstop global findtype findtypemenu findloc findstring fstring geometry global entries sha1entry sha1string sha1but + global diffcontextstring diffcontext global maincursor textcursor curtextcursor global rowctxmenu fakerowmenu mergemax wrapcomment global highlight_files gdttype @@ -733,7 +734,17 @@ proc makewindow {} { -command changediffdisp -variable diffelide -value {0 1} radiobutton .bleft.mid.new -text "New version" \ -command changediffdisp -variable diffelide -value {1 0} + label .bleft.mid.labeldiffcontext -text " Lines of context: " \ + -font $uifont pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left + spinbox .bleft.mid.diffcontext -width 5 -font $textfont \ + -from 1 -increment 1 -to 10000000 \ + -validate all -validatecommand "diffcontextvalidate %P" \ + -textvariable diffcontextstring + .bleft.mid.diffcontext set $diffcontext + trace add variable diffcontextstring write diffcontextchange + lappend entries .bleft.mid.diffcontext + pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left set ctext .bleft.ctext text $ctext -background $bgcolor -foreground $fgcolor \ -tabs "[expr {$tabstop * $charspc}]" \ @@ -1002,7 +1013,7 @@ proc savestuff {w} { global maxwidth showneartags showlocalchanges global viewname viewfiles viewargs viewperm nextviewnum global cmitmode wrapcomment - global colors bgcolor fgcolor diffcolors selectbgcolor + global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor if {$stuffsaved} return if {![winfo viewable .]} return @@ -1023,6 +1034,7 @@ proc savestuff {w} { puts $f [list set fgcolor $fgcolor] puts $f [list set colors $colors] puts $f [list set diffcolors $diffcolors] + puts $f [list set diffcontext $diffcontext] puts $f [list set selectbgcolor $selectbgcolor] puts $f "set geometry(main) [wm geometry .]" @@ -5052,12 +5064,29 @@ proc gettreediffline {gdtf ids} { return 0 } +# empty string or positive integer +proc diffcontextvalidate {v} { + return [regexp {^(|[1-9][0-9]*)$} $v] +} + +proc diffcontextchange {n1 n2 op} { + global diffcontextstring diffcontext + + if {[string is integer -strict $diffcontextstring]} { + if {$diffcontextstring > 0} { + set diffcontext $diffcontextstring + reselectline + } + } +} + proc getblobdiffs {ids} { global diffopts blobdifffd diffids env global diffinhdr treediffs + global diffcontext set env(GIT_DIFF_OPTS) $diffopts - if {[catch {set bdf [open [diffcmd $ids {-p -C --no-commit-id}] r]} err]} { + if {[catch {set bdf [open [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"] r]} err]} { puts "error getting diffs: $err" return } @@ -7631,6 +7660,7 @@ set colors {green red blue magenta darkgrey brown orange} set bgcolor white set fgcolor black set diffcolors {red "#00a000" blue} +set diffcontext 3 set selectbgcolor gray85 catch {source ~/.gitk} -- cgit v1.2.3 From e8b5f4be708a73fd8b6c06a782168d5b04e3e5c1 Mon Sep 17 00:00:00 2001 From: Arjen Laarhoven Date: Tue, 14 Aug 2007 22:02:04 +0200 Subject: [PATCH] gitk: Make the date/time display configurable The new 'datetimeformat' configuration variable in ~/.gitk can be set to a Tcl 'clock format' format string to modify the display of dates and times. http://www.tcl.tk/man/tcl8.4/TclCmd/clock.htm has a list of allowed fields. Signed-off-by: Arjen Laarhoven Signed-off-by: Paul Mackerras --- gitk | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 15e4a94ebf..aa8baf857e 100755 --- a/gitk +++ b/gitk @@ -1012,7 +1012,7 @@ proc savestuff {w} { global stuffsaved findmergefiles maxgraphpct global maxwidth showneartags showlocalchanges global viewname viewfiles viewargs viewperm nextviewnum - global cmitmode wrapcomment + global cmitmode wrapcomment datetimeformat global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor if {$stuffsaved} return @@ -1030,6 +1030,7 @@ proc savestuff {w} { puts $f [list set wrapcomment $wrapcomment] puts $f [list set showneartags $showneartags] puts $f [list set showlocalchanges $showlocalchanges] + puts $f [list set datetimeformat $datetimeformat] puts $f [list set bgcolor $bgcolor] puts $f [list set fgcolor $fgcolor] puts $f [list set colors $colors] @@ -7341,8 +7342,9 @@ proc prefsok {} { } proc formatdate {d} { + global datetimeformat if {$d ne {}} { - set d [clock format $d -format "%Y-%m-%d %H:%M:%S"] + set d [clock format $d -format $datetimeformat] } return $d } @@ -7655,6 +7657,7 @@ set showneartags 1 set maxrefs 20 set maxlinelen 200 set showlocalchanges 1 +set datetimeformat "%Y-%m-%d %H:%M:%S" set colors {green red blue magenta darkgrey brown orange} set bgcolor white -- cgit v1.2.3 From d7b16113a128ff04134cec4a8e241cf9cd0a49a2 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Fri, 17 Aug 2007 17:57:31 +1000 Subject: gitk: Fix bug in fix for warning when removing a branch My fix in commit b1054ac985aebc90c0a78202dab8477b74d7818a was only half-right, since it ignored the case where the descendent heads of the head being removed correspond to two or more different commits. This fixes it. Reported by Mark Levedahl. Signed-off-by: Paul Mackerras --- gitk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gitk') diff --git a/gitk b/gitk index aa8baf857e..0b5cfee0a7 100755 --- a/gitk +++ b/gitk @@ -6208,7 +6208,7 @@ proc rmbranch {} { return } set dheads [descheads $id] - if {$idheads($dheads) eq $head} { + if {[llength $dheads] == 1 && $idheads($dheads) 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 -- cgit v1.2.3 From d1cb298b0b74972cc27c789e4c9ce6f324f25113 Mon Sep 17 00:00:00 2001 From: Johannes Sixt Date: Thu, 16 Aug 2007 14:32:29 +0200 Subject: [PATCH] gitk: Handle 'copy from' and 'copy to' in diff headers. If a commit contained a copy operation, the file name was not correctly determined, and the corresponding part of the patch could not be navigated to from the list of files. Signed-off-by: Johannes Sixt Signed-off-by: Paul Mackerras --- gitk | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 0b5cfee0a7..6b0569a5f4 100755 --- a/gitk +++ b/gitk @@ -5146,8 +5146,8 @@ proc getblobdiffline {bdf ids} { # the middle char will be a space, and the two bits either # side will be a/name and b/name, or "a/name" and "b/name". # If the name has changed we'll get "rename from" and - # "rename to" lines following this, and we'll use them - # to get the filenames. + # "rename to" or "copy from" and "copy to" lines following this, + # and we'll use them to get the filenames. # This complexity is necessary because spaces in the filename(s) # don't get escaped. set l [string length $line] @@ -5171,8 +5171,9 @@ proc getblobdiffline {bdf ids} { set diffinhdr 0 } elseif {$diffinhdr} { - if {![string compare -length 12 "rename from " $line]} { - set fname [string range $line 12 end] + if {![string compare -length 12 "rename from " $line] || + ![string compare -length 10 "copy from " $line]} { + set fname [string range $line [expr 6 + [string first " from " $line] ] end] if {[string index $fname 0] eq "\""} { set fname [lindex $fname 0] } @@ -5180,8 +5181,9 @@ proc getblobdiffline {bdf ids} { if {$i >= 0} { setinlist difffilestart $i $curdiffstart } - } elseif {![string compare -length 10 $line "rename to "]} { - set fname [string range $line 10 end] + } elseif {![string compare -length 10 $line "rename to "] || + ![string compare -length 8 $line "copy to "]} { + set fname [string range $line [expr 4 + [string first " to " $line] ] end] if {[string index $fname 0] eq "\""} { set fname [lindex $fname 0] } -- cgit v1.2.3 From 887c996e4698dcb7ee95c48a98f7da2c3bae158b Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Mon, 20 Aug 2007 19:36:20 +1000 Subject: gitk: Add a window to list branches, tags and other references This adds an entry to the File menu labelled "List references" which pops up a window showing a sorted list of branches, tags, and other references, with a little icon beside each to indicate what sort it is. The list only shows refs that point to a commit that is included in the graph, and if you click on a ref, the corresponding commit is selected in the main window. The list of refs gets updated dynamically. Signed-off-by: Paul Mackerras --- gitk | 212 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 210 insertions(+), 2 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 6b0569a5f4..b7730ae202 100755 --- a/gitk +++ b/gitk @@ -533,6 +533,7 @@ proc makewindow {} { menu .bar.file .bar.file add command -label "Update" -command updatecommits .bar.file add command -label "Reread references" -command rereadrefs + .bar.file add command -label "List references" -command showrefs .bar.file add command -label "Quit" -command doquit .bar.file configure -font $uifont menu .bar.edit @@ -1466,6 +1467,38 @@ image create bitmap tri-dn -background black -foreground blue -data { 0x00, 0x00}; } +image create bitmap reficon-T -background black -foreground yellow -data { + #define tagicon_width 13 + #define tagicon_height 9 + static unsigned char tagicon_bits[] = { + 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07, + 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00}; +} -maskdata { + #define tagicon-mask_width 13 + #define tagicon-mask_height 9 + static unsigned char tagicon-mask_bits[] = { + 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f, + 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00}; +} +set rectdata { + #define headicon_width 13 + #define headicon_height 9 + static unsigned char headicon_bits[] = { + 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07, + 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00}; +} +set rectmask { + #define headicon-mask_width 13 + #define headicon-mask_height 9 + static unsigned char headicon-mask_bits[] = { + 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, + 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00}; +} +image create bitmap reficon-H -background black -foreground green \ + -data $rectdata -maskdata $rectmask +image create bitmap reficon-o -background black -foreground "#ddddff" \ + -data $rectdata -maskdata $rectmask + proc init_flist {first} { global cflist cflist_top selectedline difffilestart @@ -1988,6 +2021,7 @@ proc showview {n} { } elseif {$numcommits == 0} { show_status "No commits selected" } + run refill_reflist } # Stuff relating to the highlighting facility @@ -2751,13 +2785,22 @@ proc layoutmore {tmax allread} { proc showstuff {canshow last} { global numcommits commitrow pending_select selectedline curview global lookingforhead mainheadid displayorder selectfirst - global lastscrollset + global lastscrollset commitinterest if {$numcommits == 0} { global phase set phase "incrdraw" allcanvs delete all } + for {set l $numcommits} {$l < $canshow} {incr l} { + set id [lindex $displayorder $l] + if {[info exists commitinterest($id)]} { + foreach script $commitinterest($id) { + eval [string map [list "%I" $id] $script] + } + unset commitinterest($id) + } + } set r0 $numcommits set prev $numcommits set numcommits $canshow @@ -4484,6 +4527,7 @@ proc selectline {l isnew} { $canv delete hover normalline cancel_next_highlight + unsel_reflist if {$l < 0 || $l >= $numcommits} return set y [expr {$canvy0 + $l * $linespc}] set ymax [lindex [$canv cget -scrollregion] 3] @@ -5414,7 +5458,7 @@ proc redisplay {} { } proc incrfont {inc} { - global mainfont textfont ctext canv phase cflist + global mainfont textfont ctext canv phase cflist showrefstop global charspc tabstop global stopped entries unmarkmatches @@ -5430,6 +5474,9 @@ proc incrfont {inc} { if {$phase eq "getcommits"} { $canv itemconf textitems -font $mainfont } + if {[info exists showrefstop] && [winfo exists $showrefstop]} { + $showrefstop.list conf -font $mainfont + } redisplay } @@ -5888,6 +5935,8 @@ proc domktag {} { lappend idtags($id) $tag redrawtags $id addedtag $id + dispneartags 0 + run refill_reflist } proc redrawtags {id} { @@ -6029,6 +6078,7 @@ proc mkbrgo {top} { notbusy newbranch redrawtags $id dispneartags 0 + run refill_reflist } } @@ -6227,6 +6277,163 @@ proc rmbranch {} { redrawtags $id notbusy rmbranch dispneartags 0 + run refill_reflist +} + +# Display a list of tags and heads +proc showrefs {} { + global showrefstop bgcolor fgcolor selectbgcolor mainfont + global bglist fglist uifont reflistfilter reflist maincursor + + set top .showrefs + set showrefstop $top + if {[winfo exists $top]} { + raise $top + refill_reflist + return + } + toplevel $top + wm title $top "Tags and heads: [file tail [pwd]]" + text $top.list -background $bgcolor -foreground $fgcolor \ + -selectbackground $selectbgcolor -font $mainfont \ + -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \ + -width 30 -height 20 -cursor $maincursor \ + -spacing1 1 -spacing3 1 -state disabled + $top.list tag configure highlight -background $selectbgcolor + lappend bglist $top.list + lappend fglist $top.list + scrollbar $top.ysb -command "$top.list yview" -orient vertical + scrollbar $top.xsb -command "$top.list xview" -orient horizontal + grid $top.list $top.ysb -sticky nsew + grid $top.xsb x -sticky ew + frame $top.f + label $top.f.l -text "Filter: " -font $uifont + entry $top.f.e -width 20 -textvariable reflistfilter -font $uifont + set reflistfilter "*" + trace add variable reflistfilter write reflistfilter_change + pack $top.f.e -side right -fill x -expand 1 + pack $top.f.l -side left + grid $top.f - -sticky ew -pady 2 + button $top.close -command [list destroy $top] -text "Close" \ + -font $uifont + grid $top.close - + grid columnconfigure $top 0 -weight 1 + grid rowconfigure $top 0 -weight 1 + bind $top.list <1> {break} + bind $top.list {break} + bind $top.list {sel_reflist %W %x %y; break} + set reflist {} + refill_reflist +} + +proc sel_reflist {w x y} { + global showrefstop reflist headids tagids otherrefids + + if {![winfo exists $showrefstop]} return + set l [lindex [split [$w index "@$x,$y"] "."] 0] + set ref [lindex $reflist [expr {$l-1}]] + set n [lindex $ref 0] + switch -- [lindex $ref 1] { + "H" {selbyid $headids($n)} + "T" {selbyid $tagids($n)} + "o" {selbyid $otherrefids($n)} + } + $showrefstop.list tag add highlight $l.0 "$l.0 lineend" +} + +proc unsel_reflist {} { + global showrefstop + + if {![info exists showrefstop] || ![winfo exists $showrefstop]} return + $showrefstop.list tag remove highlight 0.0 end +} + +proc reflistfilter_change {n1 n2 op} { + global reflistfilter + + after cancel refill_reflist + after 200 refill_reflist +} + +proc refill_reflist {} { + global reflist reflistfilter showrefstop headids tagids otherrefids + global commitrow curview commitinterest + + if {![info exists showrefstop] || ![winfo exists $showrefstop]} return + set refs {} + foreach n [array names headids] { + if {[string match $reflistfilter $n]} { + if {[info exists commitrow($curview,$headids($n))]} { + lappend refs [list $n H] + } else { + set commitinterest($headids($n)) {run refill_reflist} + } + } + } + foreach n [array names tagids] { + if {[string match $reflistfilter $n]} { + if {[info exists commitrow($curview,$tagids($n))]} { + lappend refs [list $n T] + } else { + set commitinterest($tagids($n)) {run refill_reflist} + } + } + } + foreach n [array names otherrefids] { + if {[string match $reflistfilter $n]} { + if {[info exists commitrow($curview,$otherrefids($n))]} { + lappend refs [list $n o] + } else { + set commitinterest($otherrefids($n)) {run refill_reflist} + } + } + } + set refs [lsort -index 0 $refs] + if {$refs eq $reflist} return + + # Update the contents of $showrefstop.list according to the + # differences between $reflist (old) and $refs (new) + $showrefstop.list conf -state normal + $showrefstop.list insert end "\n" + set i 0 + set j 0 + while {$i < [llength $reflist] || $j < [llength $refs]} { + if {$i < [llength $reflist]} { + if {$j < [llength $refs]} { + set cmp [string compare [lindex $reflist $i 0] \ + [lindex $refs $j 0]] + if {$cmp == 0} { + set cmp [string compare [lindex $reflist $i 1] \ + [lindex $refs $j 1]] + } + } else { + set cmp -1 + } + } else { + set cmp 1 + } + switch -- $cmp { + -1 { + $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0" + incr i + } + 0 { + incr i + incr j + } + 1 { + set l [expr {$j + 1}] + $showrefstop.list image create $l.0 -align baseline \ + -image reficon-[lindex $refs $j 1] -padx 2 + $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n" + incr j + } + } + } + set reflist $refs + # delete last newline + $showrefstop.list delete end-2c end-1c + $showrefstop.list conf -state disabled } # Stuff for finding nearby tags @@ -7124,6 +7331,7 @@ proc rereadrefs {} { redrawtags $id } } + run refill_reflist } proc listrefs {id} { -- cgit v1.2.3 From 92ed666fa761554c67c8f883863517870a65376d Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Wed, 22 Aug 2007 22:35:28 +1000 Subject: gitk: Get rid of idrowranges and rowrangelist Instead make the rowranges procedure compute its result by looking in the rowidlist entries for the rows around the children of the id and the id itself. This turns out not to take too long, and not having to maintain idrowranges and rowrangelist speeds up the layout. This also makes optimize_rows not use rowranges, since all it really needed was a way to work out if one id is the first child of another, so it can just look at the children list. Signed-off-by: Paul Mackerras --- gitk | 142 +++++++++++++++++++++++++++++++------------------------------------ 1 file changed, 66 insertions(+), 76 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index d2f5eeeaaf..a29c793830 100755 --- a/gitk +++ b/gitk @@ -1927,7 +1927,7 @@ proc showview {n} { global curview viewdata viewfiles global displayorder parentlist rowidlist global colormap rowtextx commitrow nextcolor canvxmax - global numcommits rowrangelist commitlisted idrowranges rowchk + global numcommits commitlisted rowchk global selectedline currentid canv canvy0 global treediffs global pending_select phase @@ -1963,13 +1963,13 @@ proc showview {n} { set vcmitlisted($curview) $commitlisted if {$phase ne {}} { set viewdata($curview) \ - [list $phase $rowidlist {} $rowrangelist \ - [flatten idrowranges] [flatten idinlist] \ + [list $phase $rowidlist {} {} \ + {} [flatten idinlist] \ $rowlaidout $rowoptim $numcommits] } elseif {![info exists viewdata($curview)] || [lindex $viewdata($curview) 0] ne {}} { set viewdata($curview) \ - [list {} $rowidlist {} $rowrangelist] + [list {} $rowidlist {} {}] } } catch {unset treediffs} @@ -1998,12 +1998,9 @@ proc showview {n} { set parentlist $vparentlist($n) set commitlisted $vcmitlisted($n) set rowidlist [lindex $v 1] - set rowrangelist [lindex $v 3] if {$phase eq {}} { set numcommits [llength $displayorder] - catch {unset idrowranges} } else { - unflatten idrowranges [lindex $v 4] unflatten idinlist [lindex $v 5] set rowlaidout [lindex $v 6] set rowoptim [lindex $v 7] @@ -2670,7 +2667,7 @@ proc idcol {idlist id {i 0}} { } proc makeuparrow {oid y x} { - global rowidlist uparrowlen idrowranges displayorder + global rowidlist uparrowlen displayorder for {set i 0} {$i < $uparrowlen && $y > 1} {incr i} { incr y -1 @@ -2678,13 +2675,12 @@ proc makeuparrow {oid y x} { set x [idcol $idl $oid $x] lset rowidlist $y [linsert $idl $x $oid] } - lappend idrowranges($oid) [lindex $displayorder $y] } proc initlayout {} { global rowidlist displayorder commitlisted global rowlaidout rowoptim - global idinlist rowchk rowrangelist idrowranges + global idinlist rowchk global numcommits canvxmax canv global nextcolor global parentlist @@ -2695,7 +2691,6 @@ proc initlayout {} { set displayorder {} set commitlisted {} set parentlist {} - set rowrangelist {} set nextcolor 0 set rowidlist {{}} catch {unset idinlist} @@ -2705,7 +2700,6 @@ proc initlayout {} { set canvxmax [$canv cget -width] catch {unset colormap} catch {unset rowtextx} - catch {unset idrowranges} set selectfirst 1 } @@ -2952,9 +2946,8 @@ proc layoutrows {row endrow last} { global rowidlist displayorder global uparrowlen downarrowlen maxwidth mingaplen global children parentlist - global idrowranges global commitidx curview - global idinlist rowchk rowrangelist + global idinlist rowchk set idlist [lindex $rowidlist $row] while {$row < $endrow} { @@ -2970,8 +2963,6 @@ proc layoutrows {row endrow last} { if {$r == 0} { set idlist [lreplace $idlist $x $x] set idinlist($i) 0 - set rm1 [expr {$row - 1}] - lappend idrowranges($i) [lindex $displayorder $rm1] continue } set rowchk($i) [expr {$row + $r}] @@ -3001,20 +2992,12 @@ proc layoutrows {row endrow last} { } else { unset idinlist($id) } - set ranges {} - if {[info exists idrowranges($id)]} { - set ranges $idrowranges($id) - lappend ranges $id - unset idrowranges($id) - } - lappend rowrangelist $ranges incr row set idlist [lreplace $idlist $col $col] set x $col foreach i $newolds { set x [idcol $idlist $i $x] set idlist [linsert $idlist $x $i] - set idrowranges($i) $id } foreach oid $oldolds { set x [idcol $idlist $oid $x] @@ -3047,7 +3030,6 @@ proc addextraid {id row} { proc layouttail {} { global rowidlist idinlist commitidx curview - global idrowranges rowrangelist set row $commitidx($curview) set idlist [lindex $rowidlist $row] @@ -3056,9 +3038,6 @@ proc layouttail {} { set id [lindex $idlist $col] addextraid $id $row catch {unset idinlist($id)} - lappend idrowranges($id) $id - lappend rowrangelist $idrowranges($id) - unset idrowranges($id) incr row set idlist [lreplace $idlist $col $col] lappend rowidlist $idlist @@ -3069,9 +3048,6 @@ proc layouttail {} { addextraid $id $row lset rowidlist $row [list $id] makeuparrow $id $row 0 - lappend idrowranges($id) $id - lappend rowrangelist $idrowranges($id) - unset idrowranges($id) incr row lappend rowidlist {} } @@ -3092,7 +3068,7 @@ proc insert_pad {row col npad} { } proc optimize_rows {row col endrow} { - global rowidlist displayorder + global rowidlist displayorder curview children if {$row < 1} { set row 1 @@ -3131,8 +3107,9 @@ proc optimize_rows {row col endrow} { } } if {$z0 eq {}} { - set ranges [rowranges $id] - if {$ranges ne {} && $y0 > [lindex $ranges 0]} { + # if row y0 is the first child of $id then it's not an arrow + if {[lindex $children($curview,$id) 0] ne + [lindex $displayorder $y0]} { set isarrow 1 } } @@ -3195,11 +3172,10 @@ proc optimize_rows {row col endrow} { set x0 [lsearch -exact $previdlist $id] if {$x0 < 0} { # check if this is the link to the first child - set ranges [rowranges $id] - if {$ranges ne {} && $row == [lindex $ranges 0]} { + set kid [lindex $displayorder $y0] + if {[lindex $children($curview,$id) 0] eq $kid} { # it is, work out offset to child - set id [lindex $displayorder $y0] - set x0 [lsearch -exact $previdlist $id] + set x0 [lsearch -exact $previdlist $kid] } } if {$x0 <= $col} break @@ -3236,24 +3212,59 @@ proc linewidth {id} { } proc rowranges {id} { - global phase idrowranges commitrow rowlaidout rowrangelist curview + global commitrow curview children uparrowlen downarrowlen + global rowidlist - set ranges {} - if {$phase eq {} || - ([info exists commitrow($curview,$id)] - && $commitrow($curview,$id) < $rowlaidout)} { - set ranges [lindex $rowrangelist $commitrow($curview,$id)] - } elseif {[info exists idrowranges($id)]} { - set ranges $idrowranges($id) - } - set linenos {} - foreach rid $ranges { - lappend linenos $commitrow($curview,$rid) + set kids $children($curview,$id) + if {$kids eq {}} { + return {} } - if {$linenos ne {}} { - lset linenos 0 [expr {[lindex $linenos 0] + 1}] + set ret {} + lappend kids $id + foreach child $kids { + if {![info exists commitrow($curview,$child)]} break + set row $commitrow($curview,$child) + if {![info exists prev]} { + lappend ret [expr {$row + 1}] + } else { + if {$row <= $prevrow} { + puts "oops children out of order [shortids $id] $row < [shortids $prev] $prevrow" + } + # see if the line extends the whole way from prevrow to row + if {$row > $prevrow + $uparrowlen + $downarrowlen && + [lsearch -exact [lindex $rowidlist \ + [expr {int(($row + $prevrow) / 2)}]] $id] < 0} { + # it doesn't, see where it ends + set r [expr {$prevrow + $downarrowlen}] + if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} { + while {[incr r -1] > $prevrow && + [lsearch -exact [lindex $rowidlist $r] $id] < 0} {} + } else { + while {[incr r] <= $row && + [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {} + incr r -1 + } + lappend ret $r + # see where it starts up again + set r [expr {$row - $uparrowlen}] + if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} { + while {[incr r] < $row && + [lsearch -exact [lindex $rowidlist $r] $id] < 0} {} + } else { + while {[incr r -1] >= $prevrow && + [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {} + incr r + } + lappend ret $r + } + } + if {$child eq $id} { + lappend ret $row + } + set prev $id + set prevrow $row } - return $linenos + return $ret } proc drawlineseg {id row endrow arrowlow} { @@ -3938,7 +3949,7 @@ proc show_status {msg} { proc insertrow {row newcmit} { global displayorder parentlist commitlisted children global commitrow curview rowidlist numcommits - global rowrangelist rowlaidout rowoptim numcommits + global rowlaidout rowoptim numcommits global selectedline rowchk commitidx if {$row >= $numcommits} { @@ -3970,18 +3981,6 @@ proc insertrow {row newcmit} { } set rowidlist [linsert $rowidlist $row $idlist] - set rowrangelist [linsert $rowrangelist $row {}] - if {[llength $kids] > 1} { - set rp1 [expr {$row + 1}] - set ranges [lindex $rowrangelist $rp1] - if {$ranges eq {}} { - set ranges [list $newcmit $p] - } elseif {[lindex $ranges end-1] eq $p} { - lset ranges end-1 $newcmit - } - lset rowrangelist $rp1 $ranges - } - catch {unset rowchk} incr rowlaidout @@ -3998,7 +3997,7 @@ proc insertrow {row newcmit} { proc removerow {row} { global displayorder parentlist commitlisted children global commitrow curview rowidlist numcommits - global rowrangelist idrowranges rowlaidout rowoptim numcommits + global rowlaidout rowoptim numcommits global linesegends selectedline rowchk commitidx if {$row >= $numcommits} { @@ -4026,15 +4025,6 @@ proc removerow {row} { set rowidlist [lreplace $rowidlist $row $row] - set rowrangelist [lreplace $rowrangelist $row $row] - if {[llength $kids] > 0} { - set ranges [lindex $rowrangelist $row] - if {[lindex $ranges end-1] eq $id} { - set ranges [lreplace $ranges end-1 end] - lset rowrangelist $row $ranges - } - } - catch {unset rowchk} incr rowlaidout -1 -- cgit v1.2.3 From b0cdca996a3717552ee30e8cc2bd157bb32fd213 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Thu, 23 Aug 2007 19:35:51 +1000 Subject: gitk: Get rid of idinlist array This changes layoutrows to use information from rowidlist and children to work out which parent ids are appearing for the first time or need an up arrow, instead of using idinlist. To detect the situation where git log doesn't give us all the commits it references, this adds an idpending array that is updated and used by getcommitlines. This also fixes a bug where we weren't resetting the ordertok array when updating the list of commits; this fixes that too, and a bug where we could try to access an undefined element of commitrow if the user did an update before gitk had finished reading in the graph. Signed-off-by: Paul Mackerras --- gitk | 84 +++++++++++++++++++++++++++++++++++++------------------------------- 1 file changed, 46 insertions(+), 38 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index a29c793830..7b0b4cfade 100755 --- a/gitk +++ b/gitk @@ -151,7 +151,7 @@ proc getcommitlines {fd view} { global displayorder commitidx commitrow commitdata global parentlist children curview hlview global vparentlist vdisporder vcmitlisted - global ordertok vnextroot + global ordertok vnextroot idpending set stuff [read $fd 500000] # git log doesn't terminate the last commit with a null... @@ -162,6 +162,23 @@ proc getcommitlines {fd view} { if {![eof $fd]} { return 1 } + # Check if we have seen any ids listed as parents that haven't + # appeared in the list + foreach vid [array names idpending "$view,*"] { + # should only get here if git log is buggy + set id [lindex [split $vid ","] 1] + set commitrow($vid) $commitidx($view) + incr commitidx($view) + if {$view == $curview} { + lappend parentlist {} + lappend displayorder $id + lappend commitlisted 0 + } else { + lappend vparentlist($view) {} + lappend vdisporder($view) $id + lappend vcmitlisted($view) 0 + } + } global viewname unset commfd($view) notbusy $view @@ -242,6 +259,7 @@ proc getcommitlines {fd view} { set ordertok($view,$id) $otok } else { set otok $ordertok($view,$id) + unset idpending($view,$id) } if {$listed} { set olds [lrange $ids 1 end] @@ -250,6 +268,7 @@ proc getcommitlines {fd view} { lappend children($view,$p) $id if {![info exists ordertok($view,$p)]} { set ordertok($view,$p) $ordertok($view,$id) + set idpending($view,$p) 1 } } else { set i 0 @@ -259,6 +278,7 @@ proc getcommitlines {fd view} { } if {![info exists ordertok($view,$p)]} { set ordertok($view,$p) "$otok[strrep $i]]" + set idpending($view,$p) 1 } incr i } @@ -328,7 +348,7 @@ proc readcommit {id} { } proc updatecommits {} { - global viewdata curview phase displayorder + global viewdata curview phase displayorder ordertok idpending global children commitrow selectedline thickerline showneartags if {$phase ne {}} { @@ -339,6 +359,10 @@ proc updatecommits {} { foreach id $displayorder { catch {unset children($n,$id)} catch {unset commitrow($n,$id)} + catch {unset ordertok($n,$id)} + } + foreach vid [array names idpending "$n,*"] { + unset idpending($vid) } set curview -1 catch {unset selectedline} @@ -1963,13 +1987,11 @@ proc showview {n} { set vcmitlisted($curview) $commitlisted if {$phase ne {}} { set viewdata($curview) \ - [list $phase $rowidlist {} {} \ - {} [flatten idinlist] \ - $rowlaidout $rowoptim $numcommits] + [list $phase $rowidlist $rowlaidout $rowoptim $numcommits] } elseif {![info exists viewdata($curview)] || [lindex $viewdata($curview) 0] ne {}} { set viewdata($curview) \ - [list {} $rowidlist {} {}] + [list {} $rowidlist] } } catch {unset treediffs} @@ -2001,10 +2023,9 @@ proc showview {n} { if {$phase eq {}} { set numcommits [llength $displayorder] } else { - unflatten idinlist [lindex $v 5] - set rowlaidout [lindex $v 6] - set rowoptim [lindex $v 7] - set numcommits [lindex $v 8] + set rowlaidout [lindex $v 2] + set rowoptim [lindex $v 3] + set numcommits [lindex $v 4] catch {unset rowchk} } @@ -2123,7 +2144,7 @@ proc addvhighlight {n} { } set hlview $n if {$n != $curview && ![info exists viewdata($n)]} { - set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}] + set viewdata($n) [list getcommits {{}} 0 0 0] set vparentlist($n) {} set vdisporder($n) {} set vcmitlisted($n) {} @@ -2635,9 +2656,11 @@ proc usedinrange {id l1 l2} { } set kids $children($curview,$id) foreach c $kids { - set r $commitrow($curview,$c) - if {$l1 <= $r && $r <= $l2} { - return [expr {$r - $l1 + 1}] + if {[info exists commitrow($curview,$c)]} { + set r $commitrow($curview,$c) + if {$l1 <= $r && $r <= $l2} { + return [expr {$r - $l1 + 1}] + } } } return 0 @@ -2680,7 +2703,7 @@ proc makeuparrow {oid y x} { proc initlayout {} { global rowidlist displayorder commitlisted global rowlaidout rowoptim - global idinlist rowchk + global rowchk global numcommits canvxmax canv global nextcolor global parentlist @@ -2693,7 +2716,6 @@ proc initlayout {} { set parentlist {} set nextcolor 0 set rowidlist {{}} - catch {unset idinlist} catch {unset rowchk} set rowlaidout 0 set rowoptim 0 @@ -2733,7 +2755,7 @@ proc visiblerows {} { proc layoutmore {tmax allread} { global rowlaidout rowoptim commitidx numcommits optim_delay - global uparrowlen curview rowidlist idinlist + global uparrowlen curview rowidlist set showlast 0 set showdelay $optim_delay @@ -2763,8 +2785,7 @@ proc layoutmore {tmax allread} { } elseif {$allread} { set optdelay 0 set nrows $commitidx($curview) - if {[lindex $rowidlist $nrows] ne {} || - [array names idinlist] ne {}} { + if {[lindex $rowidlist $nrows] ne {}} { layouttail set rowlaidout $commitidx($curview) } elseif {$rowoptim == $nrows} { @@ -2947,7 +2968,7 @@ proc layoutrows {row endrow last} { global uparrowlen downarrowlen maxwidth mingaplen global children parentlist global commitidx curview - global idinlist rowchk + global rowchk set idlist [lindex $rowidlist $row] while {$row < $endrow} { @@ -2962,7 +2983,6 @@ proc layoutrows {row endrow last} { [expr {$row + $uparrowlen + $mingaplen}]] if {$r == 0} { set idlist [lreplace $idlist $x $x] - set idinlist($i) 0 continue } set rowchk($i) [expr {$row + $r}] @@ -2973,12 +2993,12 @@ proc layoutrows {row endrow last} { set oldolds {} set newolds {} foreach p [lindex $parentlist $row] { - if {![info exists idinlist($p)]} { + # is id the first child of this parent? + if {$id eq [lindex $children($curview,$p) 0]} { lappend newolds $p - } elseif {!$idinlist($p)} { + } elseif {[lsearch -exact $idlist $p] < 0} { lappend oldolds $p } - set idinlist($p) 1 } set col [lsearch -exact $idlist $id] if {$col < 0} { @@ -2986,11 +3006,8 @@ proc layoutrows {row endrow last} { set idlist [linsert $idlist $col $id] lset rowidlist $row $idlist if {$children($curview,$id) ne {}} { - unset idinlist($id) makeuparrow $id $row $col } - } else { - unset idinlist($id) } incr row set idlist [lreplace $idlist $col $col] @@ -3029,7 +3046,7 @@ proc addextraid {id row} { } proc layouttail {} { - global rowidlist idinlist commitidx curview + global rowidlist commitidx curview set row $commitidx($curview) set idlist [lindex $rowidlist $row] @@ -3037,20 +3054,10 @@ proc layouttail {} { set col [expr {[llength $idlist] - 1}] set id [lindex $idlist $col] addextraid $id $row - catch {unset idinlist($id)} incr row set idlist [lreplace $idlist $col $col] lappend rowidlist $idlist } - - foreach id [array names idinlist] { - unset idinlist($id) - addextraid $id $row - lset rowidlist $row [list $id] - makeuparrow $id $row 0 - incr row - lappend rowidlist {} - } } proc insert_pad {row col npad} { @@ -4205,6 +4212,7 @@ proc findmorerev {} { set last 0 for {} {$l > $lim} {incr l -1} { set id [lindex $displayorder $l] + if {![info exists commitdata($id)]} continue if {![doesmatch $commitdata($id)]} continue if {![info exists commitinfo($id)]} { getcommit $id -- cgit v1.2.3 From 97645683bff498e369c1c24ce10e78b51cdaf468 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Thu, 23 Aug 2007 22:24:38 +1000 Subject: gitk: Fix some problems with the display of ids as links First, this fixes the problem where a SHA1 id wouldn't be displayed as a link if it wasn't in the part of the graph that had been laid out at the time the details pane was filled in, even if that commit later became part of the graph. This arranges for us to turn the SHA1 id into a link when we get to that id in laying out the graph. Secondly, there was a problem where the cursor wouldn't always turn to a hand when over a link, because the areas for two links could overlap slightly. This fixes that by using a counter rather than always reverting to a counter when we leave the region of a link (which can happen just after we've entered a different link). Signed-off-by: Paul Mackerras --- gitk | 87 +++++++++++++++++++++++++++++++++++++++++++------------------------- 1 file changed, 55 insertions(+), 32 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 7b0b4cfade..c795e9838e 100755 --- a/gitk +++ b/gitk @@ -1959,7 +1959,7 @@ proc showview {n} { global commfd global selectedview selectfirst global vparentlist vdisporder vcmitlisted - global hlview selectedhlview + global hlview selectedhlview commitinterest if {$n == $curview} return set selid {} @@ -2000,6 +2000,7 @@ proc showview {n} { unset hlview set selectedhlview None } + catch {unset commitinterest} set curview $n set selectedview $n @@ -4322,7 +4323,7 @@ proc commit_descriptor {p} { # append some text to the ctext widget, and make any SHA1 ID # that we know about be a clickable link. proc appendwithlinks {text tags} { - global ctext commitrow linknum curview + global ctext commitrow linknum curview pendinglinks set start [$ctext index "end - 1c"] $ctext insert end $text $tags @@ -4331,17 +4332,48 @@ proc appendwithlinks {text tags} { set s [lindex $l 0] set e [lindex $l 1] set linkid [string range $text $s $e] - if {![info exists commitrow($curview,$linkid)]} continue incr e - $ctext tag add link "$start + $s c" "$start + $e c" $ctext tag add link$linknum "$start + $s c" "$start + $e c" - $ctext tag bind link$linknum <1> \ - [list selectline $commitrow($curview,$linkid) 1] + setlink $linkid link$linknum incr linknum } - $ctext tag conf link -foreground blue -underline 1 - $ctext tag bind link { %W configure -cursor hand2 } - $ctext tag bind link { %W configure -cursor $curtextcursor } +} + +proc setlink {id lk} { + global curview commitrow ctext pendinglinks commitinterest + + if {[info exists commitrow($curview,$id)]} { + $ctext tag conf $lk -foreground blue -underline 1 + $ctext tag bind $lk <1> [list selectline $commitrow($curview,$id) 1] + $ctext tag bind $lk {linkcursor %W 1} + $ctext tag bind $lk {linkcursor %W -1} + } else { + lappend pendinglinks($id) $lk + lappend commitinterest($id) {makelink %I} + } +} + +proc makelink {id} { + global pendinglinks + + if {![info exists pendinglinks($id)]} return + foreach lk $pendinglinks($id) { + setlink $id $lk + } + unset pendinglinks($id) +} + +proc linkcursor {w inc} { + global linkentercount curtextcursor + + if {[incr linkentercount $inc] > 0} { + $w configure -cursor hand2 + } else { + $w configure -cursor $curtextcursor + if {$linkentercount < 0} { + set linkentercount 0 + } + } } proc viewnextline {dir} { @@ -4388,15 +4420,7 @@ proc appendrefs {pos ids var} { $ctext tag delete $lk $ctext insert $pos $sep $ctext insert $pos [lindex $ti 0] $lk - if {[info exists commitrow($curview,$id)]} { - $ctext tag conf $lk -foreground blue - $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 } - } + setlink $id $lk set sep ", " } } @@ -5237,6 +5261,7 @@ proc nextfile {} { proc clear_ctext {{first 1.0}} { global ctext smarktop smarkbot + global pendinglinks set l [lindex [split $first .] 0] if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} { @@ -5246,6 +5271,9 @@ proc clear_ctext {{first 1.0}} { set smarkbot $l } $ctext delete $first end + if {$first eq "1.0"} { + catch {unset pendinglinks} + } } proc incrsearch {name ix op} { @@ -5609,12 +5637,9 @@ proc lineclick {x y id isnew} { # fill the details pane with info about this line $ctext conf -state normal clear_ctext - $ctext tag conf link -foreground blue -underline 1 - $ctext tag bind link { %W configure -cursor hand2 } - $ctext tag bind link { %W configure -cursor $curtextcursor } $ctext insert end "Parent:\t" - $ctext insert end $id [list link link0] - $ctext tag bind link0 <1> [list selbyid $id] + $ctext insert end $id link0 + setlink $id link0 set info $commitinfo($id) $ctext insert end "\n\t[lindex $info 0]\n" $ctext insert end "\tAuthor:\t[lindex $info 1]\n" @@ -5629,8 +5654,8 @@ proc lineclick {x y id isnew} { if {![info exists commitinfo($child)] && ![getcommit $child]} continue set info $commitinfo($child) $ctext insert end "\n\t" - $ctext insert end $child [list link link$i] - $ctext tag bind link$i <1> [list selbyid $child] + $ctext insert end $child link$i + setlink $child link$i $ctext insert end "\n\t[lindex $info 0]" $ctext insert end "\n\tAuthor:\t[lindex $info 1]" set date [formatdate [lindex $info 2]] @@ -5711,16 +5736,13 @@ proc doseldiff {oldid newid} { clear_ctext init_flist "Top" $ctext insert end "From " - $ctext tag conf link -foreground blue -underline 1 - $ctext tag bind link { %W configure -cursor hand2 } - $ctext tag bind link { %W configure -cursor $curtextcursor } - $ctext tag bind link0 <1> [list selbyid $oldid] - $ctext insert end $oldid [list link link0] + $ctext insert end $oldid link0 + setlink $oldid link0 $ctext insert end "\n " $ctext insert end [lindex $commitinfo($oldid) 0] $ctext insert end "\n\nTo " - $ctext tag bind link1 <1> [list selbyid $newid] - $ctext insert end $newid [list link link1] + $ctext insert end $newid link1 + setlink $newid link1 $ctext insert end "\n " $ctext insert end [lindex $commitinfo($newid) 0] $ctext insert end "\n" @@ -7892,6 +7914,7 @@ set boldrows {} set boldnamerows {} set diffelide {0 0} set markingmatches 0 +set linkentercount 0 set optim_delay 16 -- cgit v1.2.3 From 8f0bc7e95e41673a853a53e17708c6f4f46e6420 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Fri, 24 Aug 2007 22:16:42 +1000 Subject: gitk: Get rid of the rowchk array Instead, when looking for lines that should be terminated with a down arrow, we look at the parents of the commit $downarrowlen + 1 rows before. This gets rid of one more place where we are assuming that all the rows are laid out in order from top to bottom. Signed-off-by: Paul Mackerras --- gitk | 55 +++++++++++++++++++++++++++++++------------------------ 1 file changed, 31 insertions(+), 24 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index c795e9838e..7726c311c5 100755 --- a/gitk +++ b/gitk @@ -1951,7 +1951,7 @@ proc showview {n} { global curview viewdata viewfiles global displayorder parentlist rowidlist global colormap rowtextx commitrow nextcolor canvxmax - global numcommits commitlisted rowchk + global numcommits commitlisted global selectedline currentid canv canvy0 global treediffs global pending_select phase @@ -2027,7 +2027,6 @@ proc showview {n} { set rowlaidout [lindex $v 2] set rowoptim [lindex $v 3] set numcommits [lindex $v 4] - catch {unset rowchk} } catch {unset colormap} @@ -2704,7 +2703,6 @@ proc makeuparrow {oid y x} { proc initlayout {} { global rowidlist displayorder commitlisted global rowlaidout rowoptim - global rowchk global numcommits canvxmax canv global nextcolor global parentlist @@ -2717,7 +2715,6 @@ proc initlayout {} { set parentlist {} set nextcolor 0 set rowidlist {{}} - catch {unset rowchk} set rowlaidout 0 set rowoptim 0 set canvxmax [$canv cget -width] @@ -2964,29 +2961,43 @@ proc readdifffiles {fd serial} { return 0 } +proc nextuse {id row} { + global commitrow curview children + + if {[info exists children($curview,$id)]} { + foreach kid $children($curview,$id) { + if {[info exists commitrow($curview,$kid)] && + $commitrow($curview,$kid) > $row} { + return $commitrow($curview,$kid) + } + } + } + if {[info exists commitrow($curview,$id)]} { + return $commitrow($curview,$id) + } + return -1 +} + proc layoutrows {row endrow last} { global rowidlist displayorder global uparrowlen downarrowlen maxwidth mingaplen global children parentlist global commitidx curview - global rowchk set idlist [lindex $rowidlist $row] + if {!$last && $endrow + $uparrowlen + $mingaplen > $commitidx($curview)} { + set endrow [expr {$commitidx($curview) - $uparrowlen - $mingaplen}] + } while {$row < $endrow} { set id [lindex $displayorder $row] - if {1} { - if {!$last && - $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break - for {set x [llength $idlist]} {[incr x -1] >= 0} {} { - set i [lindex $idlist $x] - if {![info exists rowchk($i)] || $row >= $rowchk($i)} { - set r [usedinrange $i [expr {$row - $downarrowlen}] \ - [expr {$row + $uparrowlen + $mingaplen}]] - if {$r == 0} { - set idlist [lreplace $idlist $x $x] - continue - } - set rowchk($i) [expr {$row + $r}] + if {$row > $downarrowlen} { + set termrow [expr {$row - $downarrowlen - 1}] + foreach p [lindex $parentlist $termrow] { + set i [lsearch -exact $idlist $p] + if {$i < 0} continue + set nr [nextuse $p $termrow] + if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} { + set idlist [lreplace $idlist $i $i] } } lset rowidlist $row $idlist @@ -3958,7 +3969,7 @@ proc insertrow {row newcmit} { global displayorder parentlist commitlisted children global commitrow curview rowidlist numcommits global rowlaidout rowoptim numcommits - global selectedline rowchk commitidx + global selectedline commitidx if {$row >= $numcommits} { puts "oops, inserting new row $row but only have $numcommits rows" @@ -3989,8 +4000,6 @@ proc insertrow {row newcmit} { } set rowidlist [linsert $rowidlist $row $idlist] - catch {unset rowchk} - incr rowlaidout incr rowoptim incr numcommits @@ -4006,7 +4015,7 @@ proc removerow {row} { global displayorder parentlist commitlisted children global commitrow curview rowidlist numcommits global rowlaidout rowoptim numcommits - global linesegends selectedline rowchk commitidx + global linesegends selectedline commitidx if {$row >= $numcommits} { puts "oops, removing row $row but only have $numcommits rows" @@ -4033,8 +4042,6 @@ proc removerow {row} { set rowidlist [lreplace $rowidlist $row $row] - catch {unset rowchk} - incr rowlaidout -1 incr rowoptim -1 incr numcommits -1 -- cgit v1.2.3 From 0380081c65c3e8a46caad9aebe8e97ff65510453 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Wed, 29 Aug 2007 21:45:21 +1000 Subject: gitk: Do only the parts of the layout that are needed This changes layoutrows and optimize_rows to make it possible to lay out only a little bit more of the graph than is visible, rather than having to lay out the whole graph from top to bottom. To lay out some of the graph without starting at the top, we use the new make_idlist procedure for the first row, then lay it out proceeding downwards as before. Empty list elements in rowidlist are used to denote rows that haven't been laid out yet. Optimizing happens much as before except that we don't try to optimize unless we have three consecutive rows laid out (or the top 2 rows). We have a new list, rowisopt, to record which rows have been optimized. If we change a row that has already been drawn, we set a flag which causes drawcommits to throw away everything drawn on the canvas and redraw the visible rows. Signed-off-by: Paul Mackerras --- gitk | 488 ++++++++++++++++++++++++++++++++++++------------------------------- 1 file changed, 263 insertions(+), 225 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 7726c311c5..060c4c0cb2 100755 --- a/gitk +++ b/gitk @@ -1949,13 +1949,13 @@ proc unflatten {var l} { proc showview {n} { global curview viewdata viewfiles - global displayorder parentlist rowidlist + global displayorder parentlist rowidlist rowisopt global colormap rowtextx commitrow nextcolor canvxmax global numcommits commitlisted global selectedline currentid canv canvy0 global treediffs global pending_select phase - global commitidx rowlaidout rowoptim + global commitidx global commfd global selectedview selectfirst global vparentlist vdisporder vcmitlisted @@ -1987,11 +1987,11 @@ proc showview {n} { set vcmitlisted($curview) $commitlisted if {$phase ne {}} { set viewdata($curview) \ - [list $phase $rowidlist $rowlaidout $rowoptim $numcommits] + [list $phase $rowidlist $rowisopt $numcommits] } elseif {![info exists viewdata($curview)] || [lindex $viewdata($curview) 0] ne {}} { set viewdata($curview) \ - [list {} $rowidlist] + [list {} $rowidlist $rowisopt] } } catch {unset treediffs} @@ -2021,12 +2021,11 @@ proc showview {n} { set parentlist $vparentlist($n) set commitlisted $vcmitlisted($n) set rowidlist [lindex $v 1] + set rowisopt [lindex $v 2] if {$phase eq {}} { set numcommits [llength $displayorder] } else { - set rowlaidout [lindex $v 2] - set rowoptim [lindex $v 3] - set numcommits [lindex $v 4] + set numcommits [lindex $v 3] } catch {unset colormap} @@ -2625,45 +2624,16 @@ proc shortids {ids} { return $res } -proc incrange {l x o} { - set n [llength $l] - while {$x < $n} { - set e [lindex $l $x] - if {$e ne {}} { - lset l $x [expr {$e + $o}] - } - incr x - } - return $l -} - proc ntimes {n o} { set ret {} - for {} {$n > 0} {incr n -1} { - lappend ret $o - } - return $ret -} - -proc usedinrange {id l1 l2} { - global children commitrow curview - - if {[info exists commitrow($curview,$id)]} { - set r $commitrow($curview,$id) - if {$l1 <= $r && $r <= $l2} { - return [expr {$r - $l1 + 1}] - } - } - set kids $children($curview,$id) - foreach c $kids { - if {[info exists commitrow($curview,$c)]} { - set r $commitrow($curview,$c) - if {$l1 <= $r && $r <= $l2} { - return [expr {$r - $l1 + 1}] - } + set o [list $o] + for {set mask 1} {$mask <= $n} {incr mask $mask} { + if {($n & $mask) != 0} { + set ret [concat $ret $o] } + set o [concat $o $o] } - return 0 + return $ret } # Work out where id should go in idlist so that order-token @@ -2689,20 +2659,8 @@ proc idcol {idlist id {i 0}} { return $i } -proc makeuparrow {oid y x} { - global rowidlist uparrowlen displayorder - - for {set i 0} {$i < $uparrowlen && $y > 1} {incr i} { - incr y -1 - set idl [lindex $rowidlist $y] - set x [idcol $idl $oid $x] - lset rowidlist $y [linsert $idl $x $oid] - } -} - proc initlayout {} { - global rowidlist displayorder commitlisted - global rowlaidout rowoptim + global rowidlist rowisopt displayorder commitlisted global numcommits canvxmax canv global nextcolor global parentlist @@ -2714,9 +2672,8 @@ proc initlayout {} { set commitlisted {} set parentlist {} set nextcolor 0 - set rowidlist {{}} - set rowlaidout 0 - set rowoptim 0 + set rowidlist {} + set rowisopt {} set canvxmax [$canv cget -width] catch {unset colormap} catch {unset rowtextx} @@ -2752,54 +2709,18 @@ proc visiblerows {} { } proc layoutmore {tmax allread} { - global rowlaidout rowoptim commitidx numcommits optim_delay - global uparrowlen curview rowidlist + global commitidx numcommits + global uparrowlen downarrowlen mingaplen curview - set showlast 0 - set showdelay $optim_delay - set optdelay [expr {$uparrowlen + 1}] - while {1} { - if {$rowoptim - $showdelay > $numcommits} { - showstuff [expr {$rowoptim - $showdelay}] $showlast - } elseif {$rowlaidout - $optdelay > $rowoptim} { - set nr [expr {$rowlaidout - $optdelay - $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 > 200} { - set nr 200 - } - set row $rowlaidout - set rowlaidout [layoutrows $row [expr {$row + $nr}] $allread] - if {$rowlaidout == $row} { - return 0 - } - } elseif {$allread} { - set optdelay 0 - set nrows $commitidx($curview) - if {[lindex $rowidlist $nrows] ne {}} { - layouttail - set rowlaidout $commitidx($curview) - } elseif {$rowoptim == $nrows} { - set showdelay 0 - set showlast 1 - if {$numcommits == $nrows} { - return 0 - } - } - } else { - return 0 - } - if {$tmax ne {} && [clock clicks -milliseconds] >= $tmax} { - return 1 - } + set show $commitidx($curview) + if {!$allread} { + set delay [expr {$uparrowlen + $mingaplen + $downarrowlen + 3}] + set show [expr {$show - $delay}] + } + if {$show > $numcommits} { + showstuff $show $allread } + return 0 } proc showstuff {canshow last} { @@ -2966,8 +2887,10 @@ proc nextuse {id row} { if {[info exists children($curview,$id)]} { foreach kid $children($curview,$id) { - if {[info exists commitrow($curview,$kid)] && - $commitrow($curview,$kid) > $row} { + if {![info exists commitrow($curview,$kid)]} { + return -1 + } + if {$commitrow($curview,$kid) > $row} { return $commitrow($curview,$kid) } } @@ -2978,97 +2901,171 @@ proc nextuse {id row} { return -1 } -proc layoutrows {row endrow last} { - global rowidlist displayorder - global uparrowlen downarrowlen maxwidth mingaplen - global children parentlist - global commitidx curview +proc make_idlist {row} { + global displayorder parentlist uparrowlen downarrowlen mingaplen + global commitidx curview ordertok children commitrow - set idlist [lindex $rowidlist $row] - if {!$last && $endrow + $uparrowlen + $mingaplen > $commitidx($curview)} { - set endrow [expr {$commitidx($curview) - $uparrowlen - $mingaplen}] + set r [expr {$row - $mingaplen - $downarrowlen - 1}] + if {$r < 0} { + set r 0 } - while {$row < $endrow} { - set id [lindex $displayorder $row] - if {$row > $downarrowlen} { - set termrow [expr {$row - $downarrowlen - 1}] - foreach p [lindex $parentlist $termrow] { - set i [lsearch -exact $idlist $p] - if {$i < 0} continue - set nr [nextuse $p $termrow] - if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} { - set idlist [lreplace $idlist $i $i] - } + set ra [expr {$row - $downarrowlen}] + if {$ra < 0} { + set ra 0 + } + set rb [expr {$row + $uparrowlen}] + if {$rb > $commitidx($curview)} { + set rb $commitidx($curview) + } + set ids {} + for {} {$r < $ra} {incr r} { + set nextid [lindex $displayorder [expr {$r + 1}]] + foreach p [lindex $parentlist $r] { + if {$p eq $nextid} continue + set rn [nextuse $p $r] + if {$rn >= $row && + $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} { + lappend ids [list $ordertok($curview,$p) $p] } - lset rowidlist $row $idlist } - set oldolds {} - set newolds {} - foreach p [lindex $parentlist $row] { - # is id the first child of this parent? - if {$id eq [lindex $children($curview,$p) 0]} { - lappend newolds $p - } elseif {[lsearch -exact $idlist $p] < 0} { - lappend oldolds $p + } + for {} {$r < $row} {incr r} { + set nextid [lindex $displayorder [expr {$r + 1}]] + foreach p [lindex $parentlist $r] { + if {$p eq $nextid} continue + set rn [nextuse $p $r] + if {$rn < 0 || $rn >= $row} { + lappend ids [list $ordertok($curview,$p) $p] } } - set col [lsearch -exact $idlist $id] - if {$col < 0} { - set col [idcol $idlist $id] - set idlist [linsert $idlist $col $id] - lset rowidlist $row $idlist - if {$children($curview,$id) ne {}} { - makeuparrow $id $row $col + } + set id [lindex $displayorder $row] + lappend ids [list $ordertok($curview,$id) $id] + while {$r < $rb} { + foreach p [lindex $parentlist $r] { + set firstkid [lindex $children($curview,$p) 0] + if {$commitrow($curview,$firstkid) < $row} { + lappend ids [list $ordertok($curview,$p) $p] } } - incr row - set idlist [lreplace $idlist $col $col] - set x $col - foreach i $newolds { - set x [idcol $idlist $i $x] - set idlist [linsert $idlist $x $i] - } - foreach oid $oldolds { - set x [idcol $idlist $oid $x] - set idlist [linsert $idlist $x $oid] - makeuparrow $oid $row $x + incr r + set id [lindex $displayorder $r] + if {$id ne {}} { + set firstkid [lindex $children($curview,$id) 0] + if {$firstkid ne {} && $commitrow($curview,$firstkid) < $row} { + lappend ids [list $ordertok($curview,$id) $id] + } } - lappend rowidlist $idlist } - return $row + set idlist {} + foreach idx [lsort -unique $ids] { + lappend idlist [lindex $idx 1] + } + return $idlist } -proc addextraid {id row} { - global displayorder commitrow commitinfo - global commitidx commitlisted - global parentlist children curview +proc layoutrows {row endrow} { + global rowidlist rowisopt displayorder + global uparrowlen downarrowlen maxwidth mingaplen + global children parentlist + global commitidx curview commitrow - incr commitidx($curview) - lappend displayorder $id - lappend commitlisted 0 - lappend parentlist {} - set commitrow($curview,$id) $row - readcommit $id - if {![info exists commitinfo($id)]} { - set commitinfo($id) {"No commit information available"} + set idlist {} + if {$row > 0} { + foreach id [lindex $rowidlist [expr {$row - 1}]] { + if {$id ne {}} { + lappend idlist $id + } + } } - if {![info exists children($curview,$id)]} { - set children($curview,$id) {} + for {} {$row < $endrow} {incr row} { + set rm1 [expr {$row - 1}] + if {$rm1 < 0 || [lindex $rowidlist $rm1] eq {}} { + set idlist [make_idlist $row] + } else { + set id [lindex $displayorder $rm1] + set col [lsearch -exact $idlist $id] + set idlist [lreplace $idlist $col $col] + foreach p [lindex $parentlist $rm1] { + if {[lsearch -exact $idlist $p] < 0} { + set col [idcol $idlist $p $col] + set idlist [linsert $idlist $col $p] + } + } + set id [lindex $displayorder $row] + if {$row > $downarrowlen} { + set termrow [expr {$row - $downarrowlen - 1}] + foreach p [lindex $parentlist $termrow] { + set i [lsearch -exact $idlist $p] + if {$i < 0} continue + set nr [nextuse $p $termrow] + if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} { + set idlist [lreplace $idlist $i $i] + } + } + } + set col [lsearch -exact $idlist $id] + if {$col < 0} { + set col [idcol $idlist $id] + set idlist [linsert $idlist $col $id] + } + set r [expr {$row + $uparrowlen - 1}] + if {$r < $commitidx($curview)} { + set x $col + foreach p [lindex $parentlist $r] { + if {[lsearch -exact $idlist $p] >= 0} continue + set fk [lindex $children($curview,$p) 0] + if {$commitrow($curview,$fk) < $row} { + set x [idcol $idlist $p $x] + set idlist [linsert $idlist $x $p] + } + } + if {[incr r] < $commitidx($curview)} { + set p [lindex $displayorder $r] + if {[lsearch -exact $idlist $p] < 0} { + set fk [lindex $children($curview,$p) 0] + if {$fk ne {} && $commitrow($curview,$fk) < $row} { + set x [idcol $idlist $p $x] + set idlist [linsert $idlist $x $p] + } + } + } + } + } + set l [llength $rowidlist] + if {$row == $l} { + lappend rowidlist $idlist + lappend rowisopt 0 + } elseif {$row < $l} { + if {$idlist ne [lindex $rowidlist $row]} { + lset rowidlist $row $idlist + changedrow $row + } + } else { + set rowidlist [concat $rowidlist [ntimes [expr {$row - $l}] {}]] + lappend rowidlist $idlist + set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]] + } } + return $row } -proc layouttail {} { - global rowidlist commitidx curview +proc changedrow {row} { + global displayorder iddrawn rowisopt need_redisplay - set row $commitidx($curview) - set idlist [lindex $rowidlist $row] - while {$idlist ne {}} { - set col [expr {[llength $idlist] - 1}] - set id [lindex $idlist $col] - addextraid $id $row - incr row - set idlist [lreplace $idlist $col $col] - lappend rowidlist $idlist + set l [llength $rowisopt] + if {$row < $l} { + lset rowisopt $row 0 + if {$row + 1 < $l} { + lset rowisopt [expr {$row + 1}] 0 + if {$row + 2 < $l} { + lset rowisopt [expr {$row + 2}] 0 + } + } + } + set id [lindex $displayorder $row] + if {[info exists iddrawn($id)]} { + set need_redisplay 1 } } @@ -3084,27 +3081,29 @@ proc insert_pad {row col npad} { set aft [lreplace $aft $i $i] } lset rowidlist $row [concat $bef $pad $aft] + changedrow $row } proc optimize_rows {row col endrow} { - global rowidlist displayorder curview children + global rowidlist rowisopt displayorder curview children if {$row < 1} { set row 1 } - set idlist [lindex $rowidlist [expr {$row - 1}]] - if {$row >= 2} { - set previdlist [lindex $rowidlist [expr {$row - 2}]] - } else { - set previdlist {} - } - for {} {$row < $endrow} {incr row} { - set pprevidlist $previdlist - set previdlist $idlist - set idlist [lindex $rowidlist $row] + for {} {$row < $endrow} {incr row; set col 0} { + if {[lindex $rowisopt $row]} continue set haspad 0 set y0 [expr {$row - 1}] set ym [expr {$row - 2}] + set idlist [lindex $rowidlist $row] + set previdlist [lindex $rowidlist $y0] + if {$idlist eq {} || $previdlist eq {}} continue + if {$ym >= 0} { + set pprevidlist [lindex $rowidlist $ym] + if {$pprevidlist eq {}} continue + } else { + set pprevidlist {} + } set x0 -1 set xm -1 for {} {$col < [llength $idlist]} {incr col} { @@ -3180,7 +3179,6 @@ proc optimize_rows {row col endrow} { incr x0 optimize_rows $y0 $x0 $row set previdlist [lindex $rowidlist $y0] - set pprevidlist [lindex $rowidlist $ym] } } if {!$haspad} { @@ -3203,10 +3201,10 @@ proc optimize_rows {row col endrow} { # isn't the last column if {$x0 >= 0 && [incr col] < [llength $idlist]} { set idlist [linsert $idlist $col {}] + lset rowidlist $row $idlist + changedrow $row } } - lset rowidlist $row $idlist - set col 0 } } @@ -3531,7 +3529,7 @@ proc drawcmittext {id row col} { global linespc canv canv2 canv3 canvy0 fgcolor curview global commitlisted commitinfo rowidlist parentlist global rowtextx idpos idtags idheads idotherrefs - global linehtag linentag linedtag + global linehtag linentag linedtag selectedline global mainfont canvxmax boldrows boldnamerows fgcolor nullid nullid2 # listed is 0 for boundary, 1 for normal, 2 for left, 3 for right @@ -3607,6 +3605,9 @@ proc drawcmittext {id row col} { -text $name -font $nfont -tags text] set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \ -text $date -font $mainfont -tags text] + if {[info exists selectedline] && $selectedline == $row} { + make_secsel $row + } set xr [expr {$xt + [font measure $mainfont $headline]}] if {$xr > $canvxmax} { set canvxmax $xr @@ -3615,7 +3616,7 @@ proc drawcmittext {id row col} { } proc drawcmitrow {row} { - global displayorder rowidlist + global displayorder rowidlist nrows_drawn global iddrawn markingmatches global commitinfo parentlist numcommits global filehighlight fhighlights findstring nhighlights @@ -3649,6 +3650,7 @@ proc drawcmitrow {row} { assigncolor $id drawcmittext $id $row $col set iddrawn($id) 1 + incr nrows_drawn } if {$markingmatches} { markrowmatches $row $id @@ -3656,8 +3658,8 @@ proc drawcmitrow {row} { } proc drawcommits {row {endrow {}}} { - global numcommits iddrawn displayorder curview - global parentlist rowidlist + global numcommits iddrawn displayorder curview need_redisplay + global parentlist rowidlist uparrowlen downarrowlen nrows_drawn if {$row < 0} { set row 0 @@ -3669,6 +3671,35 @@ proc drawcommits {row {endrow {}}} { set endrow [expr {$numcommits - 1}] } + set rl1 [expr {$row - $downarrowlen - 3}] + if {$rl1 < 0} { + set rl1 0 + } + set ro1 [expr {$row - 3}] + if {$ro1 < 0} { + set ro1 0 + } + set r2 [expr {$endrow + $uparrowlen + 3}] + if {$r2 > $numcommits} { + set r2 $numcommits + } + for {set r $rl1} {$r < $r2} {incr r} { + if {[lindex $rowidlist $r] ne {}} { + if {$rl1 < $r} { + layoutrows $rl1 $r + } + set rl1 [expr {$r + 1}] + } + } + if {$rl1 < $r} { + layoutrows $rl1 $r + } + optimize_rows $ro1 0 $r2 + if {$need_redisplay || $nrows_drawn > 2000} { + clear_display + drawvisible + } + # make the lines join to already-drawn rows either side set r [expr {$row - 1}] if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} { @@ -3736,7 +3767,7 @@ proc drawvisible {} { } proc clear_display {} { - global iddrawn linesegs + global iddrawn linesegs need_redisplay nrows_drawn global vhighlights fhighlights nhighlights rhighlights allcanvs delete all @@ -3746,6 +3777,8 @@ proc clear_display {} { catch {unset fhighlights} catch {unset nhighlights} catch {unset rhighlights} + set need_redisplay 0 + set nrows_drawn 0 } proc findcrossings {id} { @@ -3967,9 +4000,9 @@ proc show_status {msg} { # on that row and below will move down one row. proc insertrow {row newcmit} { global displayorder parentlist commitlisted children - global commitrow curview rowidlist numcommits - global rowlaidout rowoptim numcommits - global selectedline commitidx + global commitrow curview rowidlist rowisopt numcommits + global numcommits + global selectedline commitidx ordertok if {$row >= $numcommits} { puts "oops, inserting new row $row but only have $numcommits rows" @@ -3989,6 +4022,7 @@ proc insertrow {row newcmit} { set commitrow($curview,$id) $r } incr commitidx($curview) + set ordertok($curview,$newcmit) $ordertok($curview,$p) set idlist [lindex $rowidlist $row] if {[llength $kids] == 1} { @@ -3999,9 +4033,8 @@ proc insertrow {row newcmit} { lappend idlist $newcmit } set rowidlist [linsert $rowidlist $row $idlist] + set rowisopt [linsert $rowisopt $row 0] - incr rowlaidout - incr rowoptim incr numcommits if {[info exists selectedline] && $selectedline >= $row} { @@ -4013,8 +4046,8 @@ proc insertrow {row newcmit} { # Remove a commit that was inserted with insertrow on row $row. proc removerow {row} { global displayorder parentlist commitlisted children - global commitrow curview rowidlist numcommits - global rowlaidout rowoptim numcommits + global commitrow curview rowidlist rowisopt numcommits + global numcommits global linesegends selectedline commitidx if {$row >= $numcommits} { @@ -4041,9 +4074,8 @@ proc removerow {row} { incr commitidx($curview) -1 set rowidlist [lreplace $rowidlist $row $row] + set rowisopt [lreplace $rowisopt $row $row] - incr rowlaidout -1 - incr rowoptim -1 incr numcommits -1 if {[info exists selectedline] && $selectedline > $row} { @@ -4485,9 +4517,27 @@ proc dispnexttag {} { } } +proc make_secsel {l} { + global linehtag linentag linedtag canv canv2 canv3 + + if {![info exists linehtag($l)]} return + $canv delete secsel + set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \ + -tags secsel -fill [$canv cget -selectbackground]] + $canv lower $t + $canv2 delete secsel + set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \ + -tags secsel -fill [$canv2 cget -selectbackground]] + $canv2 lower $t + $canv3 delete secsel + set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \ + -tags secsel -fill [$canv3 cget -selectbackground]] + $canv3 lower $t +} + proc selectline {l isnew} { - global canv canv2 canv3 ctext commitinfo selectedline - global displayorder linehtag linentag linedtag + global canv ctext commitinfo selectedline + global displayorder global canvy0 linespc parentlist children curview global currentid sha1entry global commentend idtags linknum @@ -4536,19 +4586,7 @@ proc selectline {l isnew} { drawvisible } - if {![info exists linehtag($l)]} return - $canv delete secsel - set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \ - -tags secsel -fill [$canv cget -selectbackground]] - $canv lower $t - $canv2 delete secsel - set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \ - -tags secsel -fill [$canv2 cget -selectbackground]] - $canv2 lower $t - $canv3 delete secsel - set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \ - -tags secsel -fill [$canv3 cget -selectbackground]] - $canv3 lower $t + make_secsel $l if {$isnew} { addtohistory [list selectline $l 0] @@ -5616,7 +5654,7 @@ proc arrowjump {id n y} { } proc lineclick {x y id isnew} { - global ctext commitinfo children canv thickerline curview + global ctext commitinfo children canv thickerline curview commitrow if {![info exists commitinfo($id)] && ![getcommit $id]} return unmarkmatches @@ -7922,8 +7960,8 @@ set boldnamerows {} set diffelide {0 0} set markingmatches 0 set linkentercount 0 - -set optim_delay 16 +set need_redisplay 0 +set nrows_drawn 0 set nextviewnum 1 set curview 0 -- cgit v1.2.3 From df904497ecc15382199045bb257250c857f04eca Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Wed, 29 Aug 2007 22:03:07 +1000 Subject: gitk: Fix bug causing incorrect ref list contents when switching view If the view we're switching to hadn't been read in, we hit an early return in showview which meant we didn't update the ref list window. Signed-off-by: Paul Mackerras --- gitk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gitk') diff --git a/gitk b/gitk index 060c4c0cb2..0125f17fcd 100755 --- a/gitk +++ b/gitk @@ -2007,6 +2007,7 @@ proc showview {n} { .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}] .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}] + run refill_reflist if {![info exists viewdata($n)]} { if {$selid ne {}} { set pending_select $selid @@ -2070,7 +2071,6 @@ proc showview {n} { } elseif {$numcommits == 0} { show_status "No commits selected" } - run refill_reflist } # Stuff relating to the highlighting facility -- cgit v1.2.3 From 719c2b9d926bf2be4879015e3620d27d32f007b6 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Wed, 29 Aug 2007 22:41:34 +1000 Subject: gitk: Fix bug causing undefined variable error when cherry-picking When "Show nearby tags" is turned off and the user did a cherry-pick, we were trying to access variables relating to the descendent/ancestor tag & head computations in addnewchild though they hadn't been set. This makes sure we don't do that. Reported by Johannes Sixt. Signed-off-by: Paul Mackerras --- gitk | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'gitk') diff --git a/gitk b/gitk index b7730ae202..300fdceb35 100755 --- a/gitk +++ b/gitk @@ -6641,8 +6641,9 @@ proc splitarc {p} { proc addnewchild {id p} { global allids allparents allchildren idtags nextarc nbmp global arcnos arcids arctags arcout arcend arcstart archeads growing - global seeds + global seeds allcommits + if {![info exists allcommits]} return lappend allids $id set allparents($id) [list $p] set allchildren($id) {} -- cgit v1.2.3 From 6eaaccd12846c5957c3433c773ad60b8a4196045 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Wed, 29 Aug 2007 22:41:34 +1000 Subject: gitk: Fix bug causing undefined variable error when cherry-picking When "Show nearby tags" is turned off and the user did a cherry-pick, we were trying to access variables relating to the descendent/ancestor tag & head computations in addnewchild though they hadn't been set. This makes sure we don't do that. Reported by Johannes Sixt. Signed-off-by: Paul Mackerras --- gitk | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'gitk') diff --git a/gitk b/gitk index 0125f17fcd..22a6318421 100755 --- a/gitk +++ b/gitk @@ -6648,8 +6648,9 @@ proc splitarc {p} { proc addnewchild {id p} { global allids allparents allchildren idtags nextarc nbmp global arcnos arcids arctags arcout arcend arcstart archeads growing - global seeds + global seeds allcommits + if {![info exists allcommits]} return lappend allids $id set allparents($id) [list $p] set allchildren($id) {} -- cgit v1.2.3 From 5cd15b6b7f87dc61f729ad31a682ffc394560273 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Thu, 30 Aug 2007 21:54:17 +1000 Subject: gitk: Add a cache for the topology info This adds code to write out the topology information used to determine precedes/follows and branch information into a cache file (~3.5MB for the kernel tree). At startup we read the cache file and then do a git rev-list to update it, which is fast because we exclude all commits in the cache that have no children and commits reachable from them (which amounts to everything in the cache). If one of those commits without children no longer exists, then git rev-list will give an error, whereupon we throw away the cache and read in the whole tree again. This gives a significant speedup in the startup time for gitk. Signed-off-by: Paul Mackerras --- gitk | 259 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 237 insertions(+), 22 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 22a6318421..251e9242b3 100755 --- a/gitk +++ b/gitk @@ -6445,25 +6445,59 @@ proc refill_reflist {} { # Stuff for finding nearby tags proc getallcommits {} { - global allcommits allids nbmp nextarc seeds + global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate + global idheads idtags idotherrefs allparents tagobjid if {![info exists allcommits]} { - set allids {} - set nbmp 0 set nextarc 0 set allcommits 0 set seeds {} + set allcwait 0 + set cachedarcs 0 + set allccache [file join [gitdir] "gitk.cache"] + if {![catch { + set f [open $allccache r] + set allcwait 1 + getcache $f + }]} return } - set cmd [concat | git rev-list --all --parents] - foreach id $seeds { - lappend cmd "^$id" + if {$allcwait} { + return + } + set cmd [list | git rev-list --parents] + set allcupdate [expr {$seeds ne {}}] + if {!$allcupdate} { + set ids "--all" + } else { + set refs [concat [array names idheads] [array names idtags] \ + [array names idotherrefs]] + set ids {} + set tagobjs {} + foreach name [array names tagobjid] { + lappend tagobjs $tagobjid($name) + } + foreach id [lsort -unique $refs] { + if {![info exists allparents($id)] && + [lsearch -exact $tagobjs $id] < 0} { + lappend ids $id + } + } + if {$ids ne {}} { + foreach id $seeds { + lappend ids "^$id" + } + } + } + if {$ids ne {}} { + set fd [open [concat $cmd $ids] r] + fconfigure $fd -blocking 0 + incr allcommits + nowbusy allcommits + filerun $fd [list getallclines $fd] + } else { + dispneartags 0 } - set fd [open $cmd r] - fconfigure $fd -blocking 0 - incr allcommits - nowbusy allcommits - filerun $fd [list getallclines $fd] } # Since most commits have 1 parent and 1 child, we group strings of @@ -6482,10 +6516,10 @@ proc getallcommits {} { # coming from descendents, and "outgoing" means going towards ancestors. proc getallclines {fd} { - global allids allparents allchildren idtags idheads nextarc nbmp + global allparents allchildren idtags idheads nextarc global arcnos arcids arctags arcout arcend arcstart archeads growing - global seeds allcommits - + global seeds allcommits cachedarcs allcupdate + set nid 0 while {[incr nid] <= 1000 && [gets $fd line] >= 0} { set id [lindex $line 0] @@ -6493,7 +6527,7 @@ proc getallclines {fd} { # seen it already continue } - lappend allids $id + set cachedarcs 0 set olds [lrange $line 1 end] set allparents($id) $olds if {![info exists allchildren($id)]} { @@ -6524,7 +6558,6 @@ proc getallclines {fd} { continue } } - incr nbmp foreach a $arcnos($id) { lappend arcids($a) $id set arcend($a) $id @@ -6564,9 +6597,28 @@ proc getallclines {fd} { if {![eof $fd]} { return [expr {$nid >= 1000? 2: 1}] } - close $fd + set cacheok 1 + if {[catch { + fconfigure $fd -blocking 1 + close $fd + } err]} { + # got an error reading the list of commits + # if we were updating, try rereading the whole thing again + if {$allcupdate} { + incr allcommits -1 + dropcache $err + return + } + error_popup "Error reading commit topology information;\ + branch and preceding/following tag information\ + will be incomplete.\n($err)" + set cacheok 0 + } if {[incr allcommits -1] == 0} { notbusy allcommits + if {$cacheok} { + run savecache + } } dispneartags 0 return 0 @@ -6590,7 +6642,7 @@ proc recalcarc {a} { } proc splitarc {p} { - global arcnos arcids nextarc nbmp arctags archeads idtags idheads + global arcnos arcids nextarc arctags archeads idtags idheads global arcstart arcend arcout allparents growing set a $arcnos($p) @@ -6622,7 +6674,6 @@ proc splitarc {p} { set growing($na) 1 unset growing($a) } - incr nbmp foreach id $tail { if {[llength $arcnos($id)] == 1} { @@ -6646,17 +6697,15 @@ proc splitarc {p} { # Update things for a new commit added that is a child of one # existing commit. Used when cherry-picking. proc addnewchild {id p} { - global allids allparents allchildren idtags nextarc nbmp + global allparents allchildren idtags nextarc global arcnos arcids arctags arcout arcend arcstart archeads growing global seeds allcommits if {![info exists allcommits]} return - lappend allids $id set allparents($id) [list $p] set allchildren($id) {} set arcnos($id) {} lappend seeds $id - incr nbmp lappend allchildren($p) $id set a [incr nextarc] set arcstart($a) $id @@ -6671,6 +6720,172 @@ proc addnewchild {id p} { set arcout($id) [list $a] } +# This implements a cache for the topology information. +# The cache saves, for each arc, the start and end of the arc, +# the ids on the arc, and the outgoing arcs from the end. +proc readcache {f} { + global arcnos arcids arcout arcstart arcend arctags archeads nextarc + global idtags idheads allparents cachedarcs possible_seeds seeds growing + global allcwait + + set a $nextarc + set lim $cachedarcs + if {$lim - $a > 500} { + set lim [expr {$a + 500}] + } + if {[catch { + if {$a == $lim} { + # finish reading the cache and setting up arctags, etc. + set line [gets $f] + if {$line ne "1"} {error "bad final version"} + close $f + foreach id [array names idtags] { + if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 && + [llength $allparents($id)] == 1} { + set a [lindex $arcnos($id) 0] + if {$arctags($a) eq {}} { + recalcarc $a + } + } + } + foreach id [array names idheads] { + if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 && + [llength $allparents($id)] == 1} { + set a [lindex $arcnos($id) 0] + if {$archeads($a) eq {}} { + recalcarc $a + } + } + } + foreach id [lsort -unique $possible_seeds] { + if {$arcnos($id) eq {}} { + lappend seeds $id + } + } + set allcwait 0 + } else { + while {[incr a] <= $lim} { + set line [gets $f] + if {[llength $line] != 3} {error "bad line"} + set s [lindex $line 0] + set arcstart($a) $s + lappend arcout($s) $a + if {![info exists arcnos($s)]} { + lappend possible_seeds $s + set arcnos($s) {} + } + set e [lindex $line 1] + if {$e eq {}} { + set growing($a) 1 + } else { + set arcend($a) $e + if {![info exists arcout($e)]} { + set arcout($e) {} + } + } + set arcids($a) [lindex $line 2] + foreach id $arcids($a) { + lappend allparents($s) $id + set s $id + lappend arcnos($id) $a + } + if {![info exists allparents($s)]} { + set allparents($s) {} + } + set arctags($a) {} + set archeads($a) {} + } + set nextarc [expr {$a - 1}] + } + } err]} { + dropcache $err + return 0 + } + if {!$allcwait} { + getallcommits + } + return $allcwait +} + +proc getcache {f} { + global nextarc cachedarcs possible_seeds + + if {[catch { + set line [gets $f] + if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"} + # make sure it's an integer + set cachedarcs [expr {int([lindex $line 1])}] + if {$cachedarcs < 0} {error "bad number of arcs"} + set nextarc 0 + set possible_seeds {} + run readcache $f + } err]} { + dropcache $err + } + return 0 +} + +proc dropcache {err} { + global allcwait nextarc cachedarcs seeds + + #puts "dropping cache ($err)" + foreach v {arcnos arcout arcids arcstart arcend growing \ + arctags archeads allparents allchildren} { + global $v + catch {unset $v} + } + set allcwait 0 + set nextarc 0 + set cachedarcs 0 + set seeds {} + getallcommits +} + +proc writecache {f} { + global cachearc cachedarcs allccache + global arcstart arcend arcnos arcids arcout + + set a $cachearc + set lim $cachedarcs + if {$lim - $a > 1000} { + set lim [expr {$a + 1000}] + } + if {[catch { + while {[incr a] <= $lim} { + if {[info exists arcend($a)]} { + puts $f [list $arcstart($a) $arcend($a) $arcids($a)] + } else { + puts $f [list $arcstart($a) {} $arcids($a)] + } + } + } err]} { + catch {close $f} + catch {file delete $allccache} + #puts "writing cache failed ($err)" + return 0 + } + set cachearc [expr {$a - 1}] + if {$a > $cachedarcs} { + puts $f "1" + close $f + return 0 + } + return 1 +} + +proc savecache {} { + global nextarc cachedarcs cachearc allccache + + if {$nextarc == $cachedarcs} return + set cachearc 0 + set cachedarcs $nextarc + catch { + set f [open $allccache w] + puts $f [list 1 $cachedarcs] + run writecache $f + } +} + # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a, # or 0 if neither is true. proc anc_or_desc {a b} { -- cgit v1.2.3 From f5f3c2e29f51a38261daa91073a3f227d4532325 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Wed, 5 Sep 2007 02:19:56 +1000 Subject: gitk: Make it possible to lay out all the rows we have received so far This arranges things so that we can do the layout all the way up to the last commit that we have received from git log. If we get more commits we re-lay and redisplay (if necessary) the visible rows. Signed-off-by: Paul Mackerras --- gitk | 127 ++++++++++++++++++++++++++++++++++++++++++++++++------------------- 1 file changed, 91 insertions(+), 36 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 251e9242b3..a042efe260 100755 --- a/gitk +++ b/gitk @@ -82,11 +82,12 @@ proc dorunq {} { proc start_rev_list {view} { global startmsecs global commfd leftover tclencoding datemode - global viewargs viewfiles commitidx vnextroot + global viewargs viewfiles commitidx viewcomplete vnextroot global lookingforhead showlocalchanges set startmsecs [clock clicks -milliseconds] set commitidx($view) 0 + set viewcomplete($view) 0 set vnextroot($view) 0 set order "--topo-order" if {$datemode} { @@ -148,7 +149,7 @@ proc strrep {n} { proc getcommitlines {fd view} { global commitlisted global leftover commfd - global displayorder commitidx commitrow commitdata + global displayorder commitidx viewcomplete commitrow commitdata global parentlist children curview hlview global vparentlist vdisporder vcmitlisted global ordertok vnextroot idpending @@ -179,6 +180,7 @@ proc getcommitlines {fd view} { lappend vcmitlisted($view) 0 } } + set viewcomplete($view) 1 global viewname unset commfd($view) notbusy $view @@ -310,15 +312,12 @@ proc getcommitlines {fd view} { } proc chewcommits {view} { - global curview hlview commfd + global curview hlview viewcomplete global selectedline pending_select - set more 0 if {$view == $curview} { - set allread [expr {![info exists commfd($view)]}] - set tlimit [expr {[clock clicks -milliseconds] + 50}] - set more [layoutmore $tlimit $allread] - if {$allread && !$more} { + layoutmore + if {$viewcomplete($view)} { global displayorder commitidx phase global numcommits startmsecs @@ -339,7 +338,7 @@ proc chewcommits {view} { if {[info exists hlview] && $view == $hlview} { vhighlightmore } - return $more + return 0 } proc readcommit {id} { @@ -1949,7 +1948,7 @@ proc unflatten {var l} { proc showview {n} { global curview viewdata viewfiles - global displayorder parentlist rowidlist rowisopt + global displayorder parentlist rowidlist rowisopt rowfinal global colormap rowtextx commitrow nextcolor canvxmax global numcommits commitlisted global selectedline currentid canv canvy0 @@ -1985,13 +1984,11 @@ proc showview {n} { set vparentlist($curview) $parentlist set vdisporder($curview) $displayorder set vcmitlisted($curview) $commitlisted - if {$phase ne {}} { - set viewdata($curview) \ - [list $phase $rowidlist $rowisopt $numcommits] - } elseif {![info exists viewdata($curview)] - || [lindex $viewdata($curview) 0] ne {}} { + if {$phase ne {} || + ![info exists viewdata($curview)] || + [lindex $viewdata($curview) 0] ne {}} { set viewdata($curview) \ - [list {} $rowidlist $rowisopt] + [list $phase $rowidlist $rowisopt $rowfinal] } } catch {unset treediffs} @@ -2023,11 +2020,8 @@ proc showview {n} { set commitlisted $vcmitlisted($n) set rowidlist [lindex $v 1] set rowisopt [lindex $v 2] - if {$phase eq {}} { - set numcommits [llength $displayorder] - } else { - set numcommits [lindex $v 3] - } + set rowfinal [lindex $v 3] + set numcommits $commitidx($n) catch {unset colormap} catch {unset rowtextx} @@ -2660,7 +2654,7 @@ proc idcol {idlist id {i 0}} { } proc initlayout {} { - global rowidlist rowisopt displayorder commitlisted + global rowidlist rowisopt rowfinal displayorder commitlisted global numcommits canvxmax canv global nextcolor global parentlist @@ -2674,6 +2668,7 @@ proc initlayout {} { set nextcolor 0 set rowidlist {} set rowisopt {} + set rowfinal {} set canvxmax [$canv cget -width] catch {unset colormap} catch {unset rowtextx} @@ -2708,19 +2703,14 @@ proc visiblerows {} { return [list $r0 $r1] } -proc layoutmore {tmax allread} { - global commitidx numcommits +proc layoutmore {} { + global commitidx viewcomplete numcommits global uparrowlen downarrowlen mingaplen curview set show $commitidx($curview) - if {!$allread} { - set delay [expr {$uparrowlen + $mingaplen + $downarrowlen + 3}] - set show [expr {$show - $delay}] - } if {$show > $numcommits} { - showstuff $show $allread + showstuff $show $viewcomplete($curview) } - return 0 } proc showstuff {canshow last} { @@ -2901,6 +2891,21 @@ proc nextuse {id row} { return -1 } +proc prevuse {id row} { + global commitrow curview children + + set ret -1 + if {[info exists children($curview,$id)]} { + foreach kid $children($curview,$id) { + if {![info exists commitrow($curview,$kid)]} break + if {$commitrow($curview,$kid) < $row} { + set ret $commitrow($curview,$kid) + } + } + } + return $ret +} + proc make_idlist {row} { global displayorder parentlist uparrowlen downarrowlen mingaplen global commitidx curview ordertok children commitrow @@ -2964,11 +2969,42 @@ proc make_idlist {row} { return $idlist } +proc rowsequal {a b} { + while {[set i [lsearch -exact $a {}]] >= 0} { + set a [lreplace $a $i $i] + } + while {[set i [lsearch -exact $b {}]] >= 0} { + set b [lreplace $b $i $i] + } + return [expr {$a eq $b}] +} + +proc makeupline {id row rend col} { + global rowidlist uparrowlen downarrowlen mingaplen + + for {set r $rend} {1} {set r $rstart} { + set rstart [prevuse $id $r] + if {$rstart < 0} return + if {$rstart < $row} break + } + if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} { + set rstart [expr {$rend - $uparrowlen - 1}] + } + for {set r $rstart} {[incr r] <= $row} {} { + set idlist [lindex $rowidlist $r] + if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} { + set col [idcol $idlist $id $col] + lset rowidlist $r [linsert $idlist $col $id] + changedrow $r + } + } +} + proc layoutrows {row endrow} { - global rowidlist rowisopt displayorder + global rowidlist rowisopt rowfinal displayorder global uparrowlen downarrowlen maxwidth mingaplen global children parentlist - global commitidx curview commitrow + global commitidx viewcomplete curview commitrow set idlist {} if {$row > 0} { @@ -2982,14 +3018,20 @@ proc layoutrows {row endrow} { set rm1 [expr {$row - 1}] if {$rm1 < 0 || [lindex $rowidlist $rm1] eq {}} { set idlist [make_idlist $row] + set final 1 } else { set id [lindex $displayorder $rm1] + set final [lindex $rowfinal $rm1] set col [lsearch -exact $idlist $id] set idlist [lreplace $idlist $col $col] foreach p [lindex $parentlist $rm1] { if {[lsearch -exact $idlist $p] < 0} { set col [idcol $idlist $p $col] set idlist [linsert $idlist $col $p] + # if not the first child, we have to insert a line going up + if {$id ne [lindex $children($curview,$p) 0]} { + makeupline $p $rm1 $row $col + } } } set id [lindex $displayorder $row] @@ -3008,6 +3050,9 @@ proc layoutrows {row endrow} { if {$col < 0} { set col [idcol $idlist $id] set idlist [linsert $idlist $col $id] + if {$children($curview,$id) ne {}} { + makeupline $id $rm1 $row $col + } } set r [expr {$row + $uparrowlen - 1}] if {$r < $commitidx($curview)} { @@ -3032,18 +3077,28 @@ proc layoutrows {row endrow} { } } } + if {$final && !$viewcomplete($curview) && + $row + $uparrowlen + $mingaplen + $downarrowlen + >= $commitidx($curview)} { + set final 0 + } set l [llength $rowidlist] if {$row == $l} { lappend rowidlist $idlist lappend rowisopt 0 + lappend rowfinal $final } elseif {$row < $l} { - if {$idlist ne [lindex $rowidlist $row]} { + if {![rowsequal $idlist [lindex $rowidlist $row]]} { lset rowidlist $row $idlist + lset rowfinal $row $final changedrow $row } } else { - set rowidlist [concat $rowidlist [ntimes [expr {$row - $l}] {}]] + set pad [ntimes [expr {$row - $l}] {}] + set rowidlist [concat $rowidlist $pad] lappend rowidlist $idlist + set rowfinal [concat $rowfinal $pad] + lappend rowfinal $final set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]] } } @@ -3659,7 +3714,7 @@ proc drawcmitrow {row} { proc drawcommits {row {endrow {}}} { global numcommits iddrawn displayorder curview need_redisplay - global parentlist rowidlist uparrowlen downarrowlen nrows_drawn + global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn if {$row < 0} { set row 0 @@ -3684,7 +3739,7 @@ proc drawcommits {row {endrow {}}} { set r2 $numcommits } for {set r $rl1} {$r < $r2} {incr r} { - if {[lindex $rowidlist $r] ne {}} { + if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} { if {$rl1 < $r} { layoutrows $rl1 $r } -- cgit v1.2.3 From f56782aef4b3d7339461d8f12ff15f6258d9871d Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Sat, 15 Sep 2007 09:04:11 +1000 Subject: gitk: Fix bugs in setting rowfinal We weren't updating the rowfinal list in insertrow and removerow, so it was getting out of sync with rowidlist, which resulted in Tcl errors. This also optimizes the setting of rowfinal in layoutrows a bit. Signed-off-by: Paul Mackerras --- gitk | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index a042efe260..fd6bbab3ed 100755 --- a/gitk +++ b/gitk @@ -3008,20 +3008,21 @@ proc layoutrows {row endrow} { set idlist {} if {$row > 0} { - foreach id [lindex $rowidlist [expr {$row - 1}]] { + set rm1 [expr {$row - 1}] + foreach id [lindex $rowidlist $rm1] { if {$id ne {}} { lappend idlist $id } } + set final [lindex $rowfinal $rm1] } for {} {$row < $endrow} {incr row} { set rm1 [expr {$row - 1}] - if {$rm1 < 0 || [lindex $rowidlist $rm1] eq {}} { + if {$rm1 < 0 || $idlist eq {}} { set idlist [make_idlist $row] set final 1 } else { set id [lindex $displayorder $rm1] - set final [lindex $rowfinal $rm1] set col [lsearch -exact $idlist $id] set idlist [lreplace $idlist $col $col] foreach p [lindex $parentlist $rm1] { @@ -3090,9 +3091,9 @@ proc layoutrows {row endrow} { } elseif {$row < $l} { if {![rowsequal $idlist [lindex $rowidlist $row]]} { lset rowidlist $row $idlist - lset rowfinal $row $final changedrow $row } + lset rowfinal $row $final } else { set pad [ntimes [expr {$row - $l}] {}] set rowidlist [concat $rowidlist $pad] @@ -4055,7 +4056,7 @@ proc show_status {msg} { # on that row and below will move down one row. proc insertrow {row newcmit} { global displayorder parentlist commitlisted children - global commitrow curview rowidlist rowisopt numcommits + global commitrow curview rowidlist rowisopt rowfinal numcommits global numcommits global selectedline commitidx ordertok @@ -4089,6 +4090,7 @@ proc insertrow {row newcmit} { } set rowidlist [linsert $rowidlist $row $idlist] set rowisopt [linsert $rowisopt $row 0] + set rowfinal [linsert $rowfinal $row [lindex $rowfinal $row]] incr numcommits @@ -4101,7 +4103,7 @@ proc insertrow {row newcmit} { # Remove a commit that was inserted with insertrow on row $row. proc removerow {row} { global displayorder parentlist commitlisted children - global commitrow curview rowidlist rowisopt numcommits + global commitrow curview rowidlist rowisopt rowfinal numcommits global numcommits global linesegends selectedline commitidx @@ -4130,6 +4132,7 @@ proc removerow {row} { set rowidlist [lreplace $rowidlist $row $row] set rowisopt [lreplace $rowisopt $row $row] + set rowfinal [lreplace $rowfinal $row $row] incr numcommits -1 -- cgit v1.2.3 From 3e6b893f33476e7969c7bd5b8914e8bcc62385e3 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Sat, 15 Sep 2007 09:33:39 +1000 Subject: gitk: Get rid of lookingforhead, use commitinterest instead Now that we have a general-purpose way of taking some action when a commit ID of interest is encountered, use that for triggering the git diff-index process when we find the currently checked-out head, rather than the special-purpose lookingforhead variable. Also do the commitinterest processing in getcommitlines rather than in showstuff. Signed-off-by: Paul Mackerras --- gitk | 42 +++++++++++++++++------------------------- 1 file changed, 17 insertions(+), 25 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index fd6bbab3ed..85d33abf4a 100755 --- a/gitk +++ b/gitk @@ -83,7 +83,7 @@ proc start_rev_list {view} { global startmsecs global commfd leftover tclencoding datemode global viewargs viewfiles commitidx viewcomplete vnextroot - global lookingforhead showlocalchanges + global showlocalchanges commitinterest mainheadid set startmsecs [clock clicks -milliseconds] set commitidx($view) 0 @@ -102,7 +102,9 @@ proc start_rev_list {view} { } set commfd($view) $fd set leftover($view) {} - set lookingforhead $showlocalchanges + if {$showlocalchanges} { + lappend commitinterest($mainheadid) {dodiffindex} + } fconfigure $fd -blocking 0 -translation lf -eofchar {} if {$tclencoding != {}} { fconfigure $fd -encoding $tclencoding @@ -147,7 +149,7 @@ proc strrep {n} { } proc getcommitlines {fd view} { - global commitlisted + global commitlisted commitinterest global leftover commfd global displayorder commitidx viewcomplete commitrow commitdata global parentlist children curview hlview @@ -303,6 +305,12 @@ proc getcommitlines {fd view} { lappend vdisporder($view) $id lappend vcmitlisted($view) $listed } + if {[info exists commitinterest($id)]} { + foreach script $commitinterest($id) { + eval [string map [list "%I" $id] $script] + } + unset commitinterest($id) + } set gotsome 1 } if {$gotsome} { @@ -2715,7 +2723,7 @@ proc layoutmore {} { proc showstuff {canshow last} { global numcommits commitrow pending_select selectedline curview - global lookingforhead mainheadid displayorder selectfirst + global mainheadid displayorder selectfirst global lastscrollset commitinterest if {$numcommits == 0} { @@ -2723,15 +2731,6 @@ proc showstuff {canshow last} { set phase "incrdraw" allcanvs delete all } - for {set l $numcommits} {$l < $canshow} {incr l} { - set id [lindex $displayorder $l] - if {[info exists commitinterest($id)]} { - foreach script $commitinterest($id) { - eval [string map [list "%I" $id] $script] - } - unset commitinterest($id) - } - } set r0 $numcommits set prev $numcommits set numcommits $canshow @@ -2762,28 +2761,22 @@ proc showstuff {canshow last} { set selectfirst 0 } } - if {$lookingforhead && [info exists commitrow($curview,$mainheadid)] - && ($last || $commitrow($curview,$mainheadid) < $numcommits - 1)} { - set lookingforhead 0 - dodiffindex - } } proc doshowlocalchanges {} { - global lookingforhead curview mainheadid phase commitrow + global curview mainheadid phase commitrow if {[info exists commitrow($curview,$mainheadid)] && ($phase eq {} || $commitrow($curview,$mainheadid) < $numcommits - 1)} { dodiffindex } elseif {$phase ne {}} { - set lookingforhead 1 + lappend commitinterest($mainheadid) {} } } proc dohidelocalchanges {} { - global lookingforhead localfrow localirow lserial + global localfrow localirow lserial - set lookingforhead 0 if {$localfrow >= 0} { removerow $localfrow set localfrow -1 @@ -2800,8 +2793,9 @@ proc dohidelocalchanges {} { # spawn off a process to do git diff-index --cached HEAD proc dodiffindex {} { - global localirow localfrow lserial + global localirow localfrow lserial showlocalchanges + if {!$showlocalchanges} return incr lserial set localfrow -1 set localirow -1 @@ -6188,7 +6182,6 @@ proc cherrypick {} { proc resethead {} { global mainheadid mainhead rowmenuid confirm_ok resettype - global showlocalchanges set confirm_ok 0 set w ".confirmreset" @@ -8249,7 +8242,6 @@ set cmdlineok 0 set stopped 0 set stuffsaved 0 set patchnum 0 -set lookingforhead 0 set localirow -1 set localfrow -1 set lserial 0 -- cgit v1.2.3 From d372e21613b36d94d595f6627ec603ed11e2fd65 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Sat, 15 Sep 2007 12:08:38 +1000 Subject: gitk: Fix bug in generating patches Commit 8f4893639129acfc866c71583317090aa2a46eab changed mkpatchgo to use diffcmd rather than constructing the diff command itself. Unfortunately diffcmd returns the command with a "|" as the first element (ready for use with open), but exec won't accept the "|". Thus we need to remove the "|". Signed-off-by: Paul Mackerras --- gitk | 2 ++ 1 file changed, 2 insertions(+) (limited to 'gitk') diff --git a/gitk b/gitk index 85d33abf4a..d5db836528 100755 --- a/gitk +++ b/gitk @@ -5920,6 +5920,8 @@ proc mkpatchgo {} { set newid [$patchtop.tosha1 get] set fname [$patchtop.fname get] set cmd [diffcmd [list $oldid $newid] -p] + # trim off the initial "|" + set cmd [lrange $cmd 1 end] lappend cmd >$fname & if {[catch {eval exec $cmd} err]} { error_popup "Error creating patch: $err" -- cgit v1.2.3 From 687c8765ec996225a01cadc7d91354ae3cfbdf8a Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Sat, 22 Sep 2007 12:49:33 +1000 Subject: gitk: Simplify highlighting interface and combine with Find function This effectively coaelesces the highlighting function and the search function. Instead of separate highlight and find controls, there is now one set of interface elements that controls both. The main selector is a drop-down menu that controls whether commits are highlighted and searched for on the basis of text in the commit (i.e. the commit object), files affected by the commit or strings added/removed by the commit. The functions to highlight by membership of a view or by ancestor/ descendent relation to the selected commit are gone, as is the move to next/previous highlighted commit (shift-up/down) function. Signed-off-by: Paul Mackerras --- gitk | 420 +++++++++++++++++++++++++++++++++++-------------------------------- 1 file changed, 220 insertions(+), 200 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index d5db836528..a5d0d66e6c 100755 --- a/gitk +++ b/gitk @@ -706,62 +706,43 @@ proc makewindow {} { -state disabled -width 26 pack .tf.bar.rightbut -side left -fill y - button .tf.bar.findbut -text "Find" -command dofind -font $uifont - pack .tf.bar.findbut -side left + # build up the bottom bar of upper window + label .tf.lbar.flabel -text "Find " -font $uifont + button .tf.lbar.fnext -text "next" -command dofind -font $uifont + button .tf.lbar.fprev -text "prev" -command {dofind 1} -font $uifont + label .tf.lbar.flab2 -text " commit " -font $uifont + pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \ + -side left -fill y + set gdttype "containing:" + set gm [tk_optionMenu .tf.lbar.gdttype gdttype \ + "containing:" \ + "touching paths:" \ + "adding/removing string:"] + trace add variable gdttype write gdttype_change + $gm conf -font $uifont + .tf.lbar.gdttype conf -font $uifont + pack .tf.lbar.gdttype -side left -fill y + set findstring {} - set fstring .tf.bar.findstring + set fstring .tf.lbar.findstring lappend entries $fstring entry $fstring -width 30 -font $textfont -textvariable findstring trace add variable findstring write find_change - pack $fstring -side left -expand 1 -fill x -in .tf.bar set findtype Exact - set findtypemenu [tk_optionMenu .tf.bar.findtype \ + set findtypemenu [tk_optionMenu .tf.lbar.findtype \ findtype Exact IgnCase Regexp] - trace add variable findtype write find_change - .tf.bar.findtype configure -font $uifont - .tf.bar.findtype.menu configure -font $uifont + trace add variable findtype write findcom_change + .tf.lbar.findtype configure -font $uifont + .tf.lbar.findtype.menu configure -font $uifont set findloc "All fields" - tk_optionMenu .tf.bar.findloc findloc "All fields" Headline \ + tk_optionMenu .tf.lbar.findloc findloc "All fields" Headline \ Comments Author Committer trace add variable findloc write find_change - .tf.bar.findloc configure -font $uifont - .tf.bar.findloc.menu configure -font $uifont - pack .tf.bar.findloc -side right - pack .tf.bar.findtype -side right - - # build up the bottom bar of upper window - label .tf.lbar.flabel -text "Highlight: Commits " \ - -font $uifont - pack .tf.lbar.flabel -side left -fill y - set gdttype "touching paths:" - set gm [tk_optionMenu .tf.lbar.gdttype gdttype "touching paths:" \ - "adding/removing string:"] - trace add variable gdttype write hfiles_change - $gm conf -font $uifont - .tf.lbar.gdttype conf -font $uifont - pack .tf.lbar.gdttype -side left -fill y - entry .tf.lbar.fent -width 25 -font $textfont \ - -textvariable highlight_files - trace add variable highlight_files write hfiles_change - lappend entries .tf.lbar.fent - pack .tf.lbar.fent -side left -fill x -expand 1 - label .tf.lbar.vlabel -text " OR in view" -font $uifont - pack .tf.lbar.vlabel -side left -fill y - global viewhlmenu selectedhlview - set viewhlmenu [tk_optionMenu .tf.lbar.vhl selectedhlview None] - $viewhlmenu entryconf None -command delvhighlight - $viewhlmenu conf -font $uifont - .tf.lbar.vhl conf -font $uifont - pack .tf.lbar.vhl -side left -fill y - label .tf.lbar.rlabel -text " OR " -font $uifont - pack .tf.lbar.rlabel -side left -fill y - global highlight_related - set m [tk_optionMenu .tf.lbar.relm highlight_related None \ - "Descendent" "Not descendent" "Ancestor" "Not ancestor"] - $m conf -font $uifont - .tf.lbar.relm conf -font $uifont - trace add variable highlight_related write vrel_change - pack .tf.lbar.relm -side left -fill y + .tf.lbar.findloc configure -font $uifont + .tf.lbar.findloc.menu configure -font $uifont + pack .tf.lbar.findloc -side right + pack .tf.lbar.findtype -side right + pack $fstring -side left -expand 1 -fill x # Finish putting the upper half of the viewer together pack .tf.lbar -in .tf -side bottom -fill x @@ -914,8 +895,6 @@ proc makewindow {} { bindkey sellastline bind . "selnextline -1" bind . "selnextline 1" - bind . "next_highlight -1" - bind . "next_highlight 1" bindkey "goforw" bindkey "goback" bind . "selnextpage -1" @@ -1852,10 +1831,10 @@ proc doviewmenu {m first cmd op argv} { } proc allviewmenus {n op args} { - global viewhlmenu + # global viewhlmenu doviewmenu .bar.view 5 [list showview $n] $op $args - doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args + # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args } proc newviewok {top n} { @@ -1898,8 +1877,8 @@ proc newviewok {top n} { set viewname($n) $newviewname($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)] + # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \ + # entryconf [list -label $viewname($n) -value $viewname($n)] } if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} { set viewfiles($n) $files @@ -1931,8 +1910,8 @@ proc addviewmenu {n} { .bar.view add radiobutton -label $viewname($n) \ -command [list showview $n] -variable selectedview -value $n - $viewhlmenu add radiobutton -label $viewname($n) \ - -command [list addvhighlight $n] -variable selectedhlview + #$viewhlmenu add radiobutton -label $viewname($n) \ + # -command [list addvhighlight $n] -variable selectedhlview } proc flatten {var} { @@ -2208,9 +2187,9 @@ proc askvhighlight {row id} { } } -proc hfiles_change {name ix op} { +proc hfiles_change {} { global highlight_files filehighlight fhighlights fh_serial - global mainfont highlight_paths + global mainfont highlight_paths gdttype if {[info exists filehighlight]} { # delete previous highlights @@ -2228,6 +2207,66 @@ proc hfiles_change {name ix op} { } } +proc gdttype_change {name ix op} { + global gdttype highlight_files findstring findpattern + + if {$findstring ne {}} { + if {$gdttype eq "containing:"} { + if {$highlight_files ne {}} { + set highlight_files {} + hfiles_change + } + findcom_change + } else { + if {$findpattern ne {}} { + set findpattern {} + findcom_change + } + set highlight_files $findstring + hfiles_change + } + drawvisible + } + # enable/disable findtype/findloc menus too +} + +proc find_change {name ix op} { + global gdttype findstring highlight_files + + if {$gdttype eq "containing:"} { + findcom_change + } else { + if {$highlight_files ne $findstring} { + set highlight_files $findstring + hfiles_change + } + } + drawvisible +} + +proc findcom_change {} { + global nhighlights mainfont boldnamerows + global findpattern findtype findstring gdttype + + # delete previous highlights, if any + foreach row $boldnamerows { + bolden_name $row $mainfont + } + set boldnamerows {} + catch {unset nhighlights} + unbolden + unmarkmatches + if {$gdttype ne "containing:" || $findstring eq {}} { + set findpattern {} + } elseif {$findtype eq "Regexp"} { + set findpattern $findstring + } else { + set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \ + $findstring] + set findpattern "*$e*" + } +} + proc makepatterns {l} { set ret {} foreach e $l { @@ -2250,8 +2289,11 @@ proc do_file_hl {serial} { set highlight_paths [makepatterns $paths] highlight_filelist set gdtargs [concat -- $paths] - } else { + } elseif {$gdttype eq "adding/removing string:"} { set gdtargs [list "-S$highlight_files"] + } else { + # must be "containing:", i.e. we're searching commit info + return } set cmd [concat | git diff-tree -r -s --stdin $gdtargs] set filehighlight [open $cmd r+] @@ -2282,7 +2324,7 @@ proc askfilehighlight {row id} { proc readfhighlight {} { global filehighlight fhighlights commitrow curview mainfont iddrawn - global fhl_list + global fhl_list find_dirn if {![info exists filehighlight]} { return 0 @@ -2314,35 +2356,21 @@ proc readfhighlight {} { unset filehighlight return 0 } - next_hlcont - return 1 -} - -proc find_change {name ix op} { - global nhighlights mainfont boldnamerows - global findstring findpattern findtype - - # delete previous highlights, if any - foreach row $boldnamerows { - bolden_name $row $mainfont - } - set boldnamerows {} - catch {unset nhighlights} - unbolden - unmarkmatches - if {$findtype ne "Regexp"} { - set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \ - $findstring] - set findpattern "*$e*" + if {[info exists find_dirn]} { + if {$find_dirn > 0} { + run findmore + } else { + run findmorerev + } } - drawvisible + return 1 } proc doesmatch {f} { - global findtype findstring findpattern + global findtype findpattern if {$findtype eq "Regexp"} { - return [regexp $findstring $f] + return [regexp $findpattern $f] } elseif {$findtype eq "IgnCase"} { return [string match -nocase $findpattern $f] } else { @@ -2535,81 +2563,6 @@ proc askrelhighlight {row id} { set rhighlights($row) $isbold } -proc next_hlcont {} { - global fhl_row fhl_dirn displayorder numcommits - global vhighlights fhighlights nhighlights rhighlights - global hlview filehighlight findstring highlight_related - - if {![info exists fhl_dirn] || $fhl_dirn == 0} return - set row $fhl_row - while {1} { - if {$row < 0 || $row >= $numcommits} { - bell - set fhl_dirn 0 - return - } - set id [lindex $displayorder $row] - if {[info exists hlview]} { - if {![info exists vhighlights($row)]} { - askvhighlight $row $id - } - if {$vhighlights($row) > 0} break - } - if {$findstring ne {}} { - if {![info exists nhighlights($row)]} { - askfindhighlight $row $id - } - if {$nhighlights($row) > 0} break - } - if {$highlight_related ne "None"} { - if {![info exists rhighlights($row)]} { - askrelhighlight $row $id - } - if {$rhighlights($row) > 0} break - } - if {[info exists filehighlight]} { - if {![info exists fhighlights($row)]} { - # ask for a few more while we're at it... - set r $row - for {set n 0} {$n < 100} {incr n} { - if {![info exists fhighlights($r)]} { - askfilehighlight $r [lindex $displayorder $r] - } - incr r $fhl_dirn - if {$r < 0 || $r >= $numcommits} break - } - flushhighlights - } - if {$fhighlights($row) < 0} { - set fhl_row $row - return - } - if {$fhighlights($row) > 0} break - } - incr row $fhl_dirn - } - set fhl_dirn 0 - selectline $row 1 -} - -proc next_highlight {dirn} { - global selectedline fhl_row fhl_dirn - global hlview filehighlight findstring highlight_related - - if {![info exists selectedline]} return - if {!([info exists hlview] || $findstring ne {} || - $highlight_related ne "None" || [info exists filehighlight])} return - set fhl_row [expr {$selectedline + $dirn}] - set fhl_dirn $dirn - next_hlcont -} - -proc cancel_next_highlight {} { - global fhl_dirn - - set fhl_dirn 0 -} - # Graph layout functions proc shortids {ids} { @@ -3669,7 +3622,7 @@ proc drawcmitrow {row} { global displayorder rowidlist nrows_drawn global iddrawn markingmatches global commitinfo parentlist numcommits - global filehighlight fhighlights findstring nhighlights + global filehighlight fhighlights findpattern nhighlights global hlview vhighlights global highlight_related rhighlights @@ -3682,7 +3635,7 @@ proc drawcmitrow {row} { if {[info exists filehighlight] && ![info exists fhighlights($row)]} { askfilehighlight $row $id } - if {$findstring ne {} && ![info exists nhighlights($row)]} { + if {$findpattern ne {} && ![info exists nhighlights($row)]} { askfindhighlight $row $id } if {$highlight_related ne "None" && ![info exists rhighlights($row)]} { @@ -4190,9 +4143,9 @@ proc findmatches {f} { proc dofind {{rev 0}} { global findstring findstartline findcurline selectedline numcommits + global gdttype filehighlight fh_serial find_dirn unmarkmatches - cancel_next_highlight focus . if {$findstring eq {} || $numcommits == 0} return if {![info exists selectedline]} { @@ -4202,19 +4155,24 @@ proc dofind {{rev 0}} { } set findcurline $findstartline nowbusy finding + if {$gdttype ne "containing:" && ![info exists filehighlight]} { + after cancel do_file_hl $fh_serial + do_file_hl $fh_serial + } if {!$rev} { + set find_dirn 1 run findmore } else { - if {$findcurline == 0} { - set findcurline $numcommits - } - incr findcurline -1 + set find_dirn -1 run findmorerev } } proc findnext {restart} { - global findcurline + global findcurline find_dirn + + if {[info exists find_dirn]} return + set find_dirn 1 if {![info exists findcurline]} { if {$restart} { dofind @@ -4228,7 +4186,10 @@ proc findnext {restart} { } proc findprev {} { - global findcurline + global findcurline find_dirn + + if {[info exists find_dirn]} return + set find_dirn -1 if {![info exists findcurline]} { dofind 1 } else { @@ -4238,8 +4199,9 @@ proc findprev {} { } proc findmore {} { - global commitdata commitinfo numcommits findstring findpattern findloc + global commitdata commitinfo numcommits findpattern findloc global findstartline findcurline displayorder + global find_dirn gdttype fhighlights set fldtypes {Headline Author Date Committer CDate Comments} set l [expr {$findcurline + 1}] @@ -4254,28 +4216,56 @@ proc findmore {} { if {$lim - $l > 500} { set lim [expr {$l + 500}] } - set last 0 - for {} {$l < $lim} {incr l} { - set id [lindex $displayorder $l] - # shouldn't happen unless git log doesn't give all the commits... - if {![info exists commitdata($id)]} continue - if {![doesmatch $commitdata($id)]} continue - if {![info exists commitinfo($id)]} { - getcommit $id + set found 0 + set domore 1 + if {$gdttype eq "containing:"} { + for {} {$l < $lim} {incr l} { + set id [lindex $displayorder $l] + # shouldn't happen unless git log doesn't give all the commits... + if {![info exists commitdata($id)]} continue + if {![doesmatch $commitdata($id)]} continue + if {![info exists commitinfo($id)]} { + getcommit $id + } + set info $commitinfo($id) + foreach f $info ty $fldtypes { + if {($findloc eq "All fields" || $findloc eq $ty) && + [doesmatch $f]} { + set found 1 + break + } + } + if {$found} break } - set info $commitinfo($id) - foreach f $info ty $fldtypes { - if {($findloc eq "All fields" || $findloc eq $ty) && - [doesmatch $f]} { - findselectline $l - notbusy finding - return 0 + } else { + for {} {$l < $lim} {incr l} { + set id [lindex $displayorder $l] + if {![info exists fhighlights($l)]} { + askfilehighlight $l $id + if {$domore} { + set domore 0 + set findcurline [expr {$l - 1}] + } + } elseif {$fhighlights($l)} { + set found $domore + break } } } + if {$found} { + unset find_dirn + findselectline $l + notbusy finding + return 0 + } + if {!$domore} { + flushhighlights + return 0 + } if {$l == $findstartline + 1} { bell unset findcurline + unset find_dirn notbusy finding return 0 } @@ -4284,8 +4274,9 @@ proc findmore {} { } proc findmorerev {} { - global commitdata commitinfo numcommits findstring findpattern findloc + global commitdata commitinfo numcommits findpattern findloc global findstartline findcurline displayorder + global find_dirn gdttype fhighlights set fldtypes {Headline Author Date Committer CDate Comments} set l $findcurline @@ -4301,27 +4292,55 @@ proc findmorerev {} { if {$l - $lim > 500} { set lim [expr {$l - 500}] } - set last 0 - for {} {$l > $lim} {incr l -1} { - set id [lindex $displayorder $l] - if {![info exists commitdata($id)]} continue - if {![doesmatch $commitdata($id)]} continue - if {![info exists commitinfo($id)]} { - getcommit $id + set found 0 + set domore 1 + if {$gdttype eq "containing:"} { + for {} {$l > $lim} {incr l -1} { + set id [lindex $displayorder $l] + if {![info exists commitdata($id)]} continue + if {![doesmatch $commitdata($id)]} continue + if {![info exists commitinfo($id)]} { + getcommit $id + } + set info $commitinfo($id) + foreach f $info ty $fldtypes { + if {($findloc eq "All fields" || $findloc eq $ty) && + [doesmatch $f]} { + set found 1 + break + } + } + if {$found} break } - set info $commitinfo($id) - foreach f $info ty $fldtypes { - if {($findloc eq "All fields" || $findloc eq $ty) && - [doesmatch $f]} { - findselectline $l - notbusy finding - return 0 + } else { + for {} {$l > $lim} {incr l -1} { + set id [lindex $displayorder $l] + if {![info exists fhighlights($l)]} { + askfilehighlight $l $id + if {$domore} { + set domore 0 + set findcurline [expr {$l + 1}] + } + } elseif {$fhighlights($l)} { + set found $domore + break } } } + if {$found} { + unset find_dirn + findselectline $l + notbusy finding + return 0 + } + if {!$domore} { + flushhighlights + return 0 + } if {$l == -1} { bell unset findcurline + unset find_dirn notbusy finding return 0 } @@ -4330,7 +4349,7 @@ proc findmorerev {} { } proc findselectline {l} { - global findloc commentend ctext findcurline markingmatches + global findloc commentend ctext findcurline markingmatches gdttype set markingmatches 1 set findcurline $l @@ -4599,7 +4618,6 @@ proc selectline {l isnew} { catch {unset pending_select} $canv delete hover normalline - cancel_next_highlight unsel_reflist if {$l < 0 || $l >= $numcommits} return set y [expr {$canvy0 + $l * $linespc}] @@ -4781,7 +4799,6 @@ proc unselectline {} { catch {unset currentid} allcanvs delete secsel rhighlight_none - cancel_next_highlight } proc reselectline {} { @@ -8223,6 +8240,7 @@ set historyindex 0 set fh_serial 0 set nhl_names {} set highlight_paths {} +set findpattern {} set searchdirn -forwards set boldrows {} set boldnamerows {} @@ -8236,6 +8254,8 @@ set nextviewnum 1 set curview 0 set selectedview 0 set selectedhlview None +set highlight_related None +set highlight_files {} set viewfiles(0) {} set viewperm(0) 0 set viewargs(0) {} -- cgit v1.2.3 From c73adce219ce52a662d90af1e1762c77ea5c4cb0 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Thu, 27 Sep 2007 10:35:05 +1000 Subject: gitk: Fix a couple of bugs insertrow and removerow were trying to adjust rowidlist, rowisopt and rowfinal even if the row where we're inserting/deleting stuff hasn't been laid out yet, which resulted in Tcl errors. This fixes that. Also we weren't deleting the link$linknum tag in appendwithlinks, which resulted in SHA1 IDs in the body of a commit message sometimes getting shown in blue with underlining when they shouldn't. Signed-off-by: Paul Mackerras --- gitk | 33 ++++++++++++++++++++------------- 1 file changed, 20 insertions(+), 13 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index a5d0d66e6c..34fe33771f 100755 --- a/gitk +++ b/gitk @@ -4027,17 +4027,21 @@ proc insertrow {row newcmit} { incr commitidx($curview) set ordertok($curview,$newcmit) $ordertok($curview,$p) - set idlist [lindex $rowidlist $row] - if {[llength $kids] == 1} { - set col [lsearch -exact $idlist $p] - lset idlist $col $newcmit - } else { - set col [llength $idlist] - lappend idlist $newcmit + if {$row < [llength $rowidlist]} { + set idlist [lindex $rowidlist $row] + if {$idlist ne {}} { + if {[llength $kids] == 1} { + set col [lsearch -exact $idlist $p] + lset idlist $col $newcmit + } else { + set col [llength $idlist] + lappend idlist $newcmit + } + } + set rowidlist [linsert $rowidlist $row $idlist] + set rowisopt [linsert $rowisopt $row 0] + set rowfinal [linsert $rowfinal $row [lindex $rowfinal $row]] } - set rowidlist [linsert $rowidlist $row $idlist] - set rowisopt [linsert $rowisopt $row 0] - set rowfinal [linsert $rowfinal $row [lindex $rowfinal $row]] incr numcommits @@ -4077,9 +4081,11 @@ proc removerow {row} { } incr commitidx($curview) -1 - set rowidlist [lreplace $rowidlist $row $row] - set rowisopt [lreplace $rowisopt $row $row] - set rowfinal [lreplace $rowfinal $row $row] + if {$row < [llength $rowidlist]} { + set rowidlist [lreplace $rowidlist $row $row] + set rowisopt [lreplace $rowisopt $row $row] + set rowfinal [lreplace $rowfinal $row $row] + } incr numcommits -1 @@ -4443,6 +4449,7 @@ proc appendwithlinks {text tags} { set e [lindex $l 1] set linkid [string range $text $s $e] incr e + $ctext tag delete link$linknum $ctext tag add link$linknum "$start + $s c" "$start + $e c" setlink $linkid link$linknum incr linknum -- cgit v1.2.3 From bb3edc8b0473192da11bf7f9e961ea0fcc444c63 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Thu, 27 Sep 2007 11:00:25 +1000 Subject: gitk: Add progress bars for reading in stuff and for finding This uses the space formerly occupied by the find string entry field to make a status label (unused for now) and a canvas to display a couple of progress bars. The bar for reading in commits is a short green bar that oscillates back and forth as commits come in. The bar for showing the progress of a Find operation is yellow and advances from left to right. This also arranges to stop a Find operation if the user selects another commit or pops up a context menu, and fixes the "highlight this" popup menu items in the file list window. Signed-off-by: Paul Mackerras --- gitk | 186 +++++++++++++++++++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 153 insertions(+), 33 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 34fe33771f..4e168e98a0 100755 --- a/gitk +++ b/gitk @@ -84,6 +84,7 @@ proc start_rev_list {view} { global commfd leftover tclencoding datemode global viewargs viewfiles commitidx viewcomplete vnextroot global showlocalchanges commitinterest mainheadid + global progressdirn progresscoords proglastnc curview set startmsecs [clock clicks -milliseconds] set commitidx($view) 0 @@ -111,6 +112,11 @@ proc start_rev_list {view} { } filerun $fd [list getcommitlines $fd $view] nowbusy $view + if {$view == $curview} { + set progressdirn 1 + set progresscoords {0 0} + set proglastnc 0 + } } proc stop_rev_list {} { @@ -183,9 +189,11 @@ proc getcommitlines {fd view} { } } set viewcomplete($view) 1 - global viewname + global viewname progresscoords unset commfd($view) notbusy $view + set progresscoords {0 0} + adjustprogress # set it blocking so we wait for the process to terminate fconfigure $fd -blocking 1 if {[catch {close $fd} err]} { @@ -315,6 +323,33 @@ proc getcommitlines {fd view} { } if {$gotsome} { run chewcommits $view + if {$view == $curview} { + # update progress bar + global progressdirn progresscoords proglastnc + set inc [expr {($commitidx($view) - $proglastnc) * 0.0002}] + set proglastnc $commitidx($view) + set l [lindex $progresscoords 0] + set r [lindex $progresscoords 1] + if {$progressdirn} { + set r [expr {$r + $inc}] + if {$r >= 1.0} { + set r 1.0 + set progressdirn 0 + } + if {$r > 0.2} { + set l [expr {$r - 0.2}] + } + } else { + set l [expr {$l - $inc}] + if {$l <= 0.0} { + set l 0.0 + set progressdirn 1 + } + set r [expr {$l + 0.2}] + } + set progresscoords [list $l $r] + adjustprogress + } } return 2 } @@ -589,7 +624,8 @@ proc makewindow {} { global highlight_files gdttype global searchstring sstring global bgcolor fgcolor bglist fglist diffcolors selectbgcolor - global headctxmenu + global headctxmenu progresscanv progressitem progresscoords statusw + global fprogitem fprogcoord lastprogupdate progupdatepending menu .bar .bar add cascade -label "File" -menu .bar.file @@ -706,6 +742,22 @@ proc makewindow {} { -state disabled -width 26 pack .tf.bar.rightbut -side left -fill y + # Status label and progress bar + set statusw .tf.bar.status + label $statusw -width 15 -relief sunken -font $uifont + pack $statusw -side left -padx 5 + set h [expr {[font metrics $uifont -linespace] + 2}] + set progresscanv .tf.bar.progress + canvas $progresscanv -relief sunken -height $h -borderwidth 2 + set progressitem [$progresscanv create rect -1 0 0 $h -fill green] + set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow] + pack $progresscanv -side right -expand 1 -fill x + set progresscoords {0 0} + set fprogcoord 0 + bind $progresscanv adjustprogress + set lastprogupdate [clock clicks -milliseconds] + set progupdatepending 0 + # build up the bottom bar of upper window label .tf.lbar.flabel -text "Find " -font $uifont button .tf.lbar.fnext -text "next" -command dofind -font $uifont @@ -1051,6 +1103,37 @@ proc click {w} { focus . } +# Adjust the progress bar for a change in requested extent or canvas size +proc adjustprogress {} { + global progresscanv progressitem progresscoords + global fprogitem fprogcoord lastprogupdate progupdatepending + + set w [expr {[winfo width $progresscanv] - 4}] + set x0 [expr {$w * [lindex $progresscoords 0]}] + set x1 [expr {$w * [lindex $progresscoords 1]}] + set h [winfo height $progresscanv] + $progresscanv coords $progressitem $x0 0 $x1 $h + $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h + set now [clock clicks -milliseconds] + if {$now >= $lastprogupdate + 100} { + set progupdatepending 0 + update + } elseif {!$progupdatepending} { + set progupdatepending 1 + after [expr {$lastprogupdate + 100 - $now}] doprogupdate + } +} + +proc doprogupdate {} { + global lastprogupdate progupdatepending + + if {$progupdatepending} { + set progupdatepending 0 + set lastprogupdate [clock clicks -milliseconds] + update + } +} + proc savestuff {w} { global canv canv2 canv3 ctext cflist mainfont textfont uifont tabstop global stuffsaved findmergefiles maxgraphpct @@ -1626,6 +1709,7 @@ proc pop_flist_menu {w X Y x y} { global ctext cflist cmitmode flist_menu flist_menu_file global treediffs diffids + stopfinding set l [lindex [split [$w index "@$x,$y"] "."] 0] if {$l <= 1} return if {$cmitmode eq "tree"} { @@ -1639,14 +1723,15 @@ proc pop_flist_menu {w X Y x y} { } proc flist_hl {only} { - global flist_menu_file highlight_files + global flist_menu_file findstring gdttype set x [shellquote $flist_menu_file] - if {$only || $highlight_files eq {}} { - set highlight_files $x + if {$only || $findstring eq {} || $gdttype ne "touching paths:"} { + set findstring $x } else { - append highlight_files " " $x + append findstring " " $x } + set gdttype "touching paths:" } # Functions for adding and removing shell-type quoting @@ -2210,6 +2295,7 @@ proc hfiles_change {} { proc gdttype_change {name ix op} { global gdttype highlight_files findstring findpattern + stopfinding if {$findstring ne {}} { if {$gdttype eq "containing:"} { if {$highlight_files ne {}} { @@ -2233,6 +2319,7 @@ proc gdttype_change {name ix op} { proc find_change {name ix op} { global gdttype findstring highlight_files + stopfinding if {$gdttype eq "containing:"} { findcom_change } else { @@ -2248,6 +2335,7 @@ proc findcom_change {} { global nhighlights mainfont boldnamerows global findpattern findtype findstring gdttype + stopfinding # delete previous highlights, if any foreach row $boldnamerows { bolden_name $row $mainfont @@ -4174,6 +4262,18 @@ proc dofind {{rev 0}} { } } +proc stopfinding {} { + global find_dirn findcurline fprogcoord + + if {[info exists find_dirn]} { + unset find_dirn + unset findcurline + notbusy finding + set fprogcoord 0 + adjustprogress + } +} + proc findnext {restart} { global findcurline find_dirn @@ -4207,8 +4307,11 @@ proc findprev {} { proc findmore {} { global commitdata commitinfo numcommits findpattern findloc global findstartline findcurline displayorder - global find_dirn gdttype fhighlights + global find_dirn gdttype fhighlights fprogcoord + if {![info exists find_dirn]} { + return 0 + } set fldtypes {Headline Author Date Committer CDate Comments} set l [expr {$findcurline + 1}] if {$l >= $numcommits} { @@ -4258,32 +4361,41 @@ proc findmore {} { } } } - if {$found} { + if {$found || ($domore && $l == $findstartline + 1)} { + unset findcurline unset find_dirn - findselectline $l notbusy finding + set fprogcoord 0 + adjustprogress + if {$found} { + findselectline $l + } else { + bell + } return 0 } if {!$domore} { flushhighlights - return 0 + } else { + set findcurline [expr {$l - 1}] } - if {$l == $findstartline + 1} { - bell - unset findcurline - unset find_dirn - notbusy finding - return 0 + set n [expr {$findcurline - ($findstartline + 1)}] + if {$n < 0} { + incr n $numcommits } - set findcurline [expr {$l - 1}] - return 1 + set fprogcoord [expr {$n * 1.0 / $numcommits}] + adjustprogress + return $domore } proc findmorerev {} { global commitdata commitinfo numcommits findpattern findloc global findstartline findcurline displayorder - global find_dirn gdttype fhighlights + global find_dirn gdttype fhighlights fprogcoord + if {![info exists find_dirn]} { + return 0 + } set fldtypes {Headline Author Date Committer CDate Comments} set l $findcurline if {$l == 0} { @@ -4333,25 +4445,31 @@ proc findmorerev {} { } } } - if {$found} { + if {$found || ($domore && $l == $findstartline - 1)} { + unset findcurline unset find_dirn - findselectline $l notbusy finding + set fprogcoord 0 + adjustprogress + if {$found} { + findselectline $l + } else { + bell + } return 0 } if {!$domore} { flushhighlights - return 0 + } else { + set findcurline [expr {$l + 1}] } - if {$l == -1} { - bell - unset findcurline - unset find_dirn - notbusy finding - return 0 + set n [expr {($findstartline - 1) - $findcurline}] + if {$n < 0} { + incr n $numcommits } - set findcurline [expr {$l + 1}] - return 1 + set fprogcoord [expr {$n * 1.0 / $numcommits}] + adjustprogress + return $domore } proc findselectline {l} { @@ -4398,12 +4516,11 @@ proc markmatches {canv l str tag matches font row} { } proc unmarkmatches {} { - global findids markingmatches findcurline + global markingmatches allcanvs delete matches - catch {unset findids} set markingmatches 0 - catch {unset findcurline} + stopfinding } proc selcanvline {w x y} { @@ -4626,6 +4743,7 @@ proc selectline {l isnew} { $canv delete hover normalline unsel_reflist + stopfinding if {$l < 0 || $l >= $numcommits} return set y [expr {$canvy0 + $l * $linespc}] set ymax [lindex [$canv cget -scrollregion] 3] @@ -5815,6 +5933,7 @@ proc rowmenu {x y id} { global rowctxmenu commitrow selectedline rowmenuid curview global nullid nullid2 fakerowmenu mainhead + stopfinding set rowmenuid $id if {![info exists selectedline] || $commitrow($curview,$id) eq $selectedline} { @@ -6293,6 +6412,7 @@ proc readresetstat {fd w} { proc headmenu {x y id head} { global headmenuid headmenuhead headctxmenu mainhead + stopfinding set headmenuid $id set headmenuhead $head set state normal -- cgit v1.2.3 From 32f1b3e4a4baa3fe3e1acbb75f8134d822a09d58 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Fri, 28 Sep 2007 21:27:39 +1000 Subject: gitk: Fix the tab setting in the diff display window This fixes the bug where we were using the wrong font to calculate the width of the tab stops in the diff display window. If we're running on Tk 8.5 we also use the new -tabstyle wordprocessor option that makes tabs work as expected, i.e. a tab moves the cursor to the right until the next tab stop is reached. On Tk 8.5 we also get fancy and set the first tab stop at column 1 for a normal diff or column N for a merge diff with N parents. On Tk8.4 we can't do that because the tabs work in the "tabular" style, i.e. the nth tab character moves to the location of the nth tab position, *unless* you ask for the default tab setting, which gives 8-column tabs that work in the "wordprocessor" mode. So on Tk8.4 if the tab setting is 8 we ask for default tabs. This means that a tab setting of 7 or 9 can look quite different to 8 in some cases. Signed-off-by: Paul Mackerras --- gitk | 37 +++++++++++++++++++++++++++++++------ 1 file changed, 31 insertions(+), 6 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 4e168e98a0..01f5926916 100755 --- a/gitk +++ b/gitk @@ -626,6 +626,7 @@ proc makewindow {} { global bgcolor fgcolor bglist fglist diffcolors selectbgcolor global headctxmenu progresscanv progressitem progresscoords statusw global fprogitem fprogcoord lastprogupdate progupdatepending + global have_tk85 menu .bar .bar add cascade -label "File" -menu .bar.file @@ -845,9 +846,11 @@ proc makewindow {} { pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left set ctext .bleft.ctext text $ctext -background $bgcolor -foreground $fgcolor \ - -tabs "[expr {$tabstop * $charspc}]" \ -state disabled -font $textfont \ -yscrollcommand scrolltext -wrap none + if {$have_tk85} { + $ctext conf -tabstyle wordprocessor + } scrollbar .bleft.sb -command "$ctext yview" pack .bleft.top -side top -fill x pack .bleft.mid -side top -fill x @@ -1135,7 +1138,7 @@ proc doprogupdate {} { } proc savestuff {w} { - global canv canv2 canv3 ctext cflist mainfont textfont uifont tabstop + global canv canv2 canv3 mainfont textfont uifont tabstop global stuffsaved findmergefiles maxgraphpct global maxwidth showneartags showlocalchanges global viewname viewfiles viewargs viewperm nextviewnum @@ -5092,6 +5095,7 @@ proc showfile {f} { $ctext insert end "$f\n" filesep $ctext config -state disabled $ctext yview $commentend + settabs 0 } proc getblobline {bf id} { @@ -5133,6 +5137,7 @@ proc mergediff {id l} { fconfigure $mdf -blocking 0 set mdifffd($id) $mdf set np [llength [lindex $parentlist $l]] + settabs $np filerun $mdf [list getmergediffline $mdf $id $np] } @@ -5210,6 +5215,7 @@ proc getmergediffline {mdf id np} { proc startdiff {ids} { global treediffs diffids treepending diffmergeid nullid nullid2 + settabs 1 set diffids $ids catch {unset diffmergeid} if {![info exists treediffs($ids)] || @@ -5515,6 +5521,23 @@ proc clear_ctext {{first 1.0}} { } } +proc settabs {{firstab {}}} { + global firsttabstop tabstop textfont ctext have_tk85 + + if {$firstab ne {} && $have_tk85} { + set firsttabstop $firstab + } + set w [font measure $textfont "0"] + if {$firsttabstop != 0} { + $ctext conf -tabs [list [expr {$firsttabstop * $w}] \ + [expr {($firsttabstop + $tabstop) * $w}]] + } elseif {$have_tk85 || $tabstop != 8} { + $ctext conf -tabs [expr {$tabstop * $w}] + } else { + $ctext conf -tabs {} + } +} + proc incrsearch {name ix op} { global ctext searchstring searchdirn @@ -5666,13 +5689,12 @@ proc redisplay {} { proc incrfont {inc} { global mainfont textfont ctext canv phase cflist showrefstop - global charspc tabstop global stopped entries unmarkmatches set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]] set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]] setcoords - $ctext conf -font $textfont -tabs "[expr {$tabstop * $charspc}]" + settabs $cflist conf -font $textfont $ctext tag conf filesep -font [concat $textfont bold] foreach e $entries { @@ -5876,6 +5898,7 @@ proc lineclick {x y id isnew} { # fill the details pane with info about this line $ctext conf -state normal clear_ctext + settabs 0 $ctext insert end "Parent:\t" $ctext insert end $id link0 setlink $id link0 @@ -7780,6 +7803,7 @@ proc showtag {tag isnew} { } $ctext conf -state normal clear_ctext + settabs 0 set linknum 0 if {![info exists tagcontents($tag)]} { catch { @@ -7951,11 +7975,10 @@ proc prefscan {} { proc prefsok {} { global maxwidth maxgraphpct global oldprefs prefstop showneartags showlocalchanges - global charspc ctext tabstop catch {destroy $prefstop} unset prefstop - $ctext configure -tabs "[expr {$tabstop * $charspc}]" + settabs if {$showlocalchanges != $oldprefs(showlocalchanges)} { if {$showlocalchanges} { doshowlocalchanges @@ -8360,6 +8383,7 @@ if {$i >= [llength $argv] && $revtreeargs ne {}} { set nullid "0000000000000000000000000000000000000000" set nullid2 "0000000000000000000000000000000000000001" +set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}] set runq {} set history {} @@ -8376,6 +8400,7 @@ set markingmatches 0 set linkentercount 0 set need_redisplay 0 set nrows_drawn 0 +set firsttabstop 0 set nextviewnum 1 set curview 0 -- cgit v1.2.3 From 64b5f146fd2252646d23eac925c49ce9cb526de9 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Thu, 4 Oct 2007 22:19:24 +1000 Subject: gitk: Fix bug causing Tcl error when changing find match type When changing the selector for Exact/IgnCase/Regexp, we were getting a Tcl error. This fixes it. It also adds a workaround for a bug in alpha versions of Tk8.5 where wordprocessor-style tabs don't seem to work properly around column 1. Signed-off-by: Paul Mackerras --- gitk | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 01f5926916..35920abc7b 100755 --- a/gitk +++ b/gitk @@ -2334,7 +2334,7 @@ proc find_change {name ix op} { drawvisible } -proc findcom_change {} { +proc findcom_change args { global nhighlights mainfont boldnamerows global findpattern findtype findstring gdttype @@ -5529,8 +5529,8 @@ proc settabs {{firstab {}}} { } set w [font measure $textfont "0"] if {$firsttabstop != 0} { - $ctext conf -tabs [list [expr {$firsttabstop * $w}] \ - [expr {($firsttabstop + $tabstop) * $w}]] + $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \ + [expr {($firsttabstop + 2 * $tabstop) * $w}]] } elseif {$have_tk85 || $tabstop != 8} { $ctext conf -tabs [expr {$tabstop * $w}] } else { -- cgit v1.2.3 From 9c311b3208f25ce70edf0fdbe0f440ecd8e0bda7 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Thu, 4 Oct 2007 22:27:13 +1000 Subject: gitk: Use named fonts instead of the font specification This replaces the use of $mainfont, $textfont and $uifont with named fonts called mainfont, textfont and uifont. We also have variants called mainfontbold and textfontbold. This makes it much easier to make sure font size changes are reflected everywhere they should be, since configuring a named font automatically changes all the widgets that are using that font. Signed-off-by: Paul Mackerras --- gitk | 257 +++++++++++++++++++++++++++++++++++++------------------------------ 1 file changed, 142 insertions(+), 115 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 35920abc7b..c257bb57ac 100755 --- a/gitk +++ b/gitk @@ -133,7 +133,7 @@ proc stop_rev_list {} { } proc getcommits {} { - global phase canv mainfont curview + global phase canv curview set phase getcommits initlayout @@ -615,7 +615,7 @@ proc confirm_popup msg { proc makewindow {} { global canv canv2 canv3 linespc charspc ctext cflist - global textfont mainfont uifont tabstop + global tabstop global findtype findtypemenu findloc findstring fstring geometry global entries sha1entry sha1string sha1but global diffcontextstring diffcontext @@ -630,19 +630,19 @@ proc makewindow {} { menu .bar .bar add cascade -label "File" -menu .bar.file - .bar configure -font $uifont + .bar configure -font uifont menu .bar.file .bar.file add command -label "Update" -command updatecommits .bar.file add command -label "Reread references" -command rereadrefs .bar.file add command -label "List references" -command showrefs .bar.file add command -label "Quit" -command doquit - .bar.file configure -font $uifont + .bar.file configure -font uifont menu .bar.edit .bar add cascade -label "Edit" -menu .bar.edit .bar.edit add command -label "Preferences" -command doprefs - .bar.edit configure -font $uifont + .bar.edit configure -font uifont - menu .bar.view -font $uifont + menu .bar.view -font uifont .bar add cascade -label "View" -menu .bar.view .bar.view add command -label "New view..." -command {newview 0} .bar.view add command -label "Edit view..." -command editview \ @@ -656,7 +656,7 @@ proc makewindow {} { .bar add cascade -label "Help" -menu .bar.help .bar.help add command -label "About gitk" -command about .bar.help add command -label "Key bindings" -command keys - .bar.help configure -font $uifont + .bar.help configure -font uifont . configure -menu .bar # the gui has upper and lower half, parts of a paned window. @@ -713,10 +713,10 @@ proc makewindow {} { set entries $sha1entry set sha1but .tf.bar.sha1label button $sha1but -text "SHA1 ID: " -state disabled -relief flat \ - -command gotocommit -width 8 -font $uifont + -command gotocommit -width 8 -font uifont $sha1but conf -disabledforeground [$sha1but cget -foreground] pack .tf.bar.sha1label -side left - entry $sha1entry -width 40 -font $textfont -textvariable sha1string + entry $sha1entry -width 40 -font textfont -textvariable sha1string trace add variable sha1string write sha1change pack $sha1entry -side left -pady 2 @@ -745,9 +745,9 @@ proc makewindow {} { # Status label and progress bar set statusw .tf.bar.status - label $statusw -width 15 -relief sunken -font $uifont + label $statusw -width 15 -relief sunken -font uifont pack $statusw -side left -padx 5 - set h [expr {[font metrics $uifont -linespace] + 2}] + set h [expr {[font metrics uifont -linespace] + 2}] set progresscanv .tf.bar.progress canvas $progresscanv -relief sunken -height $h -borderwidth 2 set progressitem [$progresscanv create rect -1 0 0 $h -fill green] @@ -760,10 +760,10 @@ proc makewindow {} { set progupdatepending 0 # build up the bottom bar of upper window - label .tf.lbar.flabel -text "Find " -font $uifont - button .tf.lbar.fnext -text "next" -command dofind -font $uifont - button .tf.lbar.fprev -text "prev" -command {dofind 1} -font $uifont - label .tf.lbar.flab2 -text " commit " -font $uifont + label .tf.lbar.flabel -text "Find " -font uifont + button .tf.lbar.fnext -text "next" -command dofind -font uifont + button .tf.lbar.fprev -text "prev" -command {dofind 1} -font uifont + label .tf.lbar.flab2 -text " commit " -font uifont pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \ -side left -fill y set gdttype "containing:" @@ -772,27 +772,27 @@ proc makewindow {} { "touching paths:" \ "adding/removing string:"] trace add variable gdttype write gdttype_change - $gm conf -font $uifont - .tf.lbar.gdttype conf -font $uifont + $gm conf -font uifont + .tf.lbar.gdttype conf -font uifont pack .tf.lbar.gdttype -side left -fill y set findstring {} set fstring .tf.lbar.findstring lappend entries $fstring - entry $fstring -width 30 -font $textfont -textvariable findstring + entry $fstring -width 30 -font textfont -textvariable findstring trace add variable findstring write find_change set findtype Exact set findtypemenu [tk_optionMenu .tf.lbar.findtype \ findtype Exact IgnCase Regexp] trace add variable findtype write findcom_change - .tf.lbar.findtype configure -font $uifont - .tf.lbar.findtype.menu configure -font $uifont + .tf.lbar.findtype configure -font uifont + .tf.lbar.findtype.menu configure -font uifont set findloc "All fields" tk_optionMenu .tf.lbar.findloc findloc "All fields" Headline \ Comments Author Committer trace add variable findloc write find_change - .tf.lbar.findloc configure -font $uifont - .tf.lbar.findloc.menu configure -font $uifont + .tf.lbar.findloc configure -font uifont + .tf.lbar.findloc.menu configure -font uifont pack .tf.lbar.findloc -side right pack .tf.lbar.findtype -side right pack $fstring -side left -expand 1 -fill x @@ -820,10 +820,10 @@ proc makewindow {} { frame .bleft.mid button .bleft.top.search -text "Search" -command dosearch \ - -font $uifont + -font uifont pack .bleft.top.search -side left -padx 5 set sstring .bleft.top.sstring - entry $sstring -width 20 -font $textfont -textvariable searchstring + entry $sstring -width 20 -font textfont -textvariable searchstring lappend entries $sstring trace add variable searchstring write incrsearch pack $sstring -side left -expand 1 -fill x @@ -834,9 +834,9 @@ proc makewindow {} { radiobutton .bleft.mid.new -text "New version" \ -command changediffdisp -variable diffelide -value {1 0} label .bleft.mid.labeldiffcontext -text " Lines of context: " \ - -font $uifont + -font uifont pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left - spinbox .bleft.mid.diffcontext -width 5 -font $textfont \ + spinbox .bleft.mid.diffcontext -width 5 -font textfont \ -from 1 -increment 1 -to 10000000 \ -validate all -validatecommand "diffcontextvalidate %P" \ -textvariable diffcontextstring @@ -846,7 +846,7 @@ proc makewindow {} { pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left set ctext .bleft.ctext text $ctext -background $bgcolor -foreground $fgcolor \ - -state disabled -font $textfont \ + -state disabled -font textfont \ -yscrollcommand scrolltext -wrap none if {$have_tk85} { $ctext conf -tabstyle wordprocessor @@ -860,7 +860,7 @@ proc makewindow {} { lappend fglist $ctext $ctext tag conf comment -wrap $wrapcomment - $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa" + $ctext tag conf filesep -font textfontbold -back "#aaaaaa" $ctext tag conf hunksep -fore [lindex $diffcolors 2] $ctext tag conf d0 -fore [lindex $diffcolors 0] $ctext tag conf d1 -fore [lindex $diffcolors 1] @@ -882,8 +882,8 @@ proc makewindow {} { $ctext tag conf m15 -fore "#ff70b0" $ctext tag conf mmax -fore darkgrey set mergemax 16 - $ctext tag conf mresult -font [concat $textfont bold] - $ctext tag conf msep -font [concat $textfont bold] + $ctext tag conf mresult -font textfontbold + $ctext tag conf msep -font textfontbold $ctext tag conf found -back yellow .pwbottom add .bleft @@ -894,18 +894,18 @@ proc makewindow {} { frame .bright.mode radiobutton .bright.mode.patch -text "Patch" \ -command reselectline -variable cmitmode -value "patch" - .bright.mode.patch configure -font $uifont + .bright.mode.patch configure -font uifont radiobutton .bright.mode.tree -text "Tree" \ -command reselectline -variable cmitmode -value "tree" - .bright.mode.tree configure -font $uifont + .bright.mode.tree configure -font uifont grid .bright.mode.patch .bright.mode.tree -sticky ew pack .bright.mode -side top -fill x set cflist .bright.cfiles - set indent [font measure $mainfont "nn"] + set indent [font measure mainfont "nn"] text $cflist \ -selectbackground $selectbgcolor \ -background $bgcolor -foreground $fgcolor \ - -font $mainfont \ + -font mainfont \ -tabs [list $indent [expr {2 * $indent}]] \ -yscrollcommand ".bright.sb set" \ -cursor [. cget -cursor] \ @@ -917,7 +917,7 @@ proc makewindow {} { pack $cflist -side left -fill both -expand 1 $cflist tag configure highlight \ -background [$cflist cget -selectbackground] - $cflist tag configure bold -font [concat $mainfont bold] + $cflist tag configure bold -font mainfontbold .pwbottom add .bright .ctop add .pwbottom @@ -1272,10 +1272,10 @@ Copyright Use and redistribute under the terms of the GNU General Public License} \ -justify center -aspect 400 -border 2 -bg white -relief groove pack $w.m -side top -fill x -padx 2 -pady 2 - $w.m configure -font $uifont + $w.m configure -font uifont button $w.ok -text Close -command "destroy $w" -default active pack $w.ok -side bottom - $w.ok configure -font $uifont + $w.ok configure -font uifont bind $w "focus $w.ok" bind $w "destroy $w" bind $w "destroy $w" @@ -1336,10 +1336,10 @@ f Scroll diff view to next file " \ -justify left -bg white -border 2 -relief groove pack $w.m -side top -fill both -padx 2 -pady 2 - $w.m configure -font $uifont + $w.m configure -font uifont button $w.ok -text Close -command "destroy $w" -default active pack $w.ok -side bottom - $w.ok configure -font $uifont + $w.ok configure -font uifont bind $w "focus $w.ok" bind $w "destroy $w" bind $w "destroy $w" @@ -1871,22 +1871,22 @@ proc vieweditor {top n title} { toplevel $top wm title $top $title - label $top.nl -text "Name" -font $uifont - entry $top.name -width 20 -textvariable newviewname($n) -font $uifont + label $top.nl -text "Name" -font uifont + entry $top.name -width 20 -textvariable newviewname($n) -font uifont grid $top.nl $top.name -sticky w -pady 5 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n) \ - -font $uifont + -font uifont grid $top.perm - -pady 5 -sticky w - message $top.al -aspect 1000 -font $uifont \ + message $top.al -aspect 1000 -font uifont \ -text "Commits to include (arguments to git rev-list):" grid $top.al - -sticky w -pady 5 entry $top.args -width 50 -textvariable newviewargs($n) \ - -background white -font $uifont + -background white -font uifont grid $top.args - -sticky ew -padx 5 - message $top.l -aspect 1000 -font $uifont \ + message $top.l -aspect 1000 -font uifont \ -text "Enter files and directories to include, one per line:" grid $top.l - -sticky w - text $top.t -width 40 -height 10 -background white -font $uifont + text $top.t -width 40 -height 10 -background white -font uifont if {[info exists viewfiles($n)]} { foreach f $viewfiles($n) { $top.t insert end $f @@ -1898,9 +1898,9 @@ proc vieweditor {top n title} { grid $top.t - -sticky ew -padx 5 frame $top.buts button $top.buts.ok -text "OK" -command [list newviewok $top $n] \ - -font $uifont + -font uifont button $top.buts.can -text "Cancel" -command [list destroy $top] \ - -font $uifont + -font uifont 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 @@ -2191,12 +2191,12 @@ proc bolden_name {row font} { } proc unbolden {} { - global mainfont boldrows + global boldrows set stillbold {} foreach row $boldrows { if {![ishighlighted $row]} { - bolden $row $mainfont + bolden $row mainfont } else { lappend stillbold $row } @@ -2235,9 +2235,8 @@ proc delvhighlight {} { proc vhighlightmore {} { global hlview vhl_done commitidx vhighlights - global displayorder vdisporder curview mainfont + global displayorder vdisporder curview - set font [concat $mainfont bold] set max $commitidx($hlview) if {$hlview == $curview} { set disp $displayorder @@ -2253,7 +2252,7 @@ proc vhighlightmore {} { set row $commitrow($curview,$id) if {$r0 <= $row && $row <= $r1} { if {![highlighted $row]} { - bolden $row $font + bolden $row mainfontbold } set vhighlights($row) 1 } @@ -2263,11 +2262,11 @@ proc vhighlightmore {} { } proc askvhighlight {row id} { - global hlview vhighlights commitrow iddrawn mainfont + global hlview vhighlights commitrow iddrawn if {[info exists commitrow($hlview,$id)]} { if {[info exists iddrawn($id)] && ![ishighlighted $row]} { - bolden $row [concat $mainfont bold] + bolden $row mainfontbold } set vhighlights($row) 1 } else { @@ -2277,7 +2276,7 @@ proc askvhighlight {row id} { proc hfiles_change {} { global highlight_files filehighlight fhighlights fh_serial - global mainfont highlight_paths gdttype + global highlight_paths gdttype if {[info exists filehighlight]} { # delete previous highlights @@ -2335,13 +2334,13 @@ proc find_change {name ix op} { } proc findcom_change args { - global nhighlights mainfont boldnamerows + global nhighlights boldnamerows global findpattern findtype findstring gdttype stopfinding # delete previous highlights, if any foreach row $boldnamerows { - bolden_name $row $mainfont + bolden_name $row mainfont } set boldnamerows {} catch {unset nhighlights} @@ -2414,7 +2413,7 @@ proc askfilehighlight {row id} { } proc readfhighlight {} { - global filehighlight fhighlights commitrow curview mainfont iddrawn + global filehighlight fhighlights commitrow curview iddrawn global fhl_list find_dirn if {![info exists filehighlight]} { @@ -2436,7 +2435,7 @@ proc readfhighlight {} { if {![info exists commitrow($curview,$line)]} continue set row $commitrow($curview,$line) if {[info exists iddrawn($line)] && ![ishighlighted $row]} { - bolden $row [concat $mainfont bold] + bolden $row mainfontbold } set fhighlights($row) 1 } @@ -2470,7 +2469,7 @@ proc doesmatch {f} { } proc askfindhighlight {row id} { - global nhighlights commitinfo iddrawn mainfont + global nhighlights commitinfo iddrawn global findloc global markingmatches @@ -2491,11 +2490,10 @@ proc askfindhighlight {row id} { } } if {$isbold && [info exists iddrawn($id)]} { - set f [concat $mainfont bold] if {![ishighlighted $row]} { - bolden $row $f + bolden $row mainfontbold if {$isbold > 1} { - bolden_name $row $f + bolden_name $row mainfontbold } } if {$markingmatches} { @@ -2624,7 +2622,7 @@ proc is_ancestor {a} { } proc askrelhighlight {row id} { - global descendent highlight_related iddrawn mainfont rhighlights + global descendent highlight_related iddrawn rhighlights global selectedline ancestor if {![info exists selectedline]} return @@ -2648,7 +2646,7 @@ proc askrelhighlight {row id} { } if {[info exists iddrawn($id)]} { if {$isbold && ![ishighlighted $row]} { - bolden $row [concat $mainfont bold] + bolden $row mainfontbold } } set rhighlights($row) $isbold @@ -3624,7 +3622,7 @@ proc drawcmittext {id row col} { global commitlisted commitinfo rowidlist parentlist global rowtextx idpos idtags idheads idotherrefs global linehtag linentag linedtag selectedline - global mainfont canvxmax boldrows boldnamerows fgcolor nullid nullid2 + global canvxmax boldrows boldnamerows fgcolor nullid nullid2 # listed is 0 for boundary, 1 for normal, 2 for left, 3 for right set listed [lindex $commitlisted $row] @@ -3681,15 +3679,15 @@ proc drawcmittext {id row col} { set name [lindex $commitinfo($id) 1] set date [lindex $commitinfo($id) 2] set date [formatdate $date] - set font $mainfont - set nfont $mainfont + set font mainfont + set nfont mainfont set isbold [ishighlighted $row] if {$isbold > 0} { lappend boldrows $row - lappend font bold + set font mainfontbold if {$isbold > 1} { lappend boldnamerows $row - lappend nfont bold + set nfont mainfontbold } } set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \ @@ -3698,11 +3696,11 @@ proc drawcmittext {id row col} { 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] + -text $date -font mainfont -tags text] if {[info exists selectedline] && $selectedline == $row} { make_secsel $row } - set xr [expr {$xt + [font measure $mainfont $headline]}] + set xr [expr {$xt + [font measure $font $headline]}] if {$xr > $canvxmax} { set canvxmax $xr setcanvscroll @@ -3985,7 +3983,7 @@ proc bindline {t id} { proc drawtags {id x xt y1} { global idtags idheads idotherrefs mainhead global linespc lthickness - global canv mainfont commitrow rowtextx curview fgcolor bgcolor + global canv commitrow rowtextx curview fgcolor bgcolor set marks {} set ntags 0 @@ -4014,9 +4012,9 @@ proc drawtags {id x xt y1} { foreach tag $marks { incr i if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} { - set wid [font measure [concat $mainfont bold] $tag] + set wid [font measure mainfontbold $tag] } else { - set wid [font measure $mainfont $tag] + set wid [font measure mainfont $tag] } lappend xvals $xt lappend wvals $wid @@ -4028,7 +4026,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 + set font mainfont if {[incr ntags -1] >= 0} { # draw a tag set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \ @@ -4041,7 +4039,7 @@ proc drawtags {id x xt y1} { if {[incr nheads -1] >= 0} { set col green if {$tag eq $mainhead} { - lappend font bold + set font mainfontbold } } else { set col "#ddddff" @@ -4050,7 +4048,7 @@ proc drawtags {id x xt y1} { $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \ -width 1 -outline black -fill $col -tags tag.$id if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} { - set rwid [font measure $mainfont $remoteprefix] + set rwid [font measure mainfont $remoteprefix] set xi [expr {$x + 1}] set yti [expr {$yt + 1}] set xri [expr {$x + $rwid}] @@ -4082,10 +4080,10 @@ proc xcoord {i level ln} { } proc show_status {msg} { - global canv mainfont fgcolor + global canv fgcolor clear_display - $canv create text 3 3 -anchor nw -text $msg -font $mainfont \ + $canv create text 3 3 -anchor nw -text $msg -font mainfont \ -tags text -fill $fgcolor } @@ -5522,12 +5520,12 @@ proc clear_ctext {{first 1.0}} { } proc settabs {{firstab {}}} { - global firsttabstop tabstop textfont ctext have_tk85 + global firsttabstop tabstop ctext have_tk85 if {$firstab ne {} && $have_tk85} { set firsttabstop $firstab } - set w [font measure $textfont "0"] + set w [font measure textfont "0"] if {$firsttabstop != 0} { $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \ [expr {($firsttabstop + 2 * $tabstop) * $w}]] @@ -5658,11 +5656,11 @@ proc scrolltext {f0 f1} { } proc setcoords {} { - global linespc charspc canvx0 canvy0 mainfont + global linespc charspc canvx0 canvy0 global xspc1 xspc2 lthickness - set linespc [font metrics $mainfont -linespace] - set charspc [font measure $mainfont "m"] + set linespc [font metrics mainfont -linespace] + set charspc [font measure mainfont "m"] set canvy0 [expr {int(3 + 0.5 * $linespc)}] set canvx0 [expr {int(3 + 0.5 * $linespc)}] set lthickness [expr {int($linespc / 9) + 1}] @@ -5687,25 +5685,45 @@ proc redisplay {} { } } +proc fontdescr {f} { + set d [list [font actual $f -family] [font actual $f -size]] + if {[font actual $f -weight] eq "bold"} { + lappend d "bold" + } + if {[font actual $f -slant] eq "italic"} { + lappend d "italic" + } + if {[font actual $f -underline]} { + lappend d "underline" + } + if {[font actual $f -overstrike]} { + lappend d "overstrike" + } + return $d +} + proc incrfont {inc} { global mainfont textfont ctext canv phase cflist showrefstop global stopped entries unmarkmatches - set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]] - set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]] + set s [font actual mainfont -size] + incr s $inc + if {$s < 1} { + set s 1 + } + font config mainfont -size $s + font config mainfontbold -size $s + set mainfont [fontdescr mainfont] + set s [font actual textfont -size] + incr s $inc + if {$s < 1} { + set s 1 + } + font config textfont -size $s + font config textfontbold -size $s + set textfont [fontdescr textfont] setcoords settabs - $cflist conf -font $textfont - $ctext tag conf filesep -font [concat $textfont bold] - foreach e $entries { - $e conf -font $mainfont - } - if {$phase eq "getcommits"} { - $canv itemconf textitems -font $mainfont - } - if {[info exists showrefstop] && [winfo exists $showrefstop]} { - $showrefstop.list conf -font $mainfont - } redisplay } @@ -5816,7 +5834,7 @@ proc lineleave {id} { proc linehover {} { global hoverx hovery hoverid hovertimer global canv linespc lthickness - global commitinfo mainfont + global commitinfo set text [lindex $commitinfo($hoverid) 0] set ymax [lindex [$canv cget -scrollregion] 3] @@ -5826,13 +5844,13 @@ proc linehover {} { set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}] set x0 [expr {$x - 2 * $lthickness}] set y0 [expr {$y - 2 * $lthickness}] - set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}] + set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}] set y1 [expr {$y + $linespc + 2 * $lthickness}] 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] + -font mainfont] $canv raise $t } @@ -6168,7 +6186,7 @@ proc domktag {} { proc redrawtags {id} { global canv linehtag commitrow idpos selectedline curview - global mainfont canvxmax iddrawn + global canvxmax iddrawn if {![info exists commitrow($curview,$id)]} return if {![info exists iddrawn($id)]} return @@ -6177,7 +6195,7 @@ proc redrawtags {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]}] + set xr [expr {$xt + [font measure mainfont $text]}] if {$xr > $canvxmax} { set canvxmax $xr setcanvscroll @@ -6509,8 +6527,8 @@ proc rmbranch {} { # Display a list of tags and heads proc showrefs {} { - global showrefstop bgcolor fgcolor selectbgcolor mainfont - global bglist fglist uifont reflistfilter reflist maincursor + global showrefstop bgcolor fgcolor selectbgcolor + global bglist fglist reflistfilter reflist maincursor set top .showrefs set showrefstop $top @@ -6522,7 +6540,7 @@ proc showrefs {} { toplevel $top wm title $top "Tags and heads: [file tail [pwd]]" text $top.list -background $bgcolor -foreground $fgcolor \ - -selectbackground $selectbgcolor -font $mainfont \ + -selectbackground $selectbgcolor -font mainfont \ -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \ -width 30 -height 20 -cursor $maincursor \ -spacing1 1 -spacing3 1 -state disabled @@ -6534,15 +6552,15 @@ proc showrefs {} { grid $top.list $top.ysb -sticky nsew grid $top.xsb x -sticky ew frame $top.f - label $top.f.l -text "Filter: " -font $uifont - entry $top.f.e -width 20 -textvariable reflistfilter -font $uifont + label $top.f.l -text "Filter: " -font uifont + entry $top.f.e -width 20 -textvariable reflistfilter -font uifont set reflistfilter "*" trace add variable reflistfilter write reflistfilter_change pack $top.f.e -side right -fill x -expand 1 pack $top.f.l -side left grid $top.f - -sticky ew -pady 2 button $top.close -command [list destroy $top] -text "Close" \ - -font $uifont + -font uifont grid $top.close - grid columnconfigure $top 0 -weight 1 grid rowconfigure $top 0 -weight 1 @@ -7845,7 +7863,7 @@ proc doprefs {} { toplevel $top wm title $top "Gitk preferences" label $top.ldisp -text "Commit list display options" - $top.ldisp configure -font $uifont + $top.ldisp configure -font uifont grid $top.ldisp - -sticky w -pady 10 label $top.spacer -text " " label $top.maxwidthl -text "Maximum graph width (lines)" \ @@ -7863,7 +7881,7 @@ proc doprefs {} { grid x $top.showlocal -sticky w label $top.ddisp -text "Diff display options" - $top.ddisp configure -font $uifont + $top.ddisp configure -font uifont grid $top.ddisp - -sticky w -pady 10 label $top.diffoptl -text "Options for diff program" \ -font optionfont @@ -7879,7 +7897,7 @@ proc doprefs {} { grid x $top.tabstopl $top.tabstop -sticky w label $top.cdisp -text "Colors: press to choose" - $top.cdisp configure -font $uifont + $top.cdisp configure -font uifont grid $top.cdisp - -sticky w -pady 10 label $top.bg -padx 40 -relief sunk -background $bgcolor button $top.bgbut -text "Background" -font optionfont \ @@ -7912,9 +7930,9 @@ proc doprefs {} { frame $top.buts button $top.buts.ok -text "OK" -command prefsok -default active - $top.buts.ok configure -font $uifont + $top.buts.ok configure -font uifont button $top.buts.can -text "Cancel" -command prefscan -default normal - $top.buts.can configure -font $uifont + $top.buts.can configure -font uifont 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 @@ -8322,6 +8340,15 @@ set selectbgcolor gray85 catch {source ~/.gitk} font create optionfont -family sans-serif -size -12 +font create mainfont +catch {eval font config mainfont [font actual $mainfont]} +eval font create mainfontbold [font actual mainfont] -weight bold +font create textfont +catch {eval font config textfont [font actual $textfont]} +eval font create textfontbold [font actual textfont] +font config textfontbold -weight bold +font create uifont +catch {eval font config uifont [font actual $uifont]} # check that we can find a .git directory somewhere... if {[catch {set gitdir [gitdir]}]} { -- cgit v1.2.3 From 0ed1dd3c77e606156f0f5d1baa59a47f33711787 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Sat, 6 Oct 2007 18:27:37 +1000 Subject: gitk: Keep track of font attributes ourselves instead of using font actual Unfortunately there seems to be a bug in Tk8.5 where font actual -size sometimes gives the wrong answer (e.g. 12 for Bitstream Vera Sans 9), even though the font is actually displayed at the right size. This works around it by parsing and storing the family, size, weight and slant of the mainfont, textfont and uifont explicitly. Signed-off-by: Paul Mackerras --- gitk | 82 +++++++++++++++++++++++++++++++++++++++++++++++--------------------- 1 file changed, 57 insertions(+), 25 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index c257bb57ac..69b31f037e 100755 --- a/gitk +++ b/gitk @@ -5685,43 +5685,73 @@ proc redisplay {} { } } -proc fontdescr {f} { - set d [list [font actual $f -family] [font actual $f -size]] - if {[font actual $f -weight] eq "bold"} { - lappend d "bold" +proc parsefont {f n} { + global fontattr + + set fontattr($f,family) [lindex $n 0] + set s [lindex $n 1] + if {$s eq {} || $s == 0} { + set s 10 + } elseif {$s < 0} { + set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}] } - if {[font actual $f -slant] eq "italic"} { - lappend d "italic" + set fontattr($f,size) $s + set fontattr($f,weight) normal + set fontattr($f,slant) roman + foreach style [lrange $n 2 end] { + switch -- $style { + "normal" - + "bold" {set fontattr($f,weight) $style} + "roman" - + "italic" {set fontattr($f,slant) $style} + } } - if {[font actual $f -underline]} { - lappend d "underline" +} + +proc fontflags {f {isbold 0}} { + global fontattr + + return [list -family $fontattr($f,family) -size $fontattr($f,size) \ + -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \ + -slant $fontattr($f,slant)] +} + +proc fontname {f} { + global fontattr + + set n [list $fontattr($f,family) $fontattr($f,size)] + if {$fontattr($f,weight) eq "bold"} { + lappend n "bold" } - if {[font actual $f -overstrike]} { - lappend d "overstrike" + if {$fontattr($f,slant) eq "italic"} { + lappend n "italic" } - return $d + return $n } proc incrfont {inc} { global mainfont textfont ctext canv phase cflist showrefstop - global stopped entries + global stopped entries fontattr + unmarkmatches - set s [font actual mainfont -size] + set s $fontattr(mainfont,size) incr s $inc if {$s < 1} { set s 1 } + set fontattr(mainfont,size) $s font config mainfont -size $s font config mainfontbold -size $s - set mainfont [fontdescr mainfont] - set s [font actual textfont -size] + set mainfont [fontname mainfont] + set s $fontattr(textfont,size) incr s $inc if {$s < 1} { set s 1 } + set fontattr(textfont,size) $s font config textfont -size $s font config textfontbold -size $s - set textfont [fontdescr textfont] + set textfont [fontname textfont] setcoords settabs redisplay @@ -8340,15 +8370,17 @@ set selectbgcolor gray85 catch {source ~/.gitk} font create optionfont -family sans-serif -size -12 -font create mainfont -catch {eval font config mainfont [font actual $mainfont]} -eval font create mainfontbold [font actual mainfont] -weight bold -font create textfont -catch {eval font config textfont [font actual $textfont]} -eval font create textfontbold [font actual textfont] -font config textfontbold -weight bold -font create uifont -catch {eval font config uifont [font actual $uifont]} + +parsefont mainfont $mainfont +eval font create mainfont [fontflags mainfont] +eval font create mainfontbold [fontflags mainfont 1] + +parsefont textfont $textfont +eval font create textfont [fontflags textfont] +eval font create textfontbold [fontflags textfont 1] + +parsefont uifont $uifont +eval font create uifont [fontflags uifont] # check that we can find a .git directory somewhere... if {[catch {set gitdir [gitdir]}]} { -- cgit v1.2.3 From 9a7558f348772ab3c2fb3d4beda3a3a7af1e843a Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Sat, 6 Oct 2007 20:16:06 +1000 Subject: gitk: Add a font chooser This adds buttons to the edit preferences window to allow the user to choose the main font, the text font (used for the diff display window) and the UI font. Pressing those buttons pops up a font chooser window that lets the user pick the font family, size, weight (bold/normal) and slant (roman/italic). Signed-off-by: Paul Mackerras --- gitk | 156 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 155 insertions(+), 1 deletion(-) (limited to 'gitk') diff --git a/gitk b/gitk index 69b31f037e..6f0af37342 100755 --- a/gitk +++ b/gitk @@ -7875,6 +7875,130 @@ proc doquit {} { destroy . } +proc mkfontdisp {font top which} { + global fontattr fontpref $font + + set fontpref($font) [set $font] + button $top.${font}but -text $which -font optionfont \ + -command [list choosefont $font $which] + label $top.$font -relief flat -font $font \ + -text $fontattr($font,family) -justify left + grid x $top.${font}but $top.$font -sticky w +} + +proc choosefont {font which} { + global fontparam fontlist fonttop fontattr + + set fontparam(which) $which + set fontparam(font) $font + set fontparam(family) [font actual $font -family] + set fontparam(size) $fontattr($font,size) + set fontparam(weight) $fontattr($font,weight) + set fontparam(slant) $fontattr($font,slant) + set top .gitkfont + set fonttop $top + if {![winfo exists $top]} { + font create sample + eval font config sample [font actual $font] + toplevel $top + wm title $top "Gitk font chooser" + label $top.l -textvariable fontparam(which) -font uifont + pack $top.l -side top + set fontlist [lsort [font families]] + frame $top.f + listbox $top.f.fam -listvariable fontlist \ + -yscrollcommand [list $top.f.sb set] + bind $top.f.fam <> selfontfam + scrollbar $top.f.sb -command [list $top.f.fam yview] + pack $top.f.sb -side right -fill y + pack $top.f.fam -side left -fill both -expand 1 + pack $top.f -side top -fill both -expand 1 + frame $top.g + spinbox $top.g.size -from 4 -to 40 -width 4 \ + -textvariable fontparam(size) \ + -validatecommand {string is integer -strict %s} + checkbutton $top.g.bold -padx 5 \ + -font {{Times New Roman} 12 bold} -text "B" -indicatoron 0 \ + -variable fontparam(weight) -onvalue bold -offvalue normal + checkbutton $top.g.ital -padx 5 \ + -font {{Times New Roman} 12 italic} -text "I" -indicatoron 0 \ + -variable fontparam(slant) -onvalue italic -offvalue roman + pack $top.g.size $top.g.bold $top.g.ital -side left + pack $top.g -side top + canvas $top.c -width 150 -height 50 -border 2 -relief sunk \ + -background white + $top.c create text 100 25 -anchor center -text $which -font sample \ + -fill black -tags text + bind $top.c [list centertext $top.c] + pack $top.c -side top -fill x + frame $top.buts + button $top.buts.ok -text "OK" -command fontok -default active \ + -font uifont + button $top.buts.can -text "Cancel" -command fontcan -default normal \ + -font uifont + 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 + pack $top.buts -side bottom -fill x + trace add variable fontparam write chg_fontparam + } else { + raise $top + $top.c itemconf text -text $which + } + set i [lsearch -exact $fontlist $fontparam(family)] + if {$i >= 0} { + $top.f.fam selection set $i + $top.f.fam see $i + } +} + +proc centertext {w} { + $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}] +} + +proc fontok {} { + global fontparam fontpref prefstop + + set f $fontparam(font) + set fontpref($f) [list $fontparam(family) $fontparam(size)] + if {$fontparam(weight) eq "bold"} { + lappend fontpref($f) "bold" + } + if {$fontparam(slant) eq "italic"} { + lappend fontpref($f) "italic" + } + set w $prefstop.$f + $w conf -text $fontparam(family) -font $fontpref($f) + + fontcan +} + +proc fontcan {} { + global fonttop fontparam + + if {[info exists fonttop]} { + catch {destroy $fonttop} + catch {font delete sample} + unset fonttop + unset fontparam + } +} + +proc selfontfam {} { + global fonttop fontparam + + set i [$fonttop.f.fam curselection] + if {$i ne {}} { + set fontparam(family) [$fonttop.f.fam get $i] + } +} + +proc chg_fontparam {v sub op} { + global fontparam + + font config sample -$sub $fontparam($sub) +} + proc doprefs {} { global maxwidth maxgraphpct diffopts global oldprefs prefstop showneartags showlocalchanges @@ -7958,6 +8082,13 @@ proc doprefs {} { -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg] grid x $top.selbgbut $top.selbgsep -sticky w + label $top.cfont -text "Fonts: press to choose" + $top.cfont configure -font uifont + grid $top.cfont - -sticky w -pady 10 + mkfontdisp mainfont $top "Main font" + mkfontdisp textfont $top "Diff display font" + mkfontdisp uifont $top "User interface font" + frame $top.buts button $top.buts.ok -text "OK" -command prefsok -default active $top.buts.ok configure -font uifont @@ -8018,14 +8149,37 @@ proc prefscan {} { } catch {destroy $prefstop} unset prefstop + fontcan } proc prefsok {} { global maxwidth maxgraphpct global oldprefs prefstop showneartags showlocalchanges + global fontpref mainfont textfont uifont catch {destroy $prefstop} unset prefstop + fontcan + set fontchanged 0 + if {$mainfont ne $fontpref(mainfont)} { + set mainfont $fontpref(mainfont) + parsefont mainfont $mainfont + eval font configure mainfont [fontflags mainfont] + eval font configure mainfontbold [fontflags mainfont 1] + setcoords + set fontchanged 1 + } + if {$textfont ne $fontpref(textfont)} { + set textfont $fontpref(textfont) + parsefont textfont $textfont + eval font configure textfont [fontflags textfont] + eval font configure textfontbold [fontflags textfont 1] + } + if {$uifont ne $fontpref(uifont)} { + set uifont $fontpref(uifont) + parsefont uifont $uifont + eval font configure uifont [fontflags uifont] + } settabs if {$showlocalchanges != $oldprefs(showlocalchanges)} { if {$showlocalchanges} { @@ -8034,7 +8188,7 @@ proc prefsok {} { dohidelocalchanges } } - if {$maxwidth != $oldprefs(maxwidth) + if {$fontchanged || $maxwidth != $oldprefs(maxwidth) || $maxgraphpct != $oldprefs(maxgraphpct)} { redisplay } elseif {$showneartags != $oldprefs(showneartags)} { -- cgit v1.2.3 From 308ff3d59df853a21d4e218473974311fb7b3320 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Sat, 6 Oct 2007 20:17:59 +1000 Subject: gitk: Fix bug where the last few commits would sometimes not be visible We weren't calling showstuff for the last few commits under some circumstances, causing the scrolling region not to be extended right to the end of the graph. This fixes it. Signed-off-by: Paul Mackerras --- gitk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gitk') diff --git a/gitk b/gitk index 6f0af37342..3f7f77777d 100755 --- a/gitk +++ b/gitk @@ -2758,7 +2758,7 @@ proc layoutmore {} { global uparrowlen downarrowlen mingaplen curview set show $commitidx($curview) - if {$show > $numcommits} { + if {$show > $numcommits || $viewcomplete($curview)} { showstuff $show $viewcomplete($curview) } } -- cgit v1.2.3 From 8d73b242a53da9ea36800a8ff0f9993e5100ea24 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Sat, 6 Oct 2007 20:22:00 +1000 Subject: gitk: Get rid of the diffopts variable The only thing that could be specified with diffopts was the number of lines of context, but there is already a spinbox for that. So this gets rid of it. Signed-off-by: Paul Mackerras --- gitk | 19 ++++++------------- 1 file changed, 6 insertions(+), 13 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 3f7f77777d..290deff7b2 100755 --- a/gitk +++ b/gitk @@ -5119,14 +5119,13 @@ proc getblobline {bf id} { } proc mergediff {id l} { - global diffmergeid diffopts mdifffd + global diffmergeid mdifffd global diffids global parentlist set diffmergeid $id set diffids $id # this doesn't seem to actually affect anything... - set env(GIT_DIFF_OPTS) $diffopts set cmd [concat | git diff-tree --no-commit-id --cc $id] if {[catch {set mdf [open $cmd r]} err]} { error_popup "Error getting merge diffs: $err" @@ -5333,11 +5332,10 @@ proc diffcontextchange {n1 n2 op} { } proc getblobdiffs {ids} { - global diffopts blobdifffd diffids env + global blobdifffd diffids env global diffinhdr treediffs global diffcontext - set env(GIT_DIFF_OPTS) $diffopts if {[catch {set bdf [open [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"] r]} err]} { puts "error getting diffs: $err" return @@ -8000,7 +7998,7 @@ proc chg_fontparam {v sub op} { } proc doprefs {} { - global maxwidth maxgraphpct diffopts + global maxwidth maxgraphpct global oldprefs prefstop showneartags showlocalchanges global bgcolor fgcolor ctext diffcolors selectbgcolor global uifont tabstop @@ -8011,7 +8009,7 @@ proc doprefs {} { raise $top return } - foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} { + foreach v {maxwidth maxgraphpct showneartags showlocalchanges} { set oldprefs($v) [set $v] } toplevel $top @@ -8037,10 +8035,6 @@ proc doprefs {} { label $top.ddisp -text "Diff display options" $top.ddisp configure -font uifont 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 @@ -8141,10 +8135,10 @@ proc setfg {c} { } proc prefscan {} { - global maxwidth maxgraphpct diffopts + global maxwidth maxgraphpct global oldprefs prefstop showneartags showlocalchanges - foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} { + foreach v {maxwidth maxgraphpct showneartags showlocalchanges} { set $v $oldprefs($v) } catch {destroy $prefstop} @@ -8479,7 +8473,6 @@ proc tcl_encoding {enc} { # defaults... set datemode 0 -set diffopts "-U 5 -p" set wrcomcmd "git diff-tree --stdin -p --pretty" set gitencoding {} -- cgit v1.2.3 From 0166419a197cea0ceef3aed8c72023deb015ecf4 Mon Sep 17 00:00:00 2001 From: Sam Vilain Date: Wed, 17 Oct 2007 11:33:04 +1300 Subject: gitk: disable colours when calling git log If the user specifies 'diff.color = 1' in their configuration file, then gitk will not start. Disable colours when calling git log. Signed-off-by: Sam Vilain Signed-off-by: Shawn O. Pearce --- gitk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gitk') diff --git a/gitk b/gitk index 300fdceb35..999e3c2188 100755 --- a/gitk +++ b/gitk @@ -92,7 +92,7 @@ proc start_rev_list {view} { set order "--date-order" } if {[catch { - set fd [open [concat | git log -z --pretty=raw $order --parents \ + set fd [open [concat | git log --no-color -z --pretty=raw $order --parents \ --boundary $viewargs($view) "--" $viewfiles($view)] r] } err]} { error_popup "Error executing git rev-list: $err" -- cgit v1.2.3 From eb33a67f218b612f6fb1456e19b40a1f97ff02c0 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Fri, 19 Oct 2007 19:09:43 +1000 Subject: gitk: Fix Tcl error: can't unset findcurline The logic in stopfinding assumes that findcurline will be set if find_dirn is, but findnext and findprev can set find_dirn without setting findcurline. This makes sure we only set find_dirn in those places if findcurline is already set. Signed-off-by: Paul Mackerras --- gitk | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 290deff7b2..3b3cc4bd93 100755 --- a/gitk +++ b/gitk @@ -4279,7 +4279,6 @@ proc findnext {restart} { global findcurline find_dirn if {[info exists find_dirn]} return - set find_dirn 1 if {![info exists findcurline]} { if {$restart} { dofind @@ -4287,6 +4286,7 @@ proc findnext {restart} { bell } } else { + set find_dirn 1 run findmore nowbusy finding } @@ -4296,10 +4296,10 @@ proc findprev {} { global findcurline find_dirn if {[info exists find_dirn]} return - set find_dirn -1 if {![info exists findcurline]} { dofind 1 } else { + set find_dirn -1 run findmorerev nowbusy finding } -- cgit v1.2.3 From 5dd57d512225bb82aa0010b39aaec0085d471eac Mon Sep 17 00:00:00 2001 From: Jonathan del Strother Date: Mon, 15 Oct 2007 10:33:07 +0100 Subject: gitk: Add support for OS X mouse wheel MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit (Väinö Järvelä supplied this patch a while ago for 1.5.2. It no longer applied cleanly, so I'm reposting it.) MacBook doesn't seem to recognize MouseRelease-4 and -5 events, at all. So i added a support for the MouseWheel event, which i limited to Tcl/tk aqua, as i couldn't test it neither on Linux or Windows. Tcl/tk needs to be updated from the version that is shipped with OS X 10.4 Tiger, for this patch to work. Signed-off-by: Jonathan del Strother Signed-off-by: Shawn O. Pearce --- gitk | 6 ++++++ 1 file changed, 6 insertions(+) (limited to 'gitk') diff --git a/gitk b/gitk index 999e3c2188..46673e3b9c 100755 --- a/gitk +++ b/gitk @@ -843,6 +843,12 @@ proc makewindow {} { } else { bindall "allcanvs yview scroll -5 units" bindall "allcanvs yview scroll 5 units" + if {[tk windowingsystem] eq "aqua"} { + bindall { + set delta [expr {- (%D)}] + allcanvs yview scroll $delta units + } + } } bindall <2> "canvscan mark %W %x %y" bindall "canvscan dragto %W %x %y" -- cgit v1.2.3 From 5e85ec4cd0658232fa8ee13e8cd9da21e0e4973e Mon Sep 17 00:00:00 2001 From: Johannes Sixt Date: Tue, 2 Oct 2007 16:16:54 +0200 Subject: gitk: Do not pick up file names of "copy from" lines A file copy would be detected only if the original file was modified in the same commit. This implies that there will be a patch listed under the original file name, and we would expect that clicking the original file name in the file list warps the patch window to that file's patch. (If the original file was not modified, the copy would not be detected in the first place, the copied file would be listed as "new file", and this whole matter would not apply.) However, if the name of the copy is sorted after the original file's patch, then the logic introduced by commit d1cb298b0b (which picks up the link information from the "copy from" line) would overwrite the link information that is already present for the original file name, which was parsed earlier. Hence, this patch reverts part of said commit. Signed-off-by: Johannes Sixt Signed-off-by: Shawn O. Pearce --- gitk | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 46673e3b9c..516e14a8fc 100755 --- a/gitk +++ b/gitk @@ -5221,8 +5221,7 @@ proc getblobdiffline {bdf ids} { set diffinhdr 0 } elseif {$diffinhdr} { - if {![string compare -length 12 "rename from " $line] || - ![string compare -length 10 "copy from " $line]} { + if {![string compare -length 12 "rename from " $line]} { set fname [string range $line [expr 6 + [string first " from " $line] ] end] if {[string index $fname 0] eq "\""} { set fname [lindex $fname 0] -- cgit v1.2.3 From 5d7589d4c43e941563dfa2d096e6d6c184191702 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Sat, 20 Oct 2007 21:21:03 +1000 Subject: gitk: Check that we are running on at least Tcl/Tk 8.4 This checks that we have Tcl/Tk 8.4 or later, and puts up an error message in a window and quits if not. This was prompted by a patch submitted by Steffen Prohaska, but is done a bit differently (this uses package require rather than looking at [info tclversion], and uses show_error to display the error rather than printing it to stderr). Signed-off-by: Paul Mackerras --- gitk | 7 +++++++ 1 file changed, 7 insertions(+) (limited to 'gitk') diff --git a/gitk b/gitk index 516e14a8fc..06172a434b 100755 --- a/gitk +++ b/gitk @@ -7838,6 +7838,13 @@ proc tcl_encoding {enc} { return {} } +# First check that Tcl/Tk is recent enough +if {[catch {package require Tk 8.4} err]} { + show_error {} . "Sorry, gitk cannot run with this version of Tcl/Tk.\n\ + Gitk requires at least Tcl/Tk 8.4." + exit 1 +} + # defaults... set datemode 0 set diffopts "-U 5 -p" -- cgit v1.2.3 From 3ebba3c724f77d149061c62f4414166649c2e56e Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Sat, 20 Oct 2007 22:10:52 +1000 Subject: gitk: Avoid an error when cherry-picking if HEAD has moved on MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This fixes an error reported by Adam PiÄ…tyszek: if the current HEAD is not in the graph that gitk knows about when we do a cherry-pick using gitk, then gitk hits an error when trying to update its internal representation of the topology. This avoids the error by not doing that update if the HEAD before the cherry-pick was a commit that gitk doesn't know about. Signed-off-by: Paul Mackerras --- gitk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gitk') diff --git a/gitk b/gitk index 06172a434b..f910cba8bf 100755 --- a/gitk +++ b/gitk @@ -6648,7 +6648,7 @@ proc addnewchild {id p} { global arcnos arcids arctags arcout arcend arcstart archeads growing global seeds allcommits - if {![info exists allcommits]} return + if {![info exists allcommits] || ![info exists arcnos($p)]} return lappend allids $id set allparents($id) [list $p] set allchildren($id) {} -- cgit v1.2.3 From e5ef6f952a13342065d44bab53999e8d8529cc3b Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Sun, 21 Oct 2007 12:58:42 +1000 Subject: gitk: Fix "can't unset prevlines(...)" Tcl error This fixes the error reported by Michele Ballabio, where gitk will throw a Tcl error "can't unset prevlines(...)" when displaying a commit that has a parent commit listed more than once, and the commit is the first child of that parent. The problem was basically that we had two variables, prevlines and lineends, and were relying on the invariant that prevlines($id) was set iff $id was in the lineends($r) list for some $r. But having a duplicate parent breaks that invariant since we end up with the parent listed twice in lineends. This fixes it by simplifying the logic to use only a single variable, lineend. It also rearranges things a little so that we don't try to draw the line for the duplicated parent twice. Signed-off-by: Paul Mackerras --- gitk | 21 +++++---------------- 1 file changed, 5 insertions(+), 16 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index f910cba8bf..41a1c69e19 100755 --- a/gitk +++ b/gitk @@ -3695,34 +3695,23 @@ proc drawcommits {row {endrow {}}} { drawcmitrow $r if {$r == $er} break set nextid [lindex $displayorder [expr {$r + 1}]] - if {$wasdrawn && [info exists iddrawn($nextid)]} { - catch {unset prevlines} - continue - } + if {$wasdrawn && [info exists iddrawn($nextid)]} continue drawparentlinks $id $r - if {[info exists lineends($r)]} { - foreach lid $lineends($r) { - unset prevlines($lid) - } - } set rowids [lindex $rowidlist $r] foreach lid $rowids { if {$lid eq {}} continue + if {[info exists lineend($lid)] && $lineend($lid) > $r} continue if {$lid eq $id} { # see if this is the first child of any of its parents foreach p [lindex $parentlist $r] { if {[lsearch -exact $rowids $p] < 0} { # make this line extend up to the child - set le [drawlineseg $p $r $er 0] - lappend lineends($le) $p - set prevlines($p) 1 + set lineend($p) [drawlineseg $p $r $er 0] } } - } elseif {![info exists prevlines($lid)]} { - set le [drawlineseg $lid $r $er 1] - lappend lineends($le) $lid - set prevlines($lid) 1 + } else { + set lineend($lid) [drawlineseg $lid $r $er 1] } } } -- cgit v1.2.3 From 7a39a17a873b818e3a4d121b3a43baf10f68cf61 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Tue, 23 Oct 2007 10:15:11 +1000 Subject: gitk: Limit diff display to listed paths by default When the user has specified a list of paths, either on the command line or when creating a view, gitk currently displays the diffs for all files that a commit has modified, not just the ones that match the path list. This is different from other git commands such as git log. This change makes gitk behave the same as these other git commands by default, that is, gitk only displays the diffs for files that match the path list. There is now a checkbox labelled "Limit diffs to listed paths" in the Edit/Preferences pane. If that is unchecked, gitk will display the diffs for all files as before. When gitk is run with the --merge flag, it will get the list of unmerged files at startup, intersect that with the paths listed on the command line (if any), and use that as the list of paths. Signed-off-by: Paul Mackerras --- gitk | 96 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 86 insertions(+), 10 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 41a1c69e19..248f5fbd04 100755 --- a/gitk +++ b/gitk @@ -1019,7 +1019,7 @@ proc savestuff {w} { global stuffsaved findmergefiles maxgraphpct global maxwidth showneartags showlocalchanges global viewname viewfiles viewargs viewperm nextviewnum - global cmitmode wrapcomment datetimeformat + global cmitmode wrapcomment datetimeformat limitdiffs global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor if {$stuffsaved} return @@ -1038,6 +1038,7 @@ proc savestuff {w} { puts $f [list set showneartags $showneartags] puts $f [list set showlocalchanges $showlocalchanges] puts $f [list set datetimeformat $datetimeformat] + puts $f [list set limitdiffs $limitdiffs] puts $f [list set bgcolor $bgcolor] puts $f [list set fgcolor $fgcolor] puts $f [list set colors $colors] @@ -5015,9 +5016,31 @@ proc startdiff {ids} { } } +proc path_filter {filter name} { + foreach p $filter { + set l [string length $p] + if {[string compare -length $l $p $name] == 0 && + ([string length $name] == $l || [string index $name $l] eq "/")} { + return 1 + } + } + return 0 +} + proc addtocflist {ids} { - global treediffs cflist - add_flist $treediffs($ids) + global treediffs cflist viewfiles curview limitdiffs + + if {$limitdiffs && $viewfiles($curview) ne {}} { + set flist {} + foreach f $treediffs($ids) { + if {[path_filter $viewfiles($curview) $f]} { + lappend flist $f + } + } + } else { + set flist $treediffs($ids) + } + add_flist $flist getblobdiffs $ids } @@ -5124,9 +5147,14 @@ proc getblobdiffs {ids} { global diffopts blobdifffd diffids env global diffinhdr treediffs global diffcontext + global limitdiffs viewfiles curview set env(GIT_DIFF_OPTS) $diffopts - if {[catch {set bdf [open [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"] r]} err]} { + set cmd [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"] + if {$limitdiffs && $viewfiles($curview) ne {}} { + set cmd [concat $cmd $viewfiles($curview)] + } + if {[catch {set bdf [open $cmd r]} err]} { puts "error getting diffs: $err" return } @@ -7382,7 +7410,7 @@ proc doprefs {} { global maxwidth maxgraphpct diffopts global oldprefs prefstop showneartags showlocalchanges global bgcolor fgcolor ctext diffcolors selectbgcolor - global uifont tabstop + global uifont tabstop limitdiffs set top .gitkprefs set prefstop $top @@ -7390,7 +7418,8 @@ proc doprefs {} { raise $top return } - foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} { + foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges \ + limitdiffs} { set oldprefs($v) [set $v] } toplevel $top @@ -7428,6 +7457,11 @@ proc doprefs {} { label $top.tabstopl -text "tabstop" -font optionfont spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop grid x $top.tabstopl $top.tabstop -sticky w + frame $top.ldiff + label $top.ldiff.l -text "Limit diffs to listed paths" -font optionfont + checkbutton $top.ldiff.b -variable limitdiffs + pack $top.ldiff.b $top.ldiff.l -side left + grid x $top.ldiff -sticky w label $top.cdisp -text "Colors: press to choose" $top.cdisp configure -font $uifont @@ -7514,9 +7548,10 @@ proc setfg {c} { proc prefscan {} { global maxwidth maxgraphpct diffopts - global oldprefs prefstop showneartags showlocalchanges + global oldprefs prefstop showneartags showlocalchanges limitdiffs - foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} { + foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges \ + limitdiffs} { set $v $oldprefs($v) } catch {destroy $prefstop} @@ -7526,7 +7561,7 @@ proc prefscan {} { proc prefsok {} { global maxwidth maxgraphpct global oldprefs prefstop showneartags showlocalchanges - global charspc ctext tabstop + global charspc ctext tabstop limitdiffs catch {destroy $prefstop} unset prefstop @@ -7541,7 +7576,8 @@ proc prefsok {} { if {$maxwidth != $oldprefs(maxwidth) || $maxgraphpct != $oldprefs(maxgraphpct)} { redisplay - } elseif {$showneartags != $oldprefs(showneartags)} { + } elseif {$showneartags != $oldprefs(showneartags) || + $limitdiffs != $oldprefs(limitdiffs)} { reselectline } } @@ -7869,6 +7905,7 @@ set showneartags 1 set maxrefs 20 set maxlinelen 200 set showlocalchanges 1 +set limitdiffs 1 set datetimeformat "%Y-%m-%d %H:%M:%S" set colors {green red blue magenta darkgrey brown orange} @@ -7892,6 +7929,7 @@ if {![file isdirectory $gitdir]} { exit 1 } +set mergeonly 0 set revtreeargs {} set cmdline_files {} set i 0 @@ -7899,6 +7937,10 @@ foreach arg $argv { switch -- $arg { "" { } "-d" { set datemode 1 } + "--merge" { + set mergeonly 1 + lappend revtreeargs $arg + } "--" { set cmdline_files [lrange $argv [expr {$i + 1}] end] break @@ -7939,6 +7981,40 @@ if {$i >= [llength $argv] && $revtreeargs ne {}} { } } +if {$mergeonly} { + # find the list of unmerged files + set mlist {} + set nr_unmerged 0 + if {[catch { + set fd [open "| git ls-files -u" r] + } err]} { + show_error {} . "Couldn't get list of unmerged files: $err" + exit 1 + } + while {[gets $fd line] >= 0} { + set i [string first "\t" $line] + if {$i < 0} continue + set fname [string range $line [expr {$i+1}] end] + if {[lsearch -exact $mlist $fname] >= 0} continue + incr nr_unmerged + if {$cmdline_files eq {} || [path_filter $cmdline_files $fname]} { + lappend mlist $fname + } + } + catch {close $fd} + if {$mlist eq {}} { + if {$nr_unmerged == 0} { + show_error {} . "No files selected: --merge specified but\ + no files are unmerged." + } else { + show_error {} . "No files selected: --merge specified but\ + no unmerged files are within file limit." + } + exit 1 + } + set cmdline_files $mlist +} + set nullid "0000000000000000000000000000000000000000" set nullid2 "0000000000000000000000000000000000000001" -- cgit v1.2.3 From 94503918e480123d0d4cf03b03153e4d83cdfd4e Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Tue, 23 Oct 2007 10:33:38 +1000 Subject: gitk: Ensure tabstop setting gets restored by Cancel button We weren't restoring the tabstop setting if the user pressed the Cancel button in the Edit/Preferences window. Also improved the label for the checkbox (made it "Tab spacing" rather than the laconic "tabstop") and moved it above the "Display nearby tags" checkbox. Signed-off-by: Paul Mackerras --- gitk | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 248f5fbd04..0d3705c43c 100755 --- a/gitk +++ b/gitk @@ -7419,7 +7419,7 @@ proc doprefs {} { return } foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges \ - limitdiffs} { + limitdiffs tabstop} { set oldprefs($v) [set $v] } toplevel $top @@ -7449,14 +7449,14 @@ proc doprefs {} { -font optionfont entry $top.diffopt -width 20 -textvariable diffopts grid x $top.diffoptl $top.diffopt -sticky w + label $top.tabstopl -text "Tab spacing" -font optionfont + spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop + grid x $top.tabstopl $top.tabstop -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.tabstopl -text "tabstop" -font optionfont - spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop - grid x $top.tabstopl $top.tabstop -sticky w frame $top.ldiff label $top.ldiff.l -text "Limit diffs to listed paths" -font optionfont checkbutton $top.ldiff.b -variable limitdiffs @@ -7547,11 +7547,11 @@ proc setfg {c} { } proc prefscan {} { - global maxwidth maxgraphpct diffopts - global oldprefs prefstop showneartags showlocalchanges limitdiffs + global oldprefs prefstop foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges \ - limitdiffs} { + limitdiffs tabstop} { + global $v set $v $oldprefs($v) } catch {destroy $prefstop} -- cgit v1.2.3 From a137a90f49e30fdcb24da0f9ff5c21b28d9cb227 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Tue, 23 Oct 2007 21:12:49 +1000 Subject: gitk: Integrate the reset progress bar in the main frame This makes the reset function use a progress bar in the same location as the progress bars for reading in commits and for finding commits, instead of a progress bar in a separate detached window. The progress bar for resetting is red. This also puts "Resetting" in the status window while the reset is in progress. The setting of the status window is done through an extension of the interface used for setting the watch cursor. Signed-off-by: Paul Mackerras --- gitk | 48 +++++++++++++++++++++++++++--------------------- 1 file changed, 27 insertions(+), 21 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 3b3cc4bd93..722e47869b 100755 --- a/gitk +++ b/gitk @@ -626,6 +626,7 @@ proc makewindow {} { global bgcolor fgcolor bglist fglist diffcolors selectbgcolor global headctxmenu progresscanv progressitem progresscoords statusw global fprogitem fprogcoord lastprogupdate progupdatepending + global rprogitem rprogcoord global have_tk85 menu .bar @@ -752,9 +753,11 @@ proc makewindow {} { canvas $progresscanv -relief sunken -height $h -borderwidth 2 set progressitem [$progresscanv create rect -1 0 0 $h -fill green] set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow] + set rprogitem [$progresscanv create rect -1 0 0 $h -fill red] pack $progresscanv -side right -expand 1 -fill x set progresscoords {0 0} set fprogcoord 0 + set rprogcoord 0 bind $progresscanv adjustprogress set lastprogupdate [clock clicks -milliseconds] set progupdatepending 0 @@ -1110,6 +1113,7 @@ proc click {w} { proc adjustprogress {} { global progresscanv progressitem progresscoords global fprogitem fprogcoord lastprogupdate progupdatepending + global rprogitem rprogcoord set w [expr {[winfo width $progresscanv] - 4}] set x0 [expr {$w * [lindex $progresscoords 0]}] @@ -1117,6 +1121,7 @@ proc adjustprogress {} { set h [winfo height $progresscanv] $progresscanv coords $progressitem $x0 0 $x1 $h $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h + $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h set now [clock clicks -milliseconds] if {$now >= $lastprogupdate + 100} { set progupdatepending 0 @@ -4195,20 +4200,30 @@ proc settextcursor {c} { set curtextcursor $c } -proc nowbusy {what} { - global isbusy +proc nowbusy {what {name {}}} { + global isbusy busyname statusw if {[array names isbusy] eq {}} { . config -cursor watch settextcursor watch } set isbusy($what) 1 + set busyname($what) $name + if {$name ne {}} { + $statusw conf -text $name + } } proc notbusy {what} { - global isbusy maincursor textcursor + global isbusy maincursor textcursor busyname statusw - catch {unset isbusy($what)} + catch { + unset isbusy($what) + if {$busyname($what) ne {} && + [$statusw cget -text] eq $busyname($what)} { + $statusw conf -text {} + } + } if {[array names isbusy] eq {}} { . config -cursor $maincursor settextcursor $textcursor @@ -6432,32 +6447,23 @@ proc resethead {} { error_popup $err } else { dohidelocalchanges - set w ".resetprogress" - filerun $fd [list readresetstat $fd $w] - toplevel $w - wm transient $w - wm title $w "Reset progress" - message $w.m -text "Reset in progress, please wait..." \ - -justify center -aspect 1000 - pack $w.m -side top -fill x -padx 20 -pady 5 - canvas $w.c -width 150 -height 20 -bg white - $w.c create rect 0 0 0 20 -fill green -tags rect - pack $w.c -side top -fill x -padx 20 -pady 5 -expand 1 - nowbusy reset + filerun $fd [list readresetstat $fd] + nowbusy reset "Resetting" } } -proc readresetstat {fd w} { - global mainhead mainheadid showlocalchanges +proc readresetstat {fd} { + global mainhead mainheadid showlocalchanges rprogcoord if {[gets $fd line] >= 0} { if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} { - set x [expr {($m * 150) / $n}] - $w.c coords rect 0 0 $x 20 + set rprogcoord [expr {1.0 * $m / $n}] + adjustprogress } return 1 } - destroy $w + set rprogcoord 0 + adjustprogress notbusy reset if {[catch {close $fd} err]} { error_popup $err -- cgit v1.2.3 From 4570b7e9d716e939287dea8193b7d2fb82e9f192 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Tue, 23 Oct 2007 21:19:06 +1000 Subject: gitk: Use the status window for other functions This sets the status window when reading commits, searching through commits, cherry-picking or checking out a head. Signed-off-by: Paul Mackerras --- gitk | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 722e47869b..951d39e21e 100755 --- a/gitk +++ b/gitk @@ -111,7 +111,7 @@ proc start_rev_list {view} { fconfigure $fd -encoding $tclencoding } filerun $fd [list getcommitlines $fd $view] - nowbusy $view + nowbusy $view "Reading" if {$view == $curview} { set progressdirn 1 set progresscoords {0 0} @@ -4264,7 +4264,7 @@ proc dofind {{rev 0}} { set findstartline $selectedline } set findcurline $findstartline - nowbusy finding + nowbusy finding "Searching" if {$gdttype ne "containing:" && ![info exists filehighlight]} { after cancel do_file_hl $fh_serial do_file_hl $fh_serial @@ -4303,7 +4303,7 @@ proc findnext {restart} { } else { set find_dirn 1 run findmore - nowbusy finding + nowbusy finding "Searching" } } @@ -4316,7 +4316,7 @@ proc findprev {} { } else { set find_dirn -1 run findmorerev - nowbusy finding + nowbusy finding "Searching" } } @@ -6381,7 +6381,7 @@ proc cherrypick {} { included in branch $mainhead -- really re-apply it?"] if {!$ok} return } - nowbusy cherrypick + nowbusy cherrypick "Cherry-picking" update # Unfortunately git-cherry-pick writes stuff to stderr even when # no error occurs, and exec takes that as an indication of error... @@ -6505,7 +6505,7 @@ proc cobranch {} { # check the tree is clean first?? set oldmainhead $mainhead - nowbusy checkout + nowbusy checkout "Checking out" update dohidelocalchanges if {[catch { -- cgit v1.2.3 From bd8f677e1c8349b9128490e2a21e0f573d0bea1d Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Tue, 23 Oct 2007 22:37:23 +1000 Subject: gitk: Fix some bugs with path limiting in the diff display First, we weren't putting "--" between the ids and the paths in the git diff-tree/diff-index/diff-files command, so if there was a tag and a file with the same name, we could get an ambiguity in the command. This puts the "--" in to make it clear that the paths are paths. Secondly, this implements the path limiting for merge diffs as well as the normal 2-way diffs. Signed-off-by: Paul Mackerras --- gitk | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'gitk') diff --git a/gitk b/gitk index 0d3705c43c..f41e30207b 100755 --- a/gitk +++ b/gitk @@ -4913,12 +4913,16 @@ proc mergediff {id l} { global diffmergeid diffopts mdifffd global diffids global parentlist + global limitdiffs viewfiles curview set diffmergeid $id set diffids $id # this doesn't seem to actually affect anything... set env(GIT_DIFF_OPTS) $diffopts set cmd [concat | git diff-tree --no-commit-id --cc $id] + if {$limitdiffs && $viewfiles($curview) ne {}} { + set cmd [concat $cmd -- $viewfiles($curview)] + } if {[catch {set mdf [open $cmd r]} err]} { error_popup "Error getting merge diffs: $err" return @@ -5152,7 +5156,7 @@ proc getblobdiffs {ids} { set env(GIT_DIFF_OPTS) $diffopts set cmd [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"] if {$limitdiffs && $viewfiles($curview) ne {}} { - set cmd [concat $cmd $viewfiles($curview)] + set cmd [concat $cmd -- $viewfiles($curview)] } if {[catch {set bdf [open $cmd r]} err]} { puts "error getting diffs: $err" -- cgit v1.2.3 From 74a40c71102ea925b174da15c74afb15b6b82537 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Wed, 24 Oct 2007 10:16:56 +1000 Subject: gitk: Fix a couple more bugs in the path limiting First, paths ending in a slash were not matching anything. This fixes path_filter to handle paths ending in a slash (such entries have to match a directory, and can't match a file, e.g., foo/bar/ can't match a plain file called foo/bar). Secondly, clicking in the file list pane (bottom right) was broken because $treediffs($ids) contained all the files modified by the commit, not just those within the file list. This fixes that too. Signed-off-by: Paul Mackerras --- gitk | 47 +++++++++++++++++++++++++++++------------------ 1 file changed, 29 insertions(+), 18 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index f41e30207b..ff5eb5e8c4 100755 --- a/gitk +++ b/gitk @@ -5023,28 +5023,25 @@ proc startdiff {ids} { proc path_filter {filter name} { foreach p $filter { set l [string length $p] - if {[string compare -length $l $p $name] == 0 && - ([string length $name] == $l || [string index $name $l] eq "/")} { - return 1 + if {[string index $p end] eq "/"} { + if {[string compare -length $l $p $name] == 0} { + return 1 + } + } else { + if {[string compare -length $l $p $name] == 0 && + ([string length $name] == $l || + [string index $name $l] eq "/")} { + return 1 + } } } return 0 } proc addtocflist {ids} { - global treediffs cflist viewfiles curview limitdiffs + global treediffs - if {$limitdiffs && $viewfiles($curview) ne {}} { - set flist {} - foreach f $treediffs($ids) { - if {[path_filter $viewfiles($curview) $f]} { - lappend flist $f - } - } - } else { - set flist $treediffs($ids) - } - add_flist $flist + add_flist $treediffs($ids) getblobdiffs $ids } @@ -5100,7 +5097,7 @@ proc gettreediffs {ids} { proc gettreediffline {gdtf ids} { global treediff treediffs treepending diffids diffmergeid - global cmitmode + global cmitmode viewfiles curview limitdiffs set nr 0 while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} { @@ -5117,7 +5114,17 @@ proc gettreediffline {gdtf ids} { return [expr {$nr >= 1000? 2: 1}] } close $gdtf - set treediffs($ids) $treediff + if {$limitdiffs && $viewfiles($curview) ne {}} { + set flist {} + foreach f $treediff { + if {[path_filter $viewfiles($curview) $f]} { + lappend flist $f + } + } + set treediffs($ids) $flist + } else { + set treediffs($ids) $treediff + } unset treepending if {$cmitmode eq "tree"} { gettree $diffids @@ -7565,7 +7572,7 @@ proc prefscan {} { proc prefsok {} { global maxwidth maxgraphpct global oldprefs prefstop showneartags showlocalchanges - global charspc ctext tabstop limitdiffs + global charspc ctext tabstop limitdiffs treediffs catch {destroy $prefstop} unset prefstop @@ -7577,6 +7584,10 @@ proc prefsok {} { dohidelocalchanges } } + if {$limitdiffs != $oldprefs(limitdiffs)} { + # treediffs elements are limited by path + catch {unset treediffs} + } if {$maxwidth != $oldprefs(maxwidth) || $maxgraphpct != $oldprefs(maxgraphpct)} { redisplay -- cgit v1.2.3 From cca5d946d692fde7ea5408a694cb4b1c97a5a838 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Sat, 27 Oct 2007 21:16:56 +1000 Subject: gitk: Simplify the code for finding commits This unifies findmore and findmorerev, and adds the ability to do a search with or without wrap around from the end of the list of commits to the beginning (or vice versa for reverse searches). findnext and findprev are gone, and the buttons and keys for searching all call dofind now. dofind doesn't unmark the matches to start with. Shift-up and shift-down are back by popular request, and the searches they do don't wrap around. The other keys that do searches (/, ?, return, M-f) do wrapping searches except for M-g. Signed-off-by: Paul Mackerras --- gitk | 206 ++++++++++++++++++------------------------------------------------- 1 file changed, 54 insertions(+), 152 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 135511e9fb..5230e3bb9d 100755 --- a/gitk +++ b/gitk @@ -764,8 +764,8 @@ proc makewindow {} { # build up the bottom bar of upper window label .tf.lbar.flabel -text "Find " -font uifont - button .tf.lbar.fnext -text "next" -command dofind -font uifont - button .tf.lbar.fprev -text "prev" -command {dofind 1} -font uifont + button .tf.lbar.fnext -text "next" -command {dofind 1 1} -font uifont + button .tf.lbar.fprev -text "prev" -command {dofind -1 1} -font uifont label .tf.lbar.flab2 -text " commit " -font uifont pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \ -side left -fill y @@ -959,6 +959,8 @@ proc makewindow {} { bindkey sellastline bind . "selnextline -1" bind . "selnextline 1" + bind . "dofind -1 0" + bind . "dofind 1 0" bindkey "goforw" bindkey "goback" bind . "selnextpage -1" @@ -983,14 +985,14 @@ proc makewindow {} { bindkey b "$ctext yview scroll -1 pages" bindkey d "$ctext yview scroll 18 units" bindkey u "$ctext yview scroll -18 units" - bindkey / {findnext 1} - bindkey {findnext 0} - bindkey ? findprev + bindkey / {dofind 1 1} + bindkey {dofind 1 1} + bindkey ? {dofind -1 1} bindkey f nextfile bindkey updatecommits bind . <$M1B-q> doquit - bind . <$M1B-f> dofind - bind . <$M1B-g> {findnext 0} + bind . <$M1B-f> {dofind 1 1} + bind . <$M1B-g> {dofind 1 0} bind . <$M1B-r> dosearchback bind . <$M1B-s> dosearch bind . <$M1B-equal> {incrfont 1} @@ -999,7 +1001,7 @@ proc makewindow {} { bind . <$M1B-KP_Subtract> {incrfont -1} wm protocol . WM_DELETE_WINDOW doquit bind . "click %W" - bind $fstring dofind + bind $fstring {dofind 1 1} bind $sha1entry gotocommit bind $sha1entry <> clearsha1 bind $cflist <1> {sel_flist %W %x %y; break} @@ -1325,8 +1327,8 @@ Gitk key bindings: <$M1T-Down> Scroll commit list down one line <$M1T-PageUp> Scroll commit list up one page <$M1T-PageDown> Scroll commit list down one page - Move to previous highlighted line - Move to next highlighted line + Find backwards (upwards, later commits) + Find forwards (downwards, earlier commits) , b Scroll diff view up one page Scroll diff view up one page Scroll diff view down one page @@ -2459,11 +2461,7 @@ proc readfhighlight {} { return 0 } if {[info exists find_dirn]} { - if {$find_dirn > 0} { - run findmore - } else { - run findmorerev - } + run findmore } return 1 } @@ -4247,15 +4245,18 @@ proc findmatches {f} { return $matches } -proc dofind {{rev 0}} { +proc dofind {{dirn 1} {wrap 1}} { global findstring findstartline findcurline selectedline numcommits - global gdttype filehighlight fh_serial find_dirn + global gdttype filehighlight fh_serial find_dirn findallowwrap - unmarkmatches + if {[info exists find_dirn]} { + if {$find_dirn == $dirn} return + stopfinding + } focus . if {$findstring eq {} || $numcommits == 0} return if {![info exists selectedline]} { - set findstartline [lindex [visiblerows] $rev] + set findstartline [lindex [visiblerows] [expr {$dirn < 0}]] } else { set findstartline $selectedline } @@ -4265,13 +4266,9 @@ proc dofind {{rev 0}} { after cancel do_file_hl $fh_serial do_file_hl $fh_serial } - if {!$rev} { - set find_dirn 1 - run findmore - } else { - set find_dirn -1 - run findmorerev - } + set find_dirn $dirn + set findallowwrap $wrap + run findmore } proc stopfinding {} { @@ -4286,147 +4283,52 @@ proc stopfinding {} { } } -proc findnext {restart} { - global findcurline find_dirn - - if {[info exists find_dirn]} return - if {![info exists findcurline]} { - if {$restart} { - dofind - } else { - bell - } - } else { - set find_dirn 1 - run findmore - nowbusy finding "Searching" - } -} - -proc findprev {} { - global findcurline find_dirn - - if {[info exists find_dirn]} return - if {![info exists findcurline]} { - dofind 1 - } else { - set find_dirn -1 - run findmorerev - nowbusy finding "Searching" - } -} - proc findmore {} { global commitdata commitinfo numcommits findpattern findloc global findstartline findcurline displayorder global find_dirn gdttype fhighlights fprogcoord + global findallowwrap if {![info exists find_dirn]} { return 0 } set fldtypes {Headline Author Date Committer CDate Comments} - set l [expr {$findcurline + 1}] - if {$l >= $numcommits} { - set l 0 - } - if {$l <= $findstartline} { - set lim [expr {$findstartline + 1}] - } else { - set lim $numcommits - } - if {$lim - $l > 500} { - set lim [expr {$l + 500}] - } - set found 0 - set domore 1 - if {$gdttype eq "containing:"} { - for {} {$l < $lim} {incr l} { - set id [lindex $displayorder $l] - # shouldn't happen unless git log doesn't give all the commits... - if {![info exists commitdata($id)]} continue - if {![doesmatch $commitdata($id)]} continue - if {![info exists commitinfo($id)]} { - getcommit $id - } - set info $commitinfo($id) - foreach f $info ty $fldtypes { - if {($findloc eq "All fields" || $findloc eq $ty) && - [doesmatch $f]} { - set found 1 - break - } - } - if {$found} break + set l $findcurline + set moretodo 0 + if {$find_dirn > 0} { + incr l + if {$l >= $numcommits} { + set l 0 + } + if {$l <= $findstartline} { + set lim [expr {$findstartline + 1}] + } else { + set lim $numcommits + set moretodo $findallowwrap } } else { - for {} {$l < $lim} {incr l} { - set id [lindex $displayorder $l] - if {![info exists fhighlights($l)]} { - askfilehighlight $l $id - if {$domore} { - set domore 0 - set findcurline [expr {$l - 1}] - } - } elseif {$fhighlights($l)} { - set found $domore - break - } + if {$l == 0} { + set l $numcommits } - } - if {$found || ($domore && $l == $findstartline + 1)} { - unset findcurline - unset find_dirn - notbusy finding - set fprogcoord 0 - adjustprogress - if {$found} { - findselectline $l + incr l -1 + if {$l >= $findstartline} { + set lim [expr {$findstartline - 1}] } else { - bell + set lim -1 + set moretodo $findallowwrap } - return 0 } - if {!$domore} { - flushhighlights - } else { - set findcurline [expr {$l - 1}] - } - set n [expr {$findcurline - ($findstartline + 1)}] - if {$n < 0} { - incr n $numcommits - } - set fprogcoord [expr {$n * 1.0 / $numcommits}] - adjustprogress - return $domore -} - -proc findmorerev {} { - global commitdata commitinfo numcommits findpattern findloc - global findstartline findcurline displayorder - global find_dirn gdttype fhighlights fprogcoord - - if {![info exists find_dirn]} { - return 0 - } - set fldtypes {Headline Author Date Committer CDate Comments} - set l $findcurline - if {$l == 0} { - set l $numcommits - } - incr l -1 - if {$l >= $findstartline} { - set lim [expr {$findstartline - 1}] - } else { - set lim -1 - } - if {$l - $lim > 500} { - set lim [expr {$l - 500}] + set n [expr {($lim - $l) * $find_dirn}] + if {$n > 500} { + set n 500 + set moretodo 1 } set found 0 set domore 1 if {$gdttype eq "containing:"} { - for {} {$l > $lim} {incr l -1} { + for {} {$n > 0} {incr n -1; incr l $find_dirn} { set id [lindex $displayorder $l] + # shouldn't happen unless git log doesn't give all the commits... if {![info exists commitdata($id)]} continue if {![doesmatch $commitdata($id)]} continue if {![info exists commitinfo($id)]} { @@ -4443,13 +4345,13 @@ proc findmorerev {} { if {$found} break } } else { - for {} {$l > $lim} {incr l -1} { + for {} {$n > 0} {incr n -1; incr l $find_dirn} { set id [lindex $displayorder $l] if {![info exists fhighlights($l)]} { askfilehighlight $l $id if {$domore} { set domore 0 - set findcurline [expr {$l + 1}] + set findcurline [expr {$l - $find_dirn}] } } elseif {$fhighlights($l)} { set found $domore @@ -4457,7 +4359,7 @@ proc findmorerev {} { } } } - if {$found || ($domore && $l == $findstartline - 1)} { + if {$found || ($domore && !$moretodo)} { unset findcurline unset find_dirn notbusy finding @@ -4473,9 +4375,9 @@ proc findmorerev {} { if {!$domore} { flushhighlights } else { - set findcurline [expr {$l + 1}] + set findcurline [expr {$l - $find_dirn}] } - set n [expr {($findstartline - 1) - $findcurline}] + set n [expr {($findcurline - $findstartline) * $find_dirn - 1}] if {$n < 0} { incr n $numcommits } -- cgit v1.2.3 From 7388bcbc5431552718dde5c3259d861d2fa75a12 Mon Sep 17 00:00:00 2001 From: Paul Mackerras Date: Sat, 27 Oct 2007 21:31:07 +1000 Subject: gitk: Use the UI font for the diff/old version/new version radio buttons This makes the radio buttons for selecting whether to see the full diff, the old version or the new version use the same font as the other user interface elements. Signed-off-by: Paul Mackerras --- gitk | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'gitk') diff --git a/gitk b/gitk index 4efcbb7957..1da0b0af1d 100755 --- a/gitk +++ b/gitk @@ -830,11 +830,11 @@ proc makewindow {} { lappend entries $sstring trace add variable searchstring write incrsearch pack $sstring -side left -expand 1 -fill x - radiobutton .bleft.mid.diff -text "Diff" \ + radiobutton .bleft.mid.diff -text "Diff" -font uifont \ -command changediffdisp -variable diffelide -value {0 0} - radiobutton .bleft.mid.old -text "Old version" \ + radiobutton .bleft.mid.old -text "Old version" -font uifont \ -command changediffdisp -variable diffelide -value {0 1} - radiobutton .bleft.mid.new -text "New version" \ + radiobutton .bleft.mid.new -text "New version" -font uifont \ -command changediffdisp -variable diffelide -value {1 0} label .bleft.mid.labeldiffcontext -text " Lines of context: " \ -font uifont -- cgit v1.2.3 From 62ba5143ec2ab9d4083669b1b1679355e7639cd5 Mon Sep 17 00:00:00 2001 From: Junio C Hamano Date: Sat, 17 Nov 2007 10:51:16 -0800 Subject: Move gitk to its own subdirectory This is to prepare for gitk i18n effort that makes gitk not a single file project anymore. We may use subproject to bind git.git and gitk.git more loosely in the future, but we do not want to require everybody to have subproject aware git to be able to pull from git.git yet. Signed-off-by: Junio C Hamano --- gitk | 8661 ------------------------------------------------------------------ 1 file changed, 8661 deletions(-) delete mode 100755 gitk (limited to 'gitk') diff --git a/gitk b/gitk deleted file mode 100755 index 1da0b0af1d..0000000000 --- a/gitk +++ /dev/null @@ -1,8661 +0,0 @@ -#!/bin/sh -# Tcl ignores the next line -*- tcl -*- \ -exec wish "$0" -- "$@" - -# 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. - -proc gitdir {} { - global env - if {[info exists env(GIT_DIR)]} { - return $env(GIT_DIR) - } else { - return [exec git rev-parse --git-dir] - } -} - -# A simple scheduler for compute-intensive stuff. -# The aim is to make sure that event handlers for GUI actions can -# run at least every 50-100 ms. Unfortunately fileevent handlers are -# run before X event handlers, so reading from a fast source can -# make the GUI completely unresponsive. -proc run args { - global isonrunq runq - - set script $args - if {[info exists isonrunq($script)]} return - if {$runq eq {}} { - after idle dorunq - } - lappend runq [list {} $script] - set isonrunq($script) 1 -} - -proc filerun {fd script} { - fileevent $fd readable [list filereadable $fd $script] -} - -proc filereadable {fd script} { - global runq - - fileevent $fd readable {} - if {$runq eq {}} { - after idle dorunq - } - lappend runq [list $fd $script] -} - -proc dorunq {} { - global isonrunq runq - - set tstart [clock clicks -milliseconds] - set t0 $tstart - while {$runq ne {}} { - set fd [lindex $runq 0 0] - set script [lindex $runq 0 1] - set repeat [eval $script] - set t1 [clock clicks -milliseconds] - set t [expr {$t1 - $t0}] - set runq [lrange $runq 1 end] - if {$repeat ne {} && $repeat} { - if {$fd eq {} || $repeat == 2} { - # script returns 1 if it wants to be readded - # file readers return 2 if they could do more straight away - lappend runq [list $fd $script] - } else { - fileevent $fd readable [list filereadable $fd $script] - } - } elseif {$fd eq {}} { - unset isonrunq($script) - } - set t0 $t1 - if {$t1 - $tstart >= 80} break - } - if {$runq ne {}} { - after idle dorunq - } -} - -# Start off a git rev-list process and arrange to read its output -proc start_rev_list {view} { - global startmsecs - global commfd leftover tclencoding datemode - global viewargs viewfiles commitidx viewcomplete vnextroot - global showlocalchanges commitinterest mainheadid - global progressdirn progresscoords proglastnc curview - - set startmsecs [clock clicks -milliseconds] - set commitidx($view) 0 - set viewcomplete($view) 0 - set vnextroot($view) 0 - set order "--topo-order" - if {$datemode} { - set order "--date-order" - } - if {[catch { - set fd [open [concat | git log --no-color -z --pretty=raw $order --parents \ - --boundary $viewargs($view) "--" $viewfiles($view)] r] - } err]} { - error_popup "Error executing git rev-list: $err" - exit 1 - } - set commfd($view) $fd - set leftover($view) {} - if {$showlocalchanges} { - lappend commitinterest($mainheadid) {dodiffindex} - } - fconfigure $fd -blocking 0 -translation lf -eofchar {} - if {$tclencoding != {}} { - fconfigure $fd -encoding $tclencoding - } - filerun $fd [list getcommitlines $fd $view] - nowbusy $view "Reading" - if {$view == $curview} { - set progressdirn 1 - set progresscoords {0 0} - set proglastnc 0 - } -} - -proc stop_rev_list {} { - global commfd curview - - if {![info exists commfd($curview)]} return - set fd $commfd($curview) - catch { - set pid [pid $fd] - exec kill $pid - } - catch {close $fd} - unset commfd($curview) -} - -proc getcommits {} { - global phase canv curview - - set phase getcommits - initlayout - start_rev_list $curview - show_status "Reading commits..." -} - -# This makes a string representation of a positive integer which -# sorts as a string in numerical order -proc strrep {n} { - if {$n < 16} { - return [format "%x" $n] - } elseif {$n < 256} { - return [format "x%.2x" $n] - } elseif {$n < 65536} { - return [format "y%.4x" $n] - } - return [format "z%.8x" $n] -} - -proc getcommitlines {fd view} { - global commitlisted commitinterest - global leftover commfd - global displayorder commitidx viewcomplete commitrow commitdata - global parentlist children curview hlview - global vparentlist vdisporder vcmitlisted - global ordertok vnextroot idpending - - set stuff [read $fd 500000] - # git log doesn't terminate the last commit with a null... - if {$stuff == {} && $leftover($view) ne {} && [eof $fd]} { - set stuff "\0" - } - if {$stuff == {}} { - if {![eof $fd]} { - return 1 - } - # Check if we have seen any ids listed as parents that haven't - # appeared in the list - foreach vid [array names idpending "$view,*"] { - # should only get here if git log is buggy - set id [lindex [split $vid ","] 1] - set commitrow($vid) $commitidx($view) - incr commitidx($view) - if {$view == $curview} { - lappend parentlist {} - lappend displayorder $id - lappend commitlisted 0 - } else { - lappend vparentlist($view) {} - lappend vdisporder($view) $id - lappend vcmitlisted($view) 0 - } - } - set viewcomplete($view) 1 - global viewname progresscoords - unset commfd($view) - notbusy $view - set progresscoords {0 0} - adjustprogress - # set it blocking so we wait for the process to terminate - fconfigure $fd -blocking 1 - if {[catch {close $fd} err]} { - set fv {} - if {$view != $curview} { - set fv " for the \"$viewname($view)\" view" - } - if {[string range $err 0 4] == "usage"} { - set err "Gitk: error reading commits$fv:\ - bad arguments to git rev-list." - if {$viewname($view) eq "Command line"} { - append err \ - " (Note: arguments to gitk are passed to git rev-list\ - to allow selection of commits to be displayed.)" - } - } else { - set err "Error reading commits$fv: $err" - } - error_popup $err - } - if {$view == $curview} { - run chewcommits $view - } - return 0 - } - set start 0 - set gotsome 0 - while 1 { - set i [string first "\0" $stuff $start] - if {$i < 0} { - append leftover($view) [string range $stuff $start end] - break - } - if {$start == 0} { - set cmit $leftover($view) - append cmit [string range $stuff 0 [expr {$i - 1}]] - set leftover($view) {} - } else { - set cmit [string range $stuff $start [expr {$i - 1}]] - } - set start [expr {$i + 1}] - set j [string first "\n" $cmit] - set ok 0 - set listed 1 - if {$j >= 0 && [string match "commit *" $cmit]} { - set ids [string range $cmit 7 [expr {$j - 1}]] - if {[string match {[-<>]*} $ids]} { - switch -- [string index $ids 0] { - "-" {set listed 0} - "<" {set listed 2} - ">" {set listed 3} - } - set ids [string range $ids 1 end] - } - set ok 1 - foreach id $ids { - if {[string length $id] != 40} { - set ok 0 - break - } - } - } - if {!$ok} { - set shortcmit $cmit - if {[string length $shortcmit] > 80} { - set shortcmit "[string range $shortcmit 0 80]..." - } - error_popup "Can't parse git log output: {$shortcmit}" - exit 1 - } - set id [lindex $ids 0] - if {![info exists ordertok($view,$id)]} { - set otok "o[strrep $vnextroot($view)]" - incr vnextroot($view) - set ordertok($view,$id) $otok - } else { - set otok $ordertok($view,$id) - unset idpending($view,$id) - } - if {$listed} { - set olds [lrange $ids 1 end] - if {[llength $olds] == 1} { - set p [lindex $olds 0] - lappend children($view,$p) $id - if {![info exists ordertok($view,$p)]} { - set ordertok($view,$p) $ordertok($view,$id) - set idpending($view,$p) 1 - } - } else { - set i 0 - foreach p $olds { - if {$i == 0 || [lsearch -exact $olds $p] >= $i} { - lappend children($view,$p) $id - } - if {![info exists ordertok($view,$p)]} { - set ordertok($view,$p) "$otok[strrep $i]]" - set idpending($view,$p) 1 - } - incr i - } - } - } else { - set olds {} - } - if {![info exists children($view,$id)]} { - set children($view,$id) {} - } - set commitdata($id) [string range $cmit [expr {$j + 1}] end] - set commitrow($view,$id) $commitidx($view) - incr commitidx($view) - if {$view == $curview} { - lappend parentlist $olds - lappend displayorder $id - lappend commitlisted $listed - } else { - lappend vparentlist($view) $olds - lappend vdisporder($view) $id - lappend vcmitlisted($view) $listed - } - if {[info exists commitinterest($id)]} { - foreach script $commitinterest($id) { - eval [string map [list "%I" $id] $script] - } - unset commitinterest($id) - } - set gotsome 1 - } - if {$gotsome} { - run chewcommits $view - if {$view == $curview} { - # update progress bar - global progressdirn progresscoords proglastnc - set inc [expr {($commitidx($view) - $proglastnc) * 0.0002}] - set proglastnc $commitidx($view) - set l [lindex $progresscoords 0] - set r [lindex $progresscoords 1] - if {$progressdirn} { - set r [expr {$r + $inc}] - if {$r >= 1.0} { - set r 1.0 - set progressdirn 0 - } - if {$r > 0.2} { - set l [expr {$r - 0.2}] - } - } else { - set l [expr {$l - $inc}] - if {$l <= 0.0} { - set l 0.0 - set progressdirn 1 - } - set r [expr {$l + 0.2}] - } - set progresscoords [list $l $r] - adjustprogress - } - } - return 2 -} - -proc chewcommits {view} { - global curview hlview viewcomplete - global selectedline pending_select - - if {$view == $curview} { - layoutmore - if {$viewcomplete($view)} { - global displayorder commitidx phase - global numcommits startmsecs - - if {[info exists pending_select]} { - set row [first_real_row] - selectline $row 1 - } - if {$commitidx($curview) > 0} { - #set ms [expr {[clock clicks -milliseconds] - $startmsecs}] - #puts "overall $ms ms for $numcommits commits" - } else { - show_status "No commits selected" - } - notbusy layout - set phase {} - } - } - if {[info exists hlview] && $view == $hlview} { - vhighlightmore - } - return 0 -} - -proc readcommit {id} { - if {[catch {set contents [exec git cat-file commit $id]}]} return - parsecommit $id $contents 0 -} - -proc updatecommits {} { - global viewdata curview phase displayorder ordertok idpending - global children commitrow selectedline thickerline showneartags - - if {$phase ne {}} { - stop_rev_list - set phase {} - } - set n $curview - foreach id $displayorder { - catch {unset children($n,$id)} - catch {unset commitrow($n,$id)} - catch {unset ordertok($n,$id)} - } - foreach vid [array names idpending "$n,*"] { - unset idpending($vid) - } - set curview -1 - catch {unset selectedline} - catch {unset thickerline} - catch {unset viewdata($n)} - readrefs - changedrefs - if {$showneartags} { - getallcommits - } - showview $n -} - -proc parsecommit {id contents listed} { - global commitinfo cdate - - set inhdr 1 - set comment {} - set headline {} - set auname {} - set audate {} - set comname {} - set comdate {} - set hdrend [string first "\n\n" $contents] - if {$hdrend < 0} { - # should never happen... - set hdrend [string length $contents] - } - set header [string range $contents 0 [expr {$hdrend - 1}]] - set comment [string range $contents [expr {$hdrend + 2}] end] - foreach line [split $header "\n"] { - set tag [lindex $line 0] - if {$tag == "author"} { - set audate [lindex $line end-1] - set auname [lrange $line 1 end-2] - } elseif {$tag == "committer"} { - set comdate [lindex $line end-1] - set comname [lrange $line 1 end-2] - } - } - set headline {} - # take the first non-blank line of the comment as the headline - set headline [string trimleft $comment] - set i [string first "\n" $headline] - if {$i >= 0} { - set headline [string range $headline 0 $i] - } - set headline [string trimright $headline] - set i [string first "\r" $headline] - if {$i >= 0} { - set headline [string trimright [string range $headline 0 $i]] - } - if {!$listed} { - # git rev-list indents the comment by 4 spaces; - # if we got this via git cat-file, add the indentation - set newcomment {} - foreach line [split $comment "\n"] { - append newcomment " " - append newcomment $line - append newcomment "\n" - } - set comment $newcomment - } - if {$comdate != {}} { - set cdate($id) $comdate - } - set commitinfo($id) [list $headline $auname $audate \ - $comname $comdate $comment] -} - -proc getcommit {id} { - global commitdata commitinfo - - if {[info exists commitdata($id)]} { - parsecommit $id $commitdata($id) 1 - } else { - readcommit $id - if {![info exists commitinfo($id)]} { - set commitinfo($id) {"No commit information available"} - } - } - return 1 -} - -proc readrefs {} { - global tagids idtags headids idheads tagobjid - global otherrefids idotherrefs mainhead mainheadid - - foreach v {tagids idtags headids idheads otherrefids idotherrefs} { - catch {unset $v} - } - set refd [open [list | git show-ref -d] r] - while {[gets $refd line] >= 0} { - if {[string index $line 40] ne " "} continue - set id [string range $line 0 39] - set ref [string range $line 41 end] - if {![string match "refs/*" $ref]} continue - set name [string range $ref 5 end] - if {[string match "remotes/*" $name]} { - if {![string match "*/HEAD" $name]} { - set headids($name) $id - lappend idheads($id) $name - } - } elseif {[string match "heads/*" $name]} { - set name [string range $name 6 end] - set headids($name) $id - lappend idheads($id) $name - } elseif {[string match "tags/*" $name]} { - # this lets refs/tags/foo^{} overwrite refs/tags/foo, - # which is what we want since the former is the commit ID - set name [string range $name 5 end] - if {[string match "*^{}" $name]} { - set name [string range $name 0 end-3] - } else { - set tagobjid($name) $id - } - set tagids($name) $id - lappend idtags($id) $name - } else { - set otherrefids($name) $id - lappend idotherrefs($id) $name - } - } - catch {close $refd} - set mainhead {} - set mainheadid {} - catch { - set thehead [exec git symbolic-ref HEAD] - if {[string match "refs/heads/*" $thehead]} { - set mainhead [string range $thehead 11 end] - if {[info exists headids($mainhead)]} { - set mainheadid $headids($mainhead) - } - } - } -} - -# skip over fake commits -proc first_real_row {} { - global nullid nullid2 displayorder numcommits - - for {set row 0} {$row < $numcommits} {incr row} { - set id [lindex $displayorder $row] - if {$id ne $nullid && $id ne $nullid2} { - break - } - } - return $row -} - -# update things for a head moved to a child of its previous location -proc movehead {id name} { - global headids idheads - - removehead $headids($name) $name - set headids($name) $id - lappend idheads($id) $name -} - -# update things when a head has been removed -proc removehead {id name} { - global headids idheads - - if {$idheads($id) eq $name} { - unset idheads($id) - } else { - set i [lsearch -exact $idheads($id) $name] - if {$i >= 0} { - set idheads($id) [lreplace $idheads($id) $i $i] - } - } - unset headids($name) -} - -proc show_error {w top msg} { - 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 "destroy $top" - pack $w.ok -side bottom -fill x - bind $top "grab $top; focus $top" - bind $top "destroy $top" - tkwait window $top -} - -proc error_popup msg { - set w .error - toplevel $w - wm transient $w . - 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 tabstop - global findtype findtypemenu findloc findstring fstring geometry - global entries sha1entry sha1string sha1but - global diffcontextstring diffcontext - global maincursor textcursor curtextcursor - global rowctxmenu fakerowmenu mergemax wrapcomment - global highlight_files gdttype - global searchstring sstring - global bgcolor fgcolor bglist fglist diffcolors selectbgcolor - global headctxmenu progresscanv progressitem progresscoords statusw - global fprogitem fprogcoord lastprogupdate progupdatepending - global rprogitem rprogcoord - global have_tk85 - - menu .bar - .bar add cascade -label "File" -menu .bar.file - .bar configure -font uifont - menu .bar.file - .bar.file add command -label "Update" -command updatecommits - .bar.file add command -label "Reread references" -command rereadrefs - .bar.file add command -label "List references" -command showrefs - .bar.file add command -label "Quit" -command doquit - .bar.file configure -font uifont - menu .bar.edit - .bar add cascade -label "Edit" -menu .bar.edit - .bar.edit add command -label "Preferences" -command doprefs - .bar.edit configure -font uifont - - menu .bar.view -font uifont - .bar add cascade -label "View" -menu .bar.view - .bar.view add command -label "New view..." -command {newview 0} - .bar.view add command -label "Edit view..." -command editview \ - -state disabled - .bar.view add command -label "Delete view" -command delview -state disabled - .bar.view add separator - .bar.view add radiobutton -label "All files" -command {showview 0} \ - -variable selectedview -value 0 - - menu .bar.help - .bar add cascade -label "Help" -menu .bar.help - .bar.help add command -label "About gitk" -command about - .bar.help add command -label "Key bindings" -command keys - .bar.help configure -font uifont - . configure -menu .bar - - # the gui has upper and lower half, parts of a paned window. - panedwindow .ctop -orient vertical - - # possibly use assumed geometry - if {![info exists geometry(pwsash0)]} { - set geometry(topheight) [expr {15 * $linespc}] - set geometry(topwidth) [expr {80 * $charspc}] - set geometry(botheight) [expr {15 * $linespc}] - set geometry(botwidth) [expr {50 * $charspc}] - set geometry(pwsash0) "[expr {40 * $charspc}] 2" - set geometry(pwsash1) "[expr {60 * $charspc}] 2" - } - - # the upper half will have a paned window, a scroll bar to the right, and some stuff below - frame .tf -height $geometry(topheight) -width $geometry(topwidth) - frame .tf.histframe - panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4 - - # create three canvases - set cscroll .tf.histframe.csb - set canv .tf.histframe.pwclist.canv - canvas $canv \ - -selectbackground $selectbgcolor \ - -background $bgcolor -bd 0 \ - -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll" - .tf.histframe.pwclist add $canv - set canv2 .tf.histframe.pwclist.canv2 - canvas $canv2 \ - -selectbackground $selectbgcolor \ - -background $bgcolor -bd 0 -yscrollincr $linespc - .tf.histframe.pwclist add $canv2 - set canv3 .tf.histframe.pwclist.canv3 - canvas $canv3 \ - -selectbackground $selectbgcolor \ - -background $bgcolor -bd 0 -yscrollincr $linespc - .tf.histframe.pwclist add $canv3 - eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0) - eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1) - - # a scroll bar to rule them - scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0 - pack $cscroll -side right -fill y - bind .tf.histframe.pwclist {resizeclistpanes %W %w} - lappend bglist $canv $canv2 $canv3 - pack .tf.histframe.pwclist -fill both -expand 1 -side left - - # we have two button bars at bottom of top frame. Bar 1 - frame .tf.bar - frame .tf.lbar -height 15 - - set sha1entry .tf.bar.sha1 - set entries $sha1entry - set sha1but .tf.bar.sha1label - button $sha1but -text "SHA1 ID: " -state disabled -relief flat \ - -command gotocommit -width 8 -font uifont - $sha1but conf -disabledforeground [$sha1but cget -foreground] - pack .tf.bar.sha1label -side left - entry $sha1entry -width 40 -font textfont -textvariable sha1string - trace add variable sha1string write sha1change - pack $sha1entry -side left -pady 2 - - image create bitmap bm-left -data { - #define left_width 16 - #define left_height 16 - static unsigned char left_bits[] = { - 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00, - 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00, - 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01}; - } - image create bitmap bm-right -data { - #define right_width 16 - #define right_height 16 - static unsigned char right_bits[] = { - 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c, - 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c, - 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01}; - } - button .tf.bar.leftbut -image bm-left -command goback \ - -state disabled -width 26 - pack .tf.bar.leftbut -side left -fill y - button .tf.bar.rightbut -image bm-right -command goforw \ - -state disabled -width 26 - pack .tf.bar.rightbut -side left -fill y - - # Status label and progress bar - set statusw .tf.bar.status - label $statusw -width 15 -relief sunken -font uifont - pack $statusw -side left -padx 5 - set h [expr {[font metrics uifont -linespace] + 2}] - set progresscanv .tf.bar.progress - canvas $progresscanv -relief sunken -height $h -borderwidth 2 - set progressitem [$progresscanv create rect -1 0 0 $h -fill green] - set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow] - set rprogitem [$progresscanv create rect -1 0 0 $h -fill red] - pack $progresscanv -side right -expand 1 -fill x - set progresscoords {0 0} - set fprogcoord 0 - set rprogcoord 0 - bind $progresscanv adjustprogress - set lastprogupdate [clock clicks -milliseconds] - set progupdatepending 0 - - # build up the bottom bar of upper window - label .tf.lbar.flabel -text "Find " -font uifont - button .tf.lbar.fnext -text "next" -command {dofind 1 1} -font uifont - button .tf.lbar.fprev -text "prev" -command {dofind -1 1} -font uifont - label .tf.lbar.flab2 -text " commit " -font uifont - pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \ - -side left -fill y - set gdttype "containing:" - set gm [tk_optionMenu .tf.lbar.gdttype gdttype \ - "containing:" \ - "touching paths:" \ - "adding/removing string:"] - trace add variable gdttype write gdttype_change - $gm conf -font uifont - .tf.lbar.gdttype conf -font uifont - pack .tf.lbar.gdttype -side left -fill y - - set findstring {} - set fstring .tf.lbar.findstring - lappend entries $fstring - entry $fstring -width 30 -font textfont -textvariable findstring - trace add variable findstring write find_change - set findtype Exact - set findtypemenu [tk_optionMenu .tf.lbar.findtype \ - findtype Exact IgnCase Regexp] - trace add variable findtype write findcom_change - .tf.lbar.findtype configure -font uifont - .tf.lbar.findtype.menu configure -font uifont - set findloc "All fields" - tk_optionMenu .tf.lbar.findloc findloc "All fields" Headline \ - Comments Author Committer - trace add variable findloc write find_change - .tf.lbar.findloc configure -font uifont - .tf.lbar.findloc.menu configure -font uifont - pack .tf.lbar.findloc -side right - pack .tf.lbar.findtype -side right - pack $fstring -side left -expand 1 -fill x - - # Finish putting the upper half of the viewer together - pack .tf.lbar -in .tf -side bottom -fill x - pack .tf.bar -in .tf -side bottom -fill x - pack .tf.histframe -fill both -side top -expand 1 - .ctop add .tf - .ctop paneconfigure .tf -height $geometry(topheight) - .ctop paneconfigure .tf -width $geometry(topwidth) - - # now build up the bottom - panedwindow .pwbottom -orient horizontal - - # lower left, a text box over search bar, scroll bar to the right - # if we know window height, then that will set the lower text height, otherwise - # we set lower text height which will drive window height - if {[info exists geometry(main)]} { - frame .bleft -width $geometry(botwidth) - } else { - frame .bleft -width $geometry(botwidth) -height $geometry(botheight) - } - frame .bleft.top - frame .bleft.mid - - button .bleft.top.search -text "Search" -command dosearch \ - -font uifont - pack .bleft.top.search -side left -padx 5 - set sstring .bleft.top.sstring - entry $sstring -width 20 -font textfont -textvariable searchstring - lappend entries $sstring - trace add variable searchstring write incrsearch - pack $sstring -side left -expand 1 -fill x - radiobutton .bleft.mid.diff -text "Diff" -font uifont \ - -command changediffdisp -variable diffelide -value {0 0} - radiobutton .bleft.mid.old -text "Old version" -font uifont \ - -command changediffdisp -variable diffelide -value {0 1} - radiobutton .bleft.mid.new -text "New version" -font uifont \ - -command changediffdisp -variable diffelide -value {1 0} - label .bleft.mid.labeldiffcontext -text " Lines of context: " \ - -font uifont - pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left - spinbox .bleft.mid.diffcontext -width 5 -font textfont \ - -from 1 -increment 1 -to 10000000 \ - -validate all -validatecommand "diffcontextvalidate %P" \ - -textvariable diffcontextstring - .bleft.mid.diffcontext set $diffcontext - trace add variable diffcontextstring write diffcontextchange - lappend entries .bleft.mid.diffcontext - pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left - set ctext .bleft.ctext - text $ctext -background $bgcolor -foreground $fgcolor \ - -state disabled -font textfont \ - -yscrollcommand scrolltext -wrap none - if {$have_tk85} { - $ctext conf -tabstyle wordprocessor - } - scrollbar .bleft.sb -command "$ctext yview" - pack .bleft.top -side top -fill x - pack .bleft.mid -side top -fill x - pack .bleft.sb -side right -fill y - pack $ctext -side left -fill both -expand 1 - lappend bglist $ctext - lappend fglist $ctext - - $ctext tag conf comment -wrap $wrapcomment - $ctext tag conf filesep -font textfontbold -back "#aaaaaa" - $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 - $ctext tag conf m3 -fore purple - $ctext tag conf m4 -fore brown - $ctext tag conf m5 -fore "#009090" - $ctext tag conf m6 -fore magenta - $ctext tag conf m7 -fore "#808000" - $ctext tag conf m8 -fore "#009000" - $ctext tag conf m9 -fore "#ff0080" - $ctext tag conf m10 -fore cyan - $ctext tag conf m11 -fore "#b07070" - $ctext tag conf m12 -fore "#70b0f0" - $ctext tag conf m13 -fore "#70f0b0" - $ctext tag conf m14 -fore "#f0b070" - $ctext tag conf m15 -fore "#ff70b0" - $ctext tag conf mmax -fore darkgrey - set mergemax 16 - $ctext tag conf mresult -font textfontbold - $ctext tag conf msep -font textfontbold - $ctext tag conf found -back yellow - - .pwbottom add .bleft - .pwbottom paneconfigure .bleft -width $geometry(botwidth) - - # lower right - frame .bright - frame .bright.mode - radiobutton .bright.mode.patch -text "Patch" \ - -command reselectline -variable cmitmode -value "patch" - .bright.mode.patch configure -font uifont - radiobutton .bright.mode.tree -text "Tree" \ - -command reselectline -variable cmitmode -value "tree" - .bright.mode.tree configure -font uifont - grid .bright.mode.patch .bright.mode.tree -sticky ew - pack .bright.mode -side top -fill x - set cflist .bright.cfiles - set indent [font measure mainfont "nn"] - text $cflist \ - -selectbackground $selectbgcolor \ - -background $bgcolor -foreground $fgcolor \ - -font mainfont \ - -tabs [list $indent [expr {2 * $indent}]] \ - -yscrollcommand ".bright.sb set" \ - -cursor [. cget -cursor] \ - -spacing1 1 -spacing3 1 - lappend bglist $cflist - lappend fglist $cflist - scrollbar .bright.sb -command "$cflist yview" - pack .bright.sb -side right -fill y - pack $cflist -side left -fill both -expand 1 - $cflist tag configure highlight \ - -background [$cflist cget -selectbackground] - $cflist tag configure bold -font mainfontbold - - .pwbottom add .bright - .ctop add .pwbottom - - # restore window position if known - if {[info exists geometry(main)]} { - wm geometry . "$geometry(main)" - } - - if {[tk windowingsystem] eq {aqua}} { - set M1B M1 - } else { - set M1B Control - } - - bind .pwbottom {resizecdetpanes %W %w} - pack .ctop -fill both -expand 1 - bindall <1> {selcanvline %W %x %y} - #bindall {selcanvline %W %x %y} - if {[tk windowingsystem] == "win32"} { - bind . { windows_mousewheel_redirector %W %X %Y %D } - bind $ctext { windows_mousewheel_redirector %W %X %Y %D ; break } - } else { - bindall "allcanvs yview scroll -5 units" - bindall "allcanvs yview scroll 5 units" - if {[tk windowingsystem] eq "aqua"} { - bindall { - set delta [expr {- (%D)}] - allcanvs yview scroll $delta units - } - } - } - bindall <2> "canvscan mark %W %x %y" - bindall "canvscan dragto %W %x %y" - bindkey selfirstline - bindkey sellastline - bind . "selnextline -1" - bind . "selnextline 1" - bind . "dofind -1 0" - bind . "dofind 1 0" - bindkey "goforw" - bindkey "goback" - bind . "selnextpage -1" - bind . "selnextpage 1" - bind . <$M1B-Home> "allcanvs yview moveto 0.0" - bind . <$M1B-End> "allcanvs yview moveto 1.0" - bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units" - bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units" - bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages" - bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages" - bindkey "$ctext yview scroll -1 pages" - bindkey "$ctext yview scroll -1 pages" - bindkey "$ctext yview scroll 1 pages" - bindkey p "selnextline -1" - bindkey n "selnextline 1" - bindkey z "goback" - bindkey x "goforw" - bindkey i "selnextline -1" - bindkey k "selnextline 1" - bindkey j "goback" - bindkey l "goforw" - bindkey b "$ctext yview scroll -1 pages" - bindkey d "$ctext yview scroll 18 units" - bindkey u "$ctext yview scroll -18 units" - bindkey / {dofind 1 1} - bindkey {dofind 1 1} - bindkey ? {dofind -1 1} - bindkey f nextfile - bindkey updatecommits - bind . <$M1B-q> doquit - bind . <$M1B-f> {dofind 1 1} - bind . <$M1B-g> {dofind 1 0} - bind . <$M1B-r> dosearchback - bind . <$M1B-s> dosearch - bind . <$M1B-equal> {incrfont 1} - bind . <$M1B-KP_Add> {incrfont 1} - bind . <$M1B-minus> {incrfont -1} - bind . <$M1B-KP_Subtract> {incrfont -1} - wm protocol . WM_DELETE_WINDOW doquit - bind . "click %W" - bind $fstring {dofind 1 1} - bind $sha1entry gotocommit - bind $sha1entry <> clearsha1 - bind $cflist <1> {sel_flist %W %x %y; break} - bind $cflist {sel_flist %W %x %y; break} - bind $cflist {treeclick %W %x %y} - bind $cflist {pop_flist_menu %W %X %Y %x %y} - - set maincursor [. cget -cursor] - set textcursor [$ctext cget -cursor] - set curtextcursor $textcursor - - set rowctxmenu .rowctxmenu - menu $rowctxmenu -tearoff 0 - $rowctxmenu add command -label "Diff this -> selected" \ - -command {diffvssel 0} - $rowctxmenu add command -label "Diff selected -> this" \ - -command {diffvssel 1} - $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 - $rowctxmenu add command -label "Reset HEAD branch to here" \ - -command resethead - - set fakerowmenu .fakerowmenu - menu $fakerowmenu -tearoff 0 - $fakerowmenu add command -label "Diff this -> selected" \ - -command {diffvssel 0} - $fakerowmenu add command -label "Diff selected -> this" \ - -command {diffvssel 1} - $fakerowmenu add command -label "Make patch" -command mkpatch -# $fakerowmenu add command -label "Commit" -command {mkcommit 0} -# $fakerowmenu add command -label "Commit all" -command {mkcommit 1} -# $fakerowmenu add command -label "Revert local changes" -command revertlocal - - 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 - - global flist_menu - set flist_menu .flistctxmenu - menu $flist_menu -tearoff 0 - $flist_menu add command -label "Highlight this too" \ - -command {flist_hl 0} - $flist_menu add command -label "Highlight this only" \ - -command {flist_hl 1} -} - -# Windows sends all mouse wheel events to the current focused window, not -# the one where the mouse hovers, so bind those events here and redirect -# to the correct window -proc windows_mousewheel_redirector {W X Y D} { - global canv canv2 canv3 - set w [winfo containing -displayof $W $X $Y] - if {$w ne ""} { - set u [expr {$D < 0 ? 5 : -5}] - if {$w == $canv || $w == $canv2 || $w == $canv3} { - allcanvs yview scroll $u units - } else { - catch { - $w yview scroll $u units - } - } - } -} - -# mouse-2 makes all windows scan vertically, but only the one -# the cursor is in scans horizontally -proc canvscan {op w x y} { - global canv canv2 canv3 - foreach c [list $canv $canv2 $canv3] { - if {$c == $w} { - $c scan $op $x $y - } else { - $c scan $op 0 $y - } - } -} - -proc scrollcanv {cscroll f0 f1} { - $cscroll set $f0 $f1 - drawfrac $f0 $f1 - flushhighlights -} - -# when we make a key binding for the toplevel, make sure -# it doesn't get triggered when that key is pressed in the -# find string entry widget. -proc bindkey {ev script} { - global entries - bind . $ev $script - set escript [bind Entry $ev] - if {$escript == {}} { - set escript [bind Entry ] - } - foreach e $entries { - bind $e $ev "$escript; break" - } -} - -# set the focus back to the toplevel for any click outside -# the entry widgets -proc click {w} { - global ctext entries - foreach e [concat $entries $ctext] { - if {$w == $e} return - } - focus . -} - -# Adjust the progress bar for a change in requested extent or canvas size -proc adjustprogress {} { - global progresscanv progressitem progresscoords - global fprogitem fprogcoord lastprogupdate progupdatepending - global rprogitem rprogcoord - - set w [expr {[winfo width $progresscanv] - 4}] - set x0 [expr {$w * [lindex $progresscoords 0]}] - set x1 [expr {$w * [lindex $progresscoords 1]}] - set h [winfo height $progresscanv] - $progresscanv coords $progressitem $x0 0 $x1 $h - $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h - $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h - set now [clock clicks -milliseconds] - if {$now >= $lastprogupdate + 100} { - set progupdatepending 0 - update - } elseif {!$progupdatepending} { - set progupdatepending 1 - after [expr {$lastprogupdate + 100 - $now}] doprogupdate - } -} - -proc doprogupdate {} { - global lastprogupdate progupdatepending - - if {$progupdatepending} { - set progupdatepending 0 - set lastprogupdate [clock clicks -milliseconds] - update - } -} - -proc savestuff {w} { - global canv canv2 canv3 mainfont textfont uifont tabstop - global stuffsaved findmergefiles maxgraphpct - global maxwidth showneartags showlocalchanges - global viewname viewfiles viewargs viewperm nextviewnum - global cmitmode wrapcomment datetimeformat limitdiffs - global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor - - if {$stuffsaved} return - if {![winfo viewable .]} return - catch { - set f [open "~/.gitk-new" w] - puts $f [list set mainfont $mainfont] - puts $f [list set textfont $textfont] - puts $f [list set uifont $uifont] - puts $f [list set tabstop $tabstop] - puts $f [list set findmergefiles $findmergefiles] - puts $f [list set maxgraphpct $maxgraphpct] - 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 showlocalchanges $showlocalchanges] - puts $f [list set datetimeformat $datetimeformat] - puts $f [list set limitdiffs $limitdiffs] - 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 [list set diffcontext $diffcontext] - puts $f [list set selectbgcolor $selectbgcolor] - - puts $f "set geometry(main) [wm geometry .]" - puts $f "set geometry(topwidth) [winfo width .tf]" - puts $f "set geometry(topheight) [winfo height .tf]" - puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\"" - puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\"" - puts $f "set geometry(botwidth) [winfo width .bleft]" - puts $f "set geometry(botheight) [winfo height .bleft]" - - puts -nonewline $f "set permviews {" - for {set v 0} {$v < $nextviewnum} {incr v} { - if {$viewperm($v)} { - puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}" - } - } - puts $f "}" - close $f - file rename -force "~/.gitk-new" "~/.gitk" - } - set stuffsaved 1 -} - -proc resizeclistpanes {win w} { - global oldwidth - if {[info exists oldwidth($win)]} { - set s0 [$win sash coord 0] - set s1 [$win sash coord 1] - if {$w < 60} { - set sash0 [expr {int($w/2 - 2)}] - set sash1 [expr {int($w*5/6 - 2)}] - } else { - set factor [expr {1.0 * $w / $oldwidth($win)}] - set sash0 [expr {int($factor * [lindex $s0 0])}] - set sash1 [expr {int($factor * [lindex $s1 0])}] - if {$sash0 < 30} { - set sash0 30 - } - if {$sash1 < $sash0 + 20} { - set sash1 [expr {$sash0 + 20}] - } - if {$sash1 > $w - 10} { - set sash1 [expr {$w - 10}] - if {$sash0 > $sash1 - 20} { - set sash0 [expr {$sash1 - 20}] - } - } - } - $win sash place 0 $sash0 [lindex $s0 1] - $win sash place 1 $sash1 [lindex $s1 1] - } - set oldwidth($win) $w -} - -proc resizecdetpanes {win w} { - global oldwidth - if {[info exists oldwidth($win)]} { - set s0 [$win sash coord 0] - if {$w < 60} { - set sash0 [expr {int($w*3/4 - 2)}] - } else { - set factor [expr {1.0 * $w / $oldwidth($win)}] - set sash0 [expr {int($factor * [lindex $s0 0])}] - if {$sash0 < 45} { - set sash0 45 - } - if {$sash0 > $w - 15} { - set sash0 [expr {$w - 15}] - } - } - $win sash place 0 $sash0 [lindex $s0 1] - } - set oldwidth($win) $w -} - -proc allcanvs args { - global canv canv2 canv3 - eval $canv $args - eval $canv2 $args - eval $canv3 $args -} - -proc bindall {event action} { - global canv canv2 canv3 - bind $canv $event $action - bind $canv2 $event $action - bind $canv3 $event $action -} - -proc about {} { - global uifont - set w .about - if {[winfo exists $w]} { - raise $w - return - } - toplevel $w - wm title $w "About gitk" - message $w.m -text { -Gitk - a commit viewer for git - -Copyright © 2005-2006 Paul Mackerras - -Use and redistribute under the terms of the GNU General Public License} \ - -justify center -aspect 400 -border 2 -bg white -relief groove - pack $w.m -side top -fill x -padx 2 -pady 2 - $w.m configure -font uifont - button $w.ok -text Close -command "destroy $w" -default active - pack $w.ok -side bottom - $w.ok configure -font uifont - bind $w "focus $w.ok" - bind $w "destroy $w" - bind $w "destroy $w" -} - -proc keys {} { - global uifont - set w .keys - if {[winfo exists $w]} { - raise $w - return - } - if {[tk windowingsystem] eq {aqua}} { - set M1T Cmd - } else { - set M1T Ctrl - } - toplevel $w - wm title $w "Gitk key bindings" - message $w.m -text " -Gitk key bindings: - -<$M1T-Q> Quit - Move to first commit - Move to last commit -, p, i Move up one commit -, n, k Move down one commit -, z, j Go back in history list -, x, l Go forward in history list - Move up one page in commit list - Move down one page in commit list -<$M1T-Home> Scroll to top of commit list -<$M1T-End> Scroll to bottom of commit list -<$M1T-Up> Scroll commit list up one line -<$M1T-Down> Scroll commit list down one line -<$M1T-PageUp> Scroll commit list up one page -<$M1T-PageDown> Scroll commit list down one page - Find backwards (upwards, later commits) - Find forwards (downwards, earlier commits) -, b Scroll diff view up one page - Scroll diff view up one page - Scroll diff view down one page -u Scroll diff view up 18 lines -d Scroll diff view down 18 lines -<$M1T-F> Find -<$M1T-G> Move to next find hit - Move to next find hit -/ Move to next find hit, or redo find -? Move to previous find hit -f Scroll diff view to next file -<$M1T-S> Search for next hit in diff view -<$M1T-R> Search for previous hit in diff view -<$M1T-KP+> Increase font size -<$M1T-plus> Increase font size -<$M1T-KP-> Decrease font size -<$M1T-minus> Decrease font size - Update -" \ - -justify left -bg white -border 2 -relief groove - pack $w.m -side top -fill both -padx 2 -pady 2 - $w.m configure -font uifont - button $w.ok -text Close -command "destroy $w" -default active - pack $w.ok -side bottom - $w.ok configure -font uifont - bind $w "focus $w.ok" - bind $w "destroy $w" - bind $w "destroy $w" -} - -# Procedures for manipulating the file list window at the -# bottom right of the overall window. - -proc treeview {w l openlevs} { - global treecontents treediropen treeheight treeparent treeindex - - set ix 0 - set treeindex() 0 - set lev 0 - set prefix {} - set prefixend -1 - set prefendstack {} - set htstack {} - set ht 0 - set treecontents() {} - $w conf -state normal - foreach f $l { - while {[string range $f 0 $prefixend] ne $prefix} { - if {$lev <= $openlevs} { - $w mark set e:$treeindex($prefix) "end -1c" - $w mark gravity e:$treeindex($prefix) left - } - set treeheight($prefix) $ht - incr ht [lindex $htstack end] - set htstack [lreplace $htstack end end] - set prefixend [lindex $prefendstack end] - set prefendstack [lreplace $prefendstack end end] - set prefix [string range $prefix 0 $prefixend] - incr lev -1 - } - set tail [string range $f [expr {$prefixend+1}] end] - while {[set slash [string first "/" $tail]] >= 0} { - lappend htstack $ht - set ht 0 - lappend prefendstack $prefixend - incr prefixend [expr {$slash + 1}] - set d [string range $tail 0 $slash] - lappend treecontents($prefix) $d - set oldprefix $prefix - append prefix $d - set treecontents($prefix) {} - set treeindex($prefix) [incr ix] - set treeparent($prefix) $oldprefix - set tail [string range $tail [expr {$slash+1}] end] - if {$lev <= $openlevs} { - set ht 1 - set treediropen($prefix) [expr {$lev < $openlevs}] - set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}] - $w mark set d:$ix "end -1c" - $w mark gravity d:$ix left - set str "\n" - for {set i 0} {$i < $lev} {incr i} {append str "\t"} - $w insert end $str - $w image create end -align center -image $bm -padx 1 \ - -name a:$ix - $w insert end $d [highlight_tag $prefix] - $w mark set s:$ix "end -1c" - $w mark gravity s:$ix left - } - incr lev - } - if {$tail ne {}} { - if {$lev <= $openlevs} { - incr ht - set str "\n" - for {set i 0} {$i < $lev} {incr i} {append str "\t"} - $w insert end $str - $w insert end $tail [highlight_tag $f] - } - lappend treecontents($prefix) $tail - } - } - while {$htstack ne {}} { - set treeheight($prefix) $ht - incr ht [lindex $htstack end] - set htstack [lreplace $htstack end end] - set prefixend [lindex $prefendstack end] - set prefendstack [lreplace $prefendstack end end] - set prefix [string range $prefix 0 $prefixend] - } - $w conf -state disabled -} - -proc linetoelt {l} { - global treeheight treecontents - - set y 2 - set prefix {} - while {1} { - foreach e $treecontents($prefix) { - if {$y == $l} { - return "$prefix$e" - } - set n 1 - if {[string index $e end] eq "/"} { - set n $treeheight($prefix$e) - if {$y + $n > $l} { - append prefix $e - incr y - break - } - } - incr y $n - } - } -} - -proc highlight_tree {y prefix} { - global treeheight treecontents cflist - - foreach e $treecontents($prefix) { - set path $prefix$e - if {[highlight_tag $path] ne {}} { - $cflist tag add bold $y.0 "$y.0 lineend" - } - incr y - if {[string index $e end] eq "/" && $treeheight($path) > 1} { - set y [highlight_tree $y $path] - } - } - return $y -} - -proc treeclosedir {w dir} { - global treediropen treeheight treeparent treeindex - - set ix $treeindex($dir) - $w conf -state normal - $w delete s:$ix e:$ix - set treediropen($dir) 0 - $w image configure a:$ix -image tri-rt - $w conf -state disabled - set n [expr {1 - $treeheight($dir)}] - while {$dir ne {}} { - incr treeheight($dir) $n - set dir $treeparent($dir) - } -} - -proc treeopendir {w dir} { - global treediropen treeheight treeparent treecontents treeindex - - set ix $treeindex($dir) - $w conf -state normal - $w image configure a:$ix -image tri-dn - $w mark set e:$ix s:$ix - $w mark gravity e:$ix right - set lev 0 - set str "\n" - set n [llength $treecontents($dir)] - for {set x $dir} {$x ne {}} {set x $treeparent($x)} { - incr lev - append str "\t" - incr treeheight($x) $n - } - foreach e $treecontents($dir) { - set de $dir$e - if {[string index $e end] eq "/"} { - set iy $treeindex($de) - $w mark set d:$iy e:$ix - $w mark gravity d:$iy left - $w insert e:$ix $str - set treediropen($de) 0 - $w image create e:$ix -align center -image tri-rt -padx 1 \ - -name a:$iy - $w insert e:$ix $e [highlight_tag $de] - $w mark set s:$iy e:$ix - $w mark gravity s:$iy left - set treeheight($de) 1 - } else { - $w insert e:$ix $str - $w insert e:$ix $e [highlight_tag $de] - } - } - $w mark gravity e:$ix left - $w conf -state disabled - set treediropen($dir) 1 - set top [lindex [split [$w index @0,0] .] 0] - set ht [$w cget -height] - set l [lindex [split [$w index s:$ix] .] 0] - if {$l < $top} { - $w yview $l.0 - } elseif {$l + $n + 1 > $top + $ht} { - set top [expr {$l + $n + 2 - $ht}] - if {$l < $top} { - set top $l - } - $w yview $top.0 - } -} - -proc treeclick {w x y} { - global treediropen cmitmode ctext cflist cflist_top - - if {$cmitmode ne "tree"} return - if {![info exists cflist_top]} return - set l [lindex [split [$w index "@$x,$y"] "."] 0] - $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend" - $cflist tag add highlight $l.0 "$l.0 lineend" - set cflist_top $l - if {$l == 1} { - $ctext yview 1.0 - return - } - set e [linetoelt $l] - if {[string index $e end] ne "/"} { - showfile $e - } elseif {$treediropen($e)} { - treeclosedir $w $e - } else { - treeopendir $w $e - } -} - -proc setfilelist {id} { - global treefilelist cflist - - treeview $cflist $treefilelist($id) 0 -} - -image create bitmap tri-rt -background black -foreground blue -data { - #define tri-rt_width 13 - #define tri-rt_height 13 - static unsigned char tri-rt_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00, - 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00, - 0x00, 0x00}; -} -maskdata { - #define tri-rt-mask_width 13 - #define tri-rt-mask_height 13 - static unsigned char tri-rt-mask_bits[] = { - 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01, - 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00, - 0x08, 0x00}; -} -image create bitmap tri-dn -background black -foreground blue -data { - #define tri-dn_width 13 - #define tri-dn_height 13 - static unsigned char tri-dn_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03, - 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00}; -} -maskdata { - #define tri-dn-mask_width 13 - #define tri-dn-mask_height 13 - static unsigned char tri-dn-mask_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07, - 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00}; -} - -image create bitmap reficon-T -background black -foreground yellow -data { - #define tagicon_width 13 - #define tagicon_height 9 - static unsigned char tagicon_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07, - 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00}; -} -maskdata { - #define tagicon-mask_width 13 - #define tagicon-mask_height 9 - static unsigned char tagicon-mask_bits[] = { - 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f, - 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00}; -} -set rectdata { - #define headicon_width 13 - #define headicon_height 9 - static unsigned char headicon_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07, - 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00}; -} -set rectmask { - #define headicon-mask_width 13 - #define headicon-mask_height 9 - static unsigned char headicon-mask_bits[] = { - 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, - 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00}; -} -image create bitmap reficon-H -background black -foreground green \ - -data $rectdata -maskdata $rectmask -image create bitmap reficon-o -background black -foreground "#ddddff" \ - -data $rectdata -maskdata $rectmask - -proc init_flist {first} { - global cflist cflist_top selectedline difffilestart - - $cflist conf -state normal - $cflist delete 0.0 end - if {$first ne {}} { - $cflist insert end $first - set cflist_top 1 - $cflist tag add highlight 1.0 "1.0 lineend" - } else { - catch {unset cflist_top} - } - $cflist conf -state disabled - set difffilestart {} -} - -proc highlight_tag {f} { - global highlight_paths - - foreach p $highlight_paths { - if {[string match $p $f]} { - return "bold" - } - } - return {} -} - -proc highlight_filelist {} { - global cmitmode cflist - - $cflist conf -state normal - if {$cmitmode ne "tree"} { - set end [lindex [split [$cflist index end] .] 0] - for {set l 2} {$l < $end} {incr l} { - set line [$cflist get $l.0 "$l.0 lineend"] - if {[highlight_tag $line] ne {}} { - $cflist tag add bold $l.0 "$l.0 lineend" - } - } - } else { - highlight_tree 2 {} - } - $cflist conf -state disabled -} - -proc unhighlight_filelist {} { - global cflist - - $cflist conf -state normal - $cflist tag remove bold 1.0 end - $cflist conf -state disabled -} - -proc add_flist {fl} { - global cflist - - $cflist conf -state normal - foreach f $fl { - $cflist insert end "\n" - $cflist insert end $f [highlight_tag $f] - } - $cflist conf -state disabled -} - -proc sel_flist {w x y} { - global ctext difffilestart cflist cflist_top cmitmode - - if {$cmitmode eq "tree"} return - if {![info exists cflist_top]} return - set l [lindex [split [$w index "@$x,$y"] "."] 0] - $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend" - $cflist tag add highlight $l.0 "$l.0 lineend" - set cflist_top $l - if {$l == 1} { - $ctext yview 1.0 - } else { - catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]} - } -} - -proc pop_flist_menu {w X Y x y} { - global ctext cflist cmitmode flist_menu flist_menu_file - global treediffs diffids - - stopfinding - set l [lindex [split [$w index "@$x,$y"] "."] 0] - if {$l <= 1} return - if {$cmitmode eq "tree"} { - set e [linetoelt $l] - if {[string index $e end] eq "/"} return - } else { - set e [lindex $treediffs($diffids) [expr {$l-2}]] - } - set flist_menu_file $e - tk_popup $flist_menu $X $Y -} - -proc flist_hl {only} { - global flist_menu_file findstring gdttype - - set x [shellquote $flist_menu_file] - if {$only || $findstring eq {} || $gdttype ne "touching paths:"} { - set findstring $x - } else { - append findstring " " $x - } - set gdttype "touching paths:" -} - -# Functions for adding and removing shell-type quoting - -proc shellquote {str} { - if {![string match "*\['\"\\ \t]*" $str]} { - return $str - } - if {![string match "*\['\"\\]*" $str]} { - return "\"$str\"" - } - if {![string match "*'*" $str]} { - return "'$str'" - } - return "\"[string map {\" \\\" \\ \\\\} $str]\"" -} - -proc shellarglist {l} { - set str {} - foreach a $l { - if {$str ne {}} { - append str " " - } - append str [shellquote $a] - } - return $str -} - -proc shelldequote {str} { - set ret {} - set used -1 - while {1} { - incr used - if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} { - append ret [string range $str $used end] - set used [string length $str] - break - } - set first [lindex $first 0] - set ch [string index $str $first] - if {$first > $used} { - append ret [string range $str $used [expr {$first - 1}]] - set used $first - } - if {$ch eq " " || $ch eq "\t"} break - incr used - if {$ch eq "'"} { - set first [string first "'" $str $used] - if {$first < 0} { - error "unmatched single-quote" - } - append ret [string range $str $used [expr {$first - 1}]] - set used $first - continue - } - if {$ch eq "\\"} { - if {$used >= [string length $str]} { - error "trailing backslash" - } - append ret [string index $str $used] - continue - } - # here ch == "\"" - while {1} { - if {![regexp -start $used -indices "\[\"\\\\]" $str first]} { - error "unmatched double-quote" - } - set first [lindex $first 0] - set ch [string index $str $first] - if {$first > $used} { - append ret [string range $str $used [expr {$first - 1}]] - set used $first - } - if {$ch eq "\""} break - incr used - append ret [string index $str $used] - incr used - } - } - return [list $used $ret] -} - -proc shellsplit {str} { - set l {} - while {1} { - set str [string trimleft $str] - if {$str eq {}} break - set dq [shelldequote $str] - set n [lindex $dq 0] - set word [lindex $dq 1] - set str [string range $str $n end] - lappend l $word - } - return $l -} - -# Code to implement multiple views - -proc newview {ishighlight} { - global nextviewnum newviewname newviewperm uifont newishighlight - global newviewargs revtreeargs - - set newishighlight $ishighlight - set top .gitkview - if {[winfo exists $top]} { - raise $top - return - } - set newviewname($nextviewnum) "View $nextviewnum" - set newviewperm($nextviewnum) 0 - set newviewargs($nextviewnum) [shellarglist $revtreeargs] - vieweditor $top $nextviewnum "Gitk view definition" -} - -proc editview {} { - global curview - global viewname viewperm newviewname newviewperm - global viewargs newviewargs - - set top .gitkvedit-$curview - if {[winfo exists $top]} { - raise $top - return - } - set newviewname($curview) $viewname($curview) - set newviewperm($curview) $viewperm($curview) - set newviewargs($curview) [shellarglist $viewargs($curview)] - vieweditor $top $curview "Gitk: edit view $viewname($curview)" -} - -proc vieweditor {top n title} { - global newviewname newviewperm viewfiles - global uifont - - toplevel $top - wm title $top $title - label $top.nl -text "Name" -font uifont - entry $top.name -width 20 -textvariable newviewname($n) -font uifont - grid $top.nl $top.name -sticky w -pady 5 - checkbutton $top.perm -text "Remember this view" -variable newviewperm($n) \ - -font uifont - grid $top.perm - -pady 5 -sticky w - message $top.al -aspect 1000 -font uifont \ - -text "Commits to include (arguments to git rev-list):" - grid $top.al - -sticky w -pady 5 - entry $top.args -width 50 -textvariable newviewargs($n) \ - -background white -font uifont - grid $top.args - -sticky ew -padx 5 - message $top.l -aspect 1000 -font uifont \ - -text "Enter files and directories to include, one per line:" - grid $top.l - -sticky w - text $top.t -width 40 -height 10 -background white -font uifont - if {[info exists viewfiles($n)]} { - foreach f $viewfiles($n) { - $top.t insert end $f - $top.t insert end "\n" - } - $top.t delete {end - 1c} end - $top.t mark set insert 0.0 - } - grid $top.t - -sticky ew -padx 5 - frame $top.buts - button $top.buts.ok -text "OK" -command [list newviewok $top $n] \ - -font uifont - button $top.buts.can -text "Cancel" -command [list destroy $top] \ - -font uifont - 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 doviewmenu {m first cmd op argv} { - set nmenu [$m index end] - for {set i $first} {$i <= $nmenu} {incr i} { - if {[$m entrycget $i -command] eq $cmd} { - eval $m $op $i $argv - break - } - } -} - -proc allviewmenus {n op args} { - # global viewhlmenu - - doviewmenu .bar.view 5 [list showview $n] $op $args - # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args -} - -proc newviewok {top n} { - global nextviewnum newviewperm newviewname newishighlight - global viewname viewfiles viewperm selectedview curview - global viewargs newviewargs viewhlmenu - - if {[catch { - set newargs [shellsplit $newviewargs($n)] - } err]} { - error_popup "Error in commit selection arguments: $err" - wm raise $top - focus $top - return - } - set files {} - foreach f [split [$top.t get 0.0 end] "\n"] { - set ft [string trim $f] - if {$ft ne {}} { - lappend files $ft - } - } - if {![info exists viewfiles($n)]} { - # creating a new view - incr nextviewnum - set viewname($n) $newviewname($n) - set viewperm($n) $newviewperm($n) - set viewfiles($n) $files - set viewargs($n) $newargs - addviewmenu $n - if {!$newishighlight} { - run showview $n - } else { - run addvhighlight $n - } - } else { - # editing an existing view - set viewperm($n) $newviewperm($n) - if {$newviewname($n) ne $viewname($n)} { - set viewname($n) $newviewname($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)] - } - if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} { - set viewfiles($n) $files - set viewargs($n) $newargs - if {$curview == $n} { - run updatecommits - } - } - } - catch {destroy $top} -} - -proc delview {} { - global curview viewdata viewperm hlview selectedhlview - - if {$curview == 0} return - if {[info exists hlview] && $hlview == $curview} { - set selectedhlview None - unset hlview - } - allviewmenus $curview delete - set viewdata($curview) {} - set viewperm($curview) 0 - showview 0 -} - -proc addviewmenu {n} { - global viewname viewhlmenu - - .bar.view add radiobutton -label $viewname($n) \ - -command [list showview $n] -variable selectedview -value $n - #$viewhlmenu add radiobutton -label $viewname($n) \ - # -command [list addvhighlight $n] -variable selectedhlview -} - -proc flatten {var} { - global $var - - set ret {} - foreach i [array names $var] { - lappend ret $i [set $var\($i\)] - } - return $ret -} - -proc unflatten {var l} { - global $var - - catch {unset $var} - foreach {i v} $l { - set $var\($i\) $v - } -} - -proc showview {n} { - global curview viewdata viewfiles - global displayorder parentlist rowidlist rowisopt rowfinal - global colormap rowtextx commitrow nextcolor canvxmax - global numcommits commitlisted - global selectedline currentid canv canvy0 - global treediffs - global pending_select phase - global commitidx - global commfd - global selectedview selectfirst - global vparentlist vdisporder vcmitlisted - global hlview selectedhlview commitinterest - - 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}] - } - } elseif {[info exists pending_select]} { - set selid $pending_select - unset pending_select - } - unselectline - normalline - if {$curview >= 0} { - set vparentlist($curview) $parentlist - set vdisporder($curview) $displayorder - set vcmitlisted($curview) $commitlisted - if {$phase ne {} || - ![info exists viewdata($curview)] || - [lindex $viewdata($curview) 0] ne {}} { - set viewdata($curview) \ - [list $phase $rowidlist $rowisopt $rowfinal] - } - } - catch {unset treediffs} - clear_display - if {[info exists hlview] && $hlview == $n} { - unset hlview - set selectedhlview None - } - catch {unset commitinterest} - - set curview $n - set selectedview $n - .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}] - .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}] - - run refill_reflist - if {![info exists viewdata($n)]} { - if {$selid ne {}} { - set pending_select $selid - } - getcommits - return - } - - set v $viewdata($n) - set phase [lindex $v 0] - set displayorder $vdisporder($n) - set parentlist $vparentlist($n) - set commitlisted $vcmitlisted($n) - set rowidlist [lindex $v 1] - set rowisopt [lindex $v 2] - set rowfinal [lindex $v 3] - set numcommits $commitidx($n) - - catch {unset colormap} - catch {unset rowtextx} - set nextcolor 0 - set canvxmax [$canv cget -width] - set curview $n - set row 0 - setcanvscroll - set yf 0 - set row {} - set selectfirst 0 - if {$selid ne {} && [info exists commitrow($n,$selid)]} { - set row $commitrow($n,$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 - if {$row ne {}} { - selectline $row 0 - } elseif {$selid ne {}} { - set pending_select $selid - } else { - set row [first_real_row] - if {$row < $numcommits} { - selectline $row 0 - } else { - set selectfirst 1 - } - } - if {$phase ne {}} { - if {$phase eq "getcommits"} { - show_status "Reading commits..." - } - run chewcommits $n - } elseif {$numcommits == 0} { - show_status "No commits selected" - } -} - -# Stuff relating to the highlighting facility - -proc ishighlighted {row} { - global vhighlights fhighlights nhighlights rhighlights - - if {[info exists nhighlights($row)] && $nhighlights($row) > 0} { - return $nhighlights($row) - } - if {[info exists vhighlights($row)] && $vhighlights($row) > 0} { - return $vhighlights($row) - } - if {[info exists fhighlights($row)] && $fhighlights($row) > 0} { - return $fhighlights($row) - } - if {[info exists rhighlights($row)] && $rhighlights($row) > 0} { - return $rhighlights($row) - } - return 0 -} - -proc bolden {row font} { - global canv linehtag selectedline boldrows - - lappend boldrows $row - $canv itemconf $linehtag($row) -font $font - if {[info exists selectedline] && $row == $selectedline} { - $canv delete secsel - set t [eval $canv create rect [$canv bbox $linehtag($row)] \ - -outline {{}} -tags secsel \ - -fill [$canv cget -selectbackground]] - $canv lower $t - } -} - -proc bolden_name {row font} { - global canv2 linentag selectedline boldnamerows - - lappend boldnamerows $row - $canv2 itemconf $linentag($row) -font $font - if {[info exists selectedline] && $row == $selectedline} { - $canv2 delete secsel - set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \ - -outline {{}} -tags secsel \ - -fill [$canv2 cget -selectbackground]] - $canv2 lower $t - } -} - -proc unbolden {} { - global boldrows - - set stillbold {} - foreach row $boldrows { - if {![ishighlighted $row]} { - bolden $row mainfont - } else { - lappend stillbold $row - } - } - set boldrows $stillbold -} - -proc addvhighlight {n} { - global hlview curview viewdata vhl_done vhighlights commitidx - - if {[info exists hlview]} { - delvhighlight - } - set hlview $n - if {$n != $curview && ![info exists viewdata($n)]} { - set viewdata($n) [list getcommits {{}} 0 0 0] - set vparentlist($n) {} - set vdisporder($n) {} - set vcmitlisted($n) {} - start_rev_list $n - } - set vhl_done $commitidx($hlview) - if {$vhl_done > 0} { - drawvisible - } -} - -proc delvhighlight {} { - global hlview vhighlights - - if {![info exists hlview]} return - unset hlview - catch {unset vhighlights} - unbolden -} - -proc vhighlightmore {} { - global hlview vhl_done commitidx vhighlights - global displayorder vdisporder curview - - set max $commitidx($hlview) - if {$hlview == $curview} { - set disp $displayorder - } else { - set disp $vdisporder($hlview) - } - set vr [visiblerows] - set r0 [lindex $vr 0] - set r1 [lindex $vr 1] - for {set i $vhl_done} {$i < $max} {incr i} { - set id [lindex $disp $i] - if {[info exists commitrow($curview,$id)]} { - set row $commitrow($curview,$id) - if {$r0 <= $row && $row <= $r1} { - if {![highlighted $row]} { - bolden $row mainfontbold - } - set vhighlights($row) 1 - } - } - } - set vhl_done $max -} - -proc askvhighlight {row id} { - global hlview vhighlights commitrow iddrawn - - if {[info exists commitrow($hlview,$id)]} { - if {[info exists iddrawn($id)] && ![ishighlighted $row]} { - bolden $row mainfontbold - } - set vhighlights($row) 1 - } else { - set vhighlights($row) 0 - } -} - -proc hfiles_change {} { - global highlight_files filehighlight fhighlights fh_serial - global highlight_paths gdttype - - if {[info exists filehighlight]} { - # delete previous highlights - catch {close $filehighlight} - unset filehighlight - catch {unset fhighlights} - unbolden - unhighlight_filelist - } - set highlight_paths {} - after cancel do_file_hl $fh_serial - incr fh_serial - if {$highlight_files ne {}} { - after 300 do_file_hl $fh_serial - } -} - -proc gdttype_change {name ix op} { - global gdttype highlight_files findstring findpattern - - stopfinding - if {$findstring ne {}} { - if {$gdttype eq "containing:"} { - if {$highlight_files ne {}} { - set highlight_files {} - hfiles_change - } - findcom_change - } else { - if {$findpattern ne {}} { - set findpattern {} - findcom_change - } - set highlight_files $findstring - hfiles_change - } - drawvisible - } - # enable/disable findtype/findloc menus too -} - -proc find_change {name ix op} { - global gdttype findstring highlight_files - - stopfinding - if {$gdttype eq "containing:"} { - findcom_change - } else { - if {$highlight_files ne $findstring} { - set highlight_files $findstring - hfiles_change - } - } - drawvisible -} - -proc findcom_change args { - global nhighlights boldnamerows - global findpattern findtype findstring gdttype - - stopfinding - # delete previous highlights, if any - foreach row $boldnamerows { - bolden_name $row mainfont - } - set boldnamerows {} - catch {unset nhighlights} - unbolden - unmarkmatches - if {$gdttype ne "containing:" || $findstring eq {}} { - set findpattern {} - } elseif {$findtype eq "Regexp"} { - set findpattern $findstring - } else { - set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \ - $findstring] - set findpattern "*$e*" - } -} - -proc makepatterns {l} { - set ret {} - foreach e $l { - set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e] - if {[string index $ee end] eq "/"} { - lappend ret "$ee*" - } else { - lappend ret $ee - lappend ret "$ee/*" - } - } - return $ret -} - -proc do_file_hl {serial} { - global highlight_files filehighlight highlight_paths gdttype fhl_list - - if {$gdttype eq "touching paths:"} { - if {[catch {set paths [shellsplit $highlight_files]}]} return - set highlight_paths [makepatterns $paths] - highlight_filelist - set gdtargs [concat -- $paths] - } elseif {$gdttype eq "adding/removing string:"} { - set gdtargs [list "-S$highlight_files"] - } else { - # must be "containing:", i.e. we're searching commit info - return - } - set cmd [concat | git diff-tree -r -s --stdin $gdtargs] - set filehighlight [open $cmd r+] - fconfigure $filehighlight -blocking 0 - filerun $filehighlight readfhighlight - set fhl_list {} - drawvisible - flushhighlights -} - -proc flushhighlights {} { - global filehighlight fhl_list - - if {[info exists filehighlight]} { - lappend fhl_list {} - puts $filehighlight "" - flush $filehighlight - } -} - -proc askfilehighlight {row id} { - global filehighlight fhighlights fhl_list - - lappend fhl_list $id - set fhighlights($row) -1 - puts $filehighlight $id -} - -proc readfhighlight {} { - global filehighlight fhighlights commitrow curview iddrawn - global fhl_list find_dirn - - if {![info exists filehighlight]} { - return 0 - } - set nr 0 - while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} { - set line [string trim $line] - set i [lsearch -exact $fhl_list $line] - if {$i < 0} continue - for {set j 0} {$j < $i} {incr j} { - set id [lindex $fhl_list $j] - if {[info exists commitrow($curview,$id)]} { - set fhighlights($commitrow($curview,$id)) 0 - } - } - set fhl_list [lrange $fhl_list [expr {$i+1}] end] - if {$line eq {}} continue - if {![info exists commitrow($curview,$line)]} continue - set row $commitrow($curview,$line) - if {[info exists iddrawn($line)] && ![ishighlighted $row]} { - bolden $row mainfontbold - } - set fhighlights($row) 1 - } - if {[eof $filehighlight]} { - # strange... - puts "oops, git diff-tree died" - catch {close $filehighlight} - unset filehighlight - return 0 - } - if {[info exists find_dirn]} { - run findmore - } - return 1 -} - -proc doesmatch {f} { - global findtype findpattern - - if {$findtype eq "Regexp"} { - return [regexp $findpattern $f] - } elseif {$findtype eq "IgnCase"} { - return [string match -nocase $findpattern $f] - } else { - return [string match $findpattern $f] - } -} - -proc askfindhighlight {row id} { - global nhighlights commitinfo iddrawn - global findloc - global markingmatches - - if {![info exists commitinfo($id)]} { - getcommit $id - } - set info $commitinfo($id) - set isbold 0 - set fldtypes {Headline Author Date Committer CDate Comments} - foreach f $info ty $fldtypes { - if {($findloc eq "All fields" || $findloc eq $ty) && - [doesmatch $f]} { - if {$ty eq "Author"} { - set isbold 2 - break - } - set isbold 1 - } - } - if {$isbold && [info exists iddrawn($id)]} { - if {![ishighlighted $row]} { - bolden $row mainfontbold - if {$isbold > 1} { - bolden_name $row mainfontbold - } - } - if {$markingmatches} { - markrowmatches $row $id - } - } - set nhighlights($row) $isbold -} - -proc markrowmatches {row id} { - global canv canv2 linehtag linentag commitinfo findloc - - set headline [lindex $commitinfo($id) 0] - set author [lindex $commitinfo($id) 1] - $canv delete match$row - $canv2 delete match$row - if {$findloc eq "All fields" || $findloc eq "Headline"} { - set m [findmatches $headline] - if {$m ne {}} { - markmatches $canv $row $headline $linehtag($row) $m \ - [$canv itemcget $linehtag($row) -font] $row - } - } - if {$findloc eq "All fields" || $findloc eq "Author"} { - set m [findmatches $author] - if {$m ne {}} { - markmatches $canv2 $row $author $linentag($row) $m \ - [$canv2 itemcget $linentag($row) -font] $row - } - } -} - -proc vrel_change {name ix op} { - global highlight_related - - rhighlight_none - if {$highlight_related ne "None"} { - run drawvisible - } -} - -# prepare for testing whether commits are descendents or ancestors of a -proc rhighlight_sel {a} { - global descendent desc_todo ancestor anc_todo - global highlight_related rhighlights - - catch {unset descendent} - set desc_todo [list $a] - catch {unset ancestor} - set anc_todo [list $a] - if {$highlight_related ne "None"} { - rhighlight_none - run drawvisible - } -} - -proc rhighlight_none {} { - global rhighlights - - catch {unset rhighlights} - unbolden -} - -proc is_descendent {a} { - global curview children commitrow descendent desc_todo - - set v $curview - set la $commitrow($v,$a) - set todo $desc_todo - set leftover {} - set done 0 - for {set i 0} {$i < [llength $todo]} {incr i} { - set do [lindex $todo $i] - if {$commitrow($v,$do) < $la} { - lappend leftover $do - continue - } - foreach nk $children($v,$do) { - if {![info exists descendent($nk)]} { - set descendent($nk) 1 - lappend todo $nk - if {$nk eq $a} { - set done 1 - } - } - } - if {$done} { - set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]] - return - } - } - set descendent($a) 0 - set desc_todo $leftover -} - -proc is_ancestor {a} { - global curview parentlist commitrow ancestor anc_todo - - set v $curview - set la $commitrow($v,$a) - set todo $anc_todo - set leftover {} - set done 0 - for {set i 0} {$i < [llength $todo]} {incr i} { - set do [lindex $todo $i] - if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} { - lappend leftover $do - continue - } - foreach np [lindex $parentlist $commitrow($v,$do)] { - if {![info exists ancestor($np)]} { - set ancestor($np) 1 - lappend todo $np - if {$np eq $a} { - set done 1 - } - } - } - if {$done} { - set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]] - return - } - } - set ancestor($a) 0 - set anc_todo $leftover -} - -proc askrelhighlight {row id} { - global descendent highlight_related iddrawn rhighlights - global selectedline ancestor - - if {![info exists selectedline]} return - set isbold 0 - if {$highlight_related eq "Descendent" || - $highlight_related eq "Not descendent"} { - if {![info exists descendent($id)]} { - is_descendent $id - } - if {$descendent($id) == ($highlight_related eq "Descendent")} { - set isbold 1 - } - } elseif {$highlight_related eq "Ancestor" || - $highlight_related eq "Not ancestor"} { - if {![info exists ancestor($id)]} { - is_ancestor $id - } - if {$ancestor($id) == ($highlight_related eq "Ancestor")} { - set isbold 1 - } - } - if {[info exists iddrawn($id)]} { - if {$isbold && ![ishighlighted $row]} { - bolden $row mainfontbold - } - } - set rhighlights($row) $isbold -} - -# Graph layout functions - -proc shortids {ids} { - set res {} - foreach id $ids { - if {[llength $id] > 1} { - lappend res [shortids $id] - } elseif {[regexp {^[0-9a-f]{40}$} $id]} { - lappend res [string range $id 0 7] - } else { - lappend res $id - } - } - return $res -} - -proc ntimes {n o} { - set ret {} - set o [list $o] - for {set mask 1} {$mask <= $n} {incr mask $mask} { - if {($n & $mask) != 0} { - set ret [concat $ret $o] - } - set o [concat $o $o] - } - return $ret -} - -# Work out where id should go in idlist so that order-token -# values increase from left to right -proc idcol {idlist id {i 0}} { - global ordertok curview - - set t $ordertok($curview,$id) - if {$i >= [llength $idlist] || - $t < $ordertok($curview,[lindex $idlist $i])} { - if {$i > [llength $idlist]} { - set i [llength $idlist] - } - while {[incr i -1] >= 0 && - $t < $ordertok($curview,[lindex $idlist $i])} {} - incr i - } else { - if {$t > $ordertok($curview,[lindex $idlist $i])} { - while {[incr i] < [llength $idlist] && - $t >= $ordertok($curview,[lindex $idlist $i])} {} - } - } - return $i -} - -proc initlayout {} { - global rowidlist rowisopt rowfinal displayorder commitlisted - global numcommits canvxmax canv - global nextcolor - global parentlist - global colormap rowtextx - global selectfirst - - set numcommits 0 - set displayorder {} - set commitlisted {} - set parentlist {} - set nextcolor 0 - set rowidlist {} - set rowisopt {} - set rowfinal {} - set canvxmax [$canv cget -width] - catch {unset colormap} - catch {unset rowtextx} - set selectfirst 1 -} - -proc setcanvscroll {} { - global canv canv2 canv3 numcommits linespc canvxmax canvy0 - - set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}] - $canv conf -scrollregion [list 0 0 $canvxmax $ymax] - $canv2 conf -scrollregion [list 0 0 0 $ymax] - $canv3 conf -scrollregion [list 0 0 0 $ymax] -} - -proc visiblerows {} { - global canv numcommits linespc - - set ymax [lindex [$canv cget -scrollregion] 3] - if {$ymax eq {} || $ymax == 0} return - set f [$canv yview] - set y0 [expr {int([lindex $f 0] * $ymax)}] - set r0 [expr {int(($y0 - 3) / $linespc) - 1}] - if {$r0 < 0} { - set r0 0 - } - set y1 [expr {int([lindex $f 1] * $ymax)}] - set r1 [expr {int(($y1 - 3) / $linespc) + 1}] - if {$r1 >= $numcommits} { - set r1 [expr {$numcommits - 1}] - } - return [list $r0 $r1] -} - -proc layoutmore {} { - global commitidx viewcomplete numcommits - global uparrowlen downarrowlen mingaplen curview - - set show $commitidx($curview) - if {$show > $numcommits || $viewcomplete($curview)} { - showstuff $show $viewcomplete($curview) - } -} - -proc showstuff {canshow last} { - global numcommits commitrow pending_select selectedline curview - global mainheadid displayorder selectfirst - global lastscrollset commitinterest - - if {$numcommits == 0} { - global phase - set phase "incrdraw" - allcanvs delete all - } - set r0 $numcommits - set prev $numcommits - set numcommits $canshow - set t [clock clicks -milliseconds] - if {$prev < 100 || $last || $t - $lastscrollset > 500} { - set lastscrollset $t - setcanvscroll - } - set rows [visiblerows] - set r1 [lindex $rows 1] - if {$r1 >= $canshow} { - set r1 [expr {$canshow - 1}] - } - if {$r0 <= $r1} { - drawcommits $r0 $r1 - } - if {[info exists pending_select] && - [info exists commitrow($curview,$pending_select)] && - $commitrow($curview,$pending_select) < $numcommits} { - selectline $commitrow($curview,$pending_select) 1 - } - if {$selectfirst} { - if {[info exists selectedline] || [info exists pending_select]} { - set selectfirst 0 - } else { - set l [first_real_row] - selectline $l 1 - set selectfirst 0 - } - } -} - -proc doshowlocalchanges {} { - global curview mainheadid phase commitrow - - if {[info exists commitrow($curview,$mainheadid)] && - ($phase eq {} || $commitrow($curview,$mainheadid) < $numcommits - 1)} { - dodiffindex - } elseif {$phase ne {}} { - lappend commitinterest($mainheadid) {} - } -} - -proc dohidelocalchanges {} { - global localfrow localirow lserial - - if {$localfrow >= 0} { - removerow $localfrow - set localfrow -1 - if {$localirow > 0} { - incr localirow -1 - } - } - if {$localirow >= 0} { - removerow $localirow - set localirow -1 - } - incr lserial -} - -# spawn off a process to do git diff-index --cached HEAD -proc dodiffindex {} { - global localirow localfrow lserial showlocalchanges - - if {!$showlocalchanges} return - incr lserial - set localfrow -1 - set localirow -1 - set fd [open "|git diff-index --cached HEAD" r] - fconfigure $fd -blocking 0 - filerun $fd [list readdiffindex $fd $lserial] -} - -proc readdiffindex {fd serial} { - global localirow commitrow mainheadid nullid2 curview - global commitinfo commitdata lserial - - set isdiff 1 - if {[gets $fd line] < 0} { - if {![eof $fd]} { - return 1 - } - set isdiff 0 - } - # we only need to see one line and we don't really care what it says... - close $fd - - # now see if there are any local changes not checked in to the index - if {$serial == $lserial} { - set fd [open "|git diff-files" r] - fconfigure $fd -blocking 0 - filerun $fd [list readdifffiles $fd $serial] - } - - if {$isdiff && $serial == $lserial && $localirow == -1} { - # add the line for the changes in the index to the graph - set localirow $commitrow($curview,$mainheadid) - set hl "Local changes checked in to index but not committed" - set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"] - set commitdata($nullid2) "\n $hl\n" - insertrow $localirow $nullid2 - } - return 0 -} - -proc readdifffiles {fd serial} { - global localirow localfrow commitrow mainheadid nullid curview - global commitinfo commitdata lserial - - set isdiff 1 - if {[gets $fd line] < 0} { - if {![eof $fd]} { - return 1 - } - set isdiff 0 - } - # we only need to see one line and we don't really care what it says... - close $fd - - if {$isdiff && $serial == $lserial && $localfrow == -1} { - # add the line for the local diff to the graph - if {$localirow >= 0} { - set localfrow $localirow - incr localirow - } else { - set localfrow $commitrow($curview,$mainheadid) - } - set hl "Local uncommitted changes, not checked in to index" - set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"] - set commitdata($nullid) "\n $hl\n" - insertrow $localfrow $nullid - } - return 0 -} - -proc nextuse {id row} { - global commitrow curview children - - if {[info exists children($curview,$id)]} { - foreach kid $children($curview,$id) { - if {![info exists commitrow($curview,$kid)]} { - return -1 - } - if {$commitrow($curview,$kid) > $row} { - return $commitrow($curview,$kid) - } - } - } - if {[info exists commitrow($curview,$id)]} { - return $commitrow($curview,$id) - } - return -1 -} - -proc prevuse {id row} { - global commitrow curview children - - set ret -1 - if {[info exists children($curview,$id)]} { - foreach kid $children($curview,$id) { - if {![info exists commitrow($curview,$kid)]} break - if {$commitrow($curview,$kid) < $row} { - set ret $commitrow($curview,$kid) - } - } - } - return $ret -} - -proc make_idlist {row} { - global displayorder parentlist uparrowlen downarrowlen mingaplen - global commitidx curview ordertok children commitrow - - set r [expr {$row - $mingaplen - $downarrowlen - 1}] - if {$r < 0} { - set r 0 - } - set ra [expr {$row - $downarrowlen}] - if {$ra < 0} { - set ra 0 - } - set rb [expr {$row + $uparrowlen}] - if {$rb > $commitidx($curview)} { - set rb $commitidx($curview) - } - set ids {} - for {} {$r < $ra} {incr r} { - set nextid [lindex $displayorder [expr {$r + 1}]] - foreach p [lindex $parentlist $r] { - if {$p eq $nextid} continue - set rn [nextuse $p $r] - if {$rn >= $row && - $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} { - lappend ids [list $ordertok($curview,$p) $p] - } - } - } - for {} {$r < $row} {incr r} { - set nextid [lindex $displayorder [expr {$r + 1}]] - foreach p [lindex $parentlist $r] { - if {$p eq $nextid} continue - set rn [nextuse $p $r] - if {$rn < 0 || $rn >= $row} { - lappend ids [list $ordertok($curview,$p) $p] - } - } - } - set id [lindex $displayorder $row] - lappend ids [list $ordertok($curview,$id) $id] - while {$r < $rb} { - foreach p [lindex $parentlist $r] { - set firstkid [lindex $children($curview,$p) 0] - if {$commitrow($curview,$firstkid) < $row} { - lappend ids [list $ordertok($curview,$p) $p] - } - } - incr r - set id [lindex $displayorder $r] - if {$id ne {}} { - set firstkid [lindex $children($curview,$id) 0] - if {$firstkid ne {} && $commitrow($curview,$firstkid) < $row} { - lappend ids [list $ordertok($curview,$id) $id] - } - } - } - set idlist {} - foreach idx [lsort -unique $ids] { - lappend idlist [lindex $idx 1] - } - return $idlist -} - -proc rowsequal {a b} { - while {[set i [lsearch -exact $a {}]] >= 0} { - set a [lreplace $a $i $i] - } - while {[set i [lsearch -exact $b {}]] >= 0} { - set b [lreplace $b $i $i] - } - return [expr {$a eq $b}] -} - -proc makeupline {id row rend col} { - global rowidlist uparrowlen downarrowlen mingaplen - - for {set r $rend} {1} {set r $rstart} { - set rstart [prevuse $id $r] - if {$rstart < 0} return - if {$rstart < $row} break - } - if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} { - set rstart [expr {$rend - $uparrowlen - 1}] - } - for {set r $rstart} {[incr r] <= $row} {} { - set idlist [lindex $rowidlist $r] - if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} { - set col [idcol $idlist $id $col] - lset rowidlist $r [linsert $idlist $col $id] - changedrow $r - } - } -} - -proc layoutrows {row endrow} { - global rowidlist rowisopt rowfinal displayorder - global uparrowlen downarrowlen maxwidth mingaplen - global children parentlist - global commitidx viewcomplete curview commitrow - - set idlist {} - if {$row > 0} { - set rm1 [expr {$row - 1}] - foreach id [lindex $rowidlist $rm1] { - if {$id ne {}} { - lappend idlist $id - } - } - set final [lindex $rowfinal $rm1] - } - for {} {$row < $endrow} {incr row} { - set rm1 [expr {$row - 1}] - if {$rm1 < 0 || $idlist eq {}} { - set idlist [make_idlist $row] - set final 1 - } else { - set id [lindex $displayorder $rm1] - set col [lsearch -exact $idlist $id] - set idlist [lreplace $idlist $col $col] - foreach p [lindex $parentlist $rm1] { - if {[lsearch -exact $idlist $p] < 0} { - set col [idcol $idlist $p $col] - set idlist [linsert $idlist $col $p] - # if not the first child, we have to insert a line going up - if {$id ne [lindex $children($curview,$p) 0]} { - makeupline $p $rm1 $row $col - } - } - } - set id [lindex $displayorder $row] - if {$row > $downarrowlen} { - set termrow [expr {$row - $downarrowlen - 1}] - foreach p [lindex $parentlist $termrow] { - set i [lsearch -exact $idlist $p] - if {$i < 0} continue - set nr [nextuse $p $termrow] - if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} { - set idlist [lreplace $idlist $i $i] - } - } - } - set col [lsearch -exact $idlist $id] - if {$col < 0} { - set col [idcol $idlist $id] - set idlist [linsert $idlist $col $id] - if {$children($curview,$id) ne {}} { - makeupline $id $rm1 $row $col - } - } - set r [expr {$row + $uparrowlen - 1}] - if {$r < $commitidx($curview)} { - set x $col - foreach p [lindex $parentlist $r] { - if {[lsearch -exact $idlist $p] >= 0} continue - set fk [lindex $children($curview,$p) 0] - if {$commitrow($curview,$fk) < $row} { - set x [idcol $idlist $p $x] - set idlist [linsert $idlist $x $p] - } - } - if {[incr r] < $commitidx($curview)} { - set p [lindex $displayorder $r] - if {[lsearch -exact $idlist $p] < 0} { - set fk [lindex $children($curview,$p) 0] - if {$fk ne {} && $commitrow($curview,$fk) < $row} { - set x [idcol $idlist $p $x] - set idlist [linsert $idlist $x $p] - } - } - } - } - } - if {$final && !$viewcomplete($curview) && - $row + $uparrowlen + $mingaplen + $downarrowlen - >= $commitidx($curview)} { - set final 0 - } - set l [llength $rowidlist] - if {$row == $l} { - lappend rowidlist $idlist - lappend rowisopt 0 - lappend rowfinal $final - } elseif {$row < $l} { - if {![rowsequal $idlist [lindex $rowidlist $row]]} { - lset rowidlist $row $idlist - changedrow $row - } - lset rowfinal $row $final - } else { - set pad [ntimes [expr {$row - $l}] {}] - set rowidlist [concat $rowidlist $pad] - lappend rowidlist $idlist - set rowfinal [concat $rowfinal $pad] - lappend rowfinal $final - set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]] - } - } - return $row -} - -proc changedrow {row} { - global displayorder iddrawn rowisopt need_redisplay - - set l [llength $rowisopt] - if {$row < $l} { - lset rowisopt $row 0 - if {$row + 1 < $l} { - lset rowisopt [expr {$row + 1}] 0 - if {$row + 2 < $l} { - lset rowisopt [expr {$row + 2}] 0 - } - } - } - set id [lindex $displayorder $row] - if {[info exists iddrawn($id)]} { - set need_redisplay 1 - } -} - -proc insert_pad {row col npad} { - global rowidlist - - set pad [ntimes $npad {}] - set idlist [lindex $rowidlist $row] - set bef [lrange $idlist 0 [expr {$col - 1}]] - set aft [lrange $idlist $col end] - set i [lsearch -exact $aft {}] - if {$i > 0} { - set aft [lreplace $aft $i $i] - } - lset rowidlist $row [concat $bef $pad $aft] - changedrow $row -} - -proc optimize_rows {row col endrow} { - global rowidlist rowisopt displayorder curview children - - if {$row < 1} { - set row 1 - } - for {} {$row < $endrow} {incr row; set col 0} { - if {[lindex $rowisopt $row]} continue - set haspad 0 - set y0 [expr {$row - 1}] - set ym [expr {$row - 2}] - set idlist [lindex $rowidlist $row] - set previdlist [lindex $rowidlist $y0] - if {$idlist eq {} || $previdlist eq {}} continue - if {$ym >= 0} { - set pprevidlist [lindex $rowidlist $ym] - if {$pprevidlist eq {}} continue - } else { - set pprevidlist {} - } - set x0 -1 - set xm -1 - for {} {$col < [llength $idlist]} {incr col} { - set id [lindex $idlist $col] - if {[lindex $previdlist $col] eq $id} continue - if {$id eq {}} { - set haspad 1 - continue - } - set x0 [lsearch -exact $previdlist $id] - if {$x0 < 0} continue - set z [expr {$x0 - $col}] - set isarrow 0 - set z0 {} - if {$ym >= 0} { - set xm [lsearch -exact $pprevidlist $id] - if {$xm >= 0} { - set z0 [expr {$xm - $x0}] - } - } - if {$z0 eq {}} { - # if row y0 is the first child of $id then it's not an arrow - if {[lindex $children($curview,$id) 0] ne - [lindex $displayorder $y0]} { - set isarrow 1 - } - } - if {!$isarrow && $id ne [lindex $displayorder $row] && - [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} { - set isarrow 1 - } - # Looking at lines from this row to the previous row, - # make them go straight up if they end in an arrow on - # the previous row; otherwise make them go straight up - # or at 45 degrees. - if {$z < -1 || ($z < 0 && $isarrow)} { - # Line currently goes left too much; - # insert pads in the previous row, then optimize it - set npad [expr {-1 - $z + $isarrow}] - insert_pad $y0 $x0 $npad - if {$y0 > 0} { - optimize_rows $y0 $x0 $row - } - set previdlist [lindex $rowidlist $y0] - set x0 [lsearch -exact $previdlist $id] - set z [expr {$x0 - $col}] - if {$z0 ne {}} { - set pprevidlist [lindex $rowidlist $ym] - set xm [lsearch -exact $pprevidlist $id] - set z0 [expr {$xm - $x0}] - } - } elseif {$z > 1 || ($z > 0 && $isarrow)} { - # Line currently goes right too much; - # insert pads in this line - set npad [expr {$z - 1 + $isarrow}] - insert_pad $row $col $npad - set idlist [lindex $rowidlist $row] - incr col $npad - set z [expr {$x0 - $col}] - set haspad 1 - } - if {$z0 eq {} && !$isarrow && $ym >= 0} { - # this line links to its first child on row $row-2 - set id [lindex $displayorder $ym] - set xc [lsearch -exact $pprevidlist $id] - if {$xc >= 0} { - set z0 [expr {$xc - $x0}] - } - } - # avoid lines jigging left then immediately right - if {$z0 ne {} && $z < 0 && $z0 > 0} { - insert_pad $y0 $x0 1 - incr x0 - optimize_rows $y0 $x0 $row - set previdlist [lindex $rowidlist $y0] - } - } - if {!$haspad} { - # Find the first column that doesn't have a line going right - for {set col [llength $idlist]} {[incr col -1] >= 0} {} { - set id [lindex $idlist $col] - if {$id eq {}} break - set x0 [lsearch -exact $previdlist $id] - if {$x0 < 0} { - # check if this is the link to the first child - set kid [lindex $displayorder $y0] - if {[lindex $children($curview,$id) 0] eq $kid} { - # it is, work out offset to child - set x0 [lsearch -exact $previdlist $kid] - } - } - if {$x0 <= $col} break - } - # Insert a pad at that column as long as it has a line and - # isn't the last column - if {$x0 >= 0 && [incr col] < [llength $idlist]} { - set idlist [linsert $idlist $col {}] - lset rowidlist $row $idlist - changedrow $row - } - } - } -} - -proc xc {row col} { - global canvx0 linespc - return [expr {$canvx0 + $col * $linespc}] -} - -proc yc {row} { - global canvy0 linespc - return [expr {$canvy0 + $row * $linespc}] -} - -proc linewidth {id} { - global thickerline lthickness - - set wid $lthickness - if {[info exists thickerline] && $id eq $thickerline} { - set wid [expr {2 * $lthickness}] - } - return $wid -} - -proc rowranges {id} { - global commitrow curview children uparrowlen downarrowlen - global rowidlist - - set kids $children($curview,$id) - if {$kids eq {}} { - return {} - } - set ret {} - lappend kids $id - foreach child $kids { - if {![info exists commitrow($curview,$child)]} break - set row $commitrow($curview,$child) - if {![info exists prev]} { - lappend ret [expr {$row + 1}] - } else { - if {$row <= $prevrow} { - puts "oops children out of order [shortids $id] $row < [shortids $prev] $prevrow" - } - # see if the line extends the whole way from prevrow to row - if {$row > $prevrow + $uparrowlen + $downarrowlen && - [lsearch -exact [lindex $rowidlist \ - [expr {int(($row + $prevrow) / 2)}]] $id] < 0} { - # it doesn't, see where it ends - set r [expr {$prevrow + $downarrowlen}] - if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} { - while {[incr r -1] > $prevrow && - [lsearch -exact [lindex $rowidlist $r] $id] < 0} {} - } else { - while {[incr r] <= $row && - [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {} - incr r -1 - } - lappend ret $r - # see where it starts up again - set r [expr {$row - $uparrowlen}] - if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} { - while {[incr r] < $row && - [lsearch -exact [lindex $rowidlist $r] $id] < 0} {} - } else { - while {[incr r -1] >= $prevrow && - [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {} - incr r - } - lappend ret $r - } - } - if {$child eq $id} { - lappend ret $row - } - set prev $id - set prevrow $row - } - return $ret -} - -proc drawlineseg {id row endrow arrowlow} { - global rowidlist displayorder iddrawn linesegs - global canv colormap linespc curview maxlinelen parentlist - - set cols [list [lsearch -exact [lindex $rowidlist $row] $id]] - set le [expr {$row + 1}] - set arrowhigh 1 - while {1} { - set c [lsearch -exact [lindex $rowidlist $le] $id] - if {$c < 0} { - incr le -1 - break - } - lappend cols $c - set x [lindex $displayorder $le] - if {$x eq $id} { - set arrowhigh 0 - break - } - if {[info exists iddrawn($x)] || $le == $endrow} { - set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id] - if {$c >= 0} { - lappend cols $c - set arrowhigh 0 - } - break - } - incr le - } - if {$le <= $row} { - return $row - } - - set lines {} - set i 0 - set joinhigh 0 - if {[info exists linesegs($id)]} { - set lines $linesegs($id) - foreach li $lines { - set r0 [lindex $li 0] - if {$r0 > $row} { - if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} { - set joinhigh 1 - } - break - } - incr i - } - } - set joinlow 0 - if {$i > 0} { - set li [lindex $lines [expr {$i-1}]] - set r1 [lindex $li 1] - if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} { - set joinlow 1 - } - } - - set x [lindex $cols [expr {$le - $row}]] - set xp [lindex $cols [expr {$le - 1 - $row}]] - set dir [expr {$xp - $x}] - if {$joinhigh} { - set ith [lindex $lines $i 2] - set coords [$canv coords $ith] - set ah [$canv itemcget $ith -arrow] - set arrowhigh [expr {$ah eq "first" || $ah eq "both"}] - set x2 [lindex $cols [expr {$le + 1 - $row}]] - if {$x2 ne {} && $x - $x2 == $dir} { - set coords [lrange $coords 0 end-2] - } - } else { - set coords [list [xc $le $x] [yc $le]] - } - if {$joinlow} { - set itl [lindex $lines [expr {$i-1}] 2] - set al [$canv itemcget $itl -arrow] - set arrowlow [expr {$al eq "last" || $al eq "both"}] - } elseif {$arrowlow} { - if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 || - [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} { - set arrowlow 0 - } - } - set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]] - for {set y $le} {[incr y -1] > $row} {} { - set x $xp - set xp [lindex $cols [expr {$y - 1 - $row}]] - set ndir [expr {$xp - $x}] - if {$dir != $ndir || $xp < 0} { - lappend coords [xc $y $x] [yc $y] - } - set dir $ndir - } - if {!$joinlow} { - if {$xp < 0} { - # join parent line to first child - set ch [lindex $displayorder $row] - set xc [lsearch -exact [lindex $rowidlist $row] $ch] - if {$xc < 0} { - puts "oops: drawlineseg: child $ch not on row $row" - } elseif {$xc != $x} { - if {($arrowhigh && $le == $row + 1) || $dir == 0} { - set d [expr {int(0.5 * $linespc)}] - set x1 [xc $row $x] - if {$xc < $x} { - set x2 [expr {$x1 - $d}] - } else { - set x2 [expr {$x1 + $d}] - } - set y2 [yc $row] - set y1 [expr {$y2 + $d}] - lappend coords $x1 $y1 $x2 $y2 - } elseif {$xc < $x - 1} { - lappend coords [xc $row [expr {$x-1}]] [yc $row] - } elseif {$xc > $x + 1} { - lappend coords [xc $row [expr {$x+1}]] [yc $row] - } - set x $xc - } - lappend coords [xc $row $x] [yc $row] - } else { - set xn [xc $row $xp] - set yn [yc $row] - lappend coords $xn $yn - } - if {!$joinhigh} { - assigncolor $id - set t [$canv create line $coords -width [linewidth $id] \ - -fill $colormap($id) -tags lines.$id -arrow $arrow] - $canv lower $t - bindline $t $id - set lines [linsert $lines $i [list $row $le $t]] - } else { - $canv coords $ith $coords - if {$arrow ne $ah} { - $canv itemconf $ith -arrow $arrow - } - lset lines $i 0 $row - } - } else { - set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id] - set ndir [expr {$xo - $xp}] - set clow [$canv coords $itl] - if {$dir == $ndir} { - set clow [lrange $clow 2 end] - } - set coords [concat $coords $clow] - if {!$joinhigh} { - lset lines [expr {$i-1}] 1 $le - } else { - # coalesce two pieces - $canv delete $ith - set b [lindex $lines [expr {$i-1}] 0] - set e [lindex $lines $i 1] - set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]] - } - $canv coords $itl $coords - if {$arrow ne $al} { - $canv itemconf $itl -arrow $arrow - } - } - - set linesegs($id) $lines - return $le -} - -proc drawparentlinks {id row} { - global rowidlist canv colormap curview parentlist - global idpos linespc - - set rowids [lindex $rowidlist $row] - set col [lsearch -exact $rowids $id] - if {$col < 0} return - set olds [lindex $parentlist $row] - set row2 [expr {$row + 1}] - set x [xc $row $col] - set y [yc $row] - set y2 [yc $row2] - set d [expr {int(0.5 * $linespc)}] - set ymid [expr {$y + $d}] - set ids [lindex $rowidlist $row2] - # rmx = right-most X coord used - set rmx 0 - foreach p $olds { - set i [lsearch -exact $ids $p] - if {$i < 0} { - puts "oops, parent $p of $id not in list" - continue - } - set x2 [xc $row2 $i] - if {$x2 > $rmx} { - set rmx $x2 - } - set j [lsearch -exact $rowids $p] - if {$j < 0} { - # drawlineseg will do this one for us - continue - } - assigncolor $p - # should handle duplicated parents here... - set coords [list $x $y] - if {$i != $col} { - # if attaching to a vertical segment, draw a smaller - # slant for visual distinctness - if {$i == $j} { - if {$i < $col} { - lappend coords [expr {$x2 + $d}] $y $x2 $ymid - } else { - lappend coords [expr {$x2 - $d}] $y $x2 $ymid - } - } elseif {$i < $col && $i < $j} { - # segment slants towards us already - lappend coords [xc $row $j] $y - } else { - if {$i < $col - 1} { - lappend coords [expr {$x2 + $linespc}] $y - } elseif {$i > $col + 1} { - lappend coords [expr {$x2 - $linespc}] $y - } - lappend coords $x2 $y2 - } - } else { - lappend coords $x2 $y2 - } - set t [$canv create line $coords -width [linewidth $p] \ - -fill $colormap($p) -tags lines.$p] - $canv lower $t - bindline $t $p - } - if {$rmx > [lindex $idpos($id) 1]} { - lset idpos($id) 1 $rmx - redrawtags $id - } -} - -proc drawlines {id} { - global canv - - $canv itemconf lines.$id -width [linewidth $id] -} - -proc drawcmittext {id row col} { - global linespc canv canv2 canv3 canvy0 fgcolor curview - global commitlisted commitinfo rowidlist parentlist - global rowtextx idpos idtags idheads idotherrefs - global linehtag linentag linedtag selectedline - global canvxmax boldrows boldnamerows fgcolor nullid nullid2 - - # listed is 0 for boundary, 1 for normal, 2 for left, 3 for right - set listed [lindex $commitlisted $row] - if {$id eq $nullid} { - set ofill red - } elseif {$id eq $nullid2} { - set ofill green - } else { - set ofill [expr {$listed != 0? "blue": "white"}] - } - set x [xc $row $col] - set y [yc $row] - set orad [expr {$linespc / 3}] - if {$listed <= 1} { - set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \ - [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \ - -fill $ofill -outline $fgcolor -width 1 -tags circle] - } elseif {$listed == 2} { - # triangle pointing left for left-side commits - set t [$canv create polygon \ - [expr {$x - $orad}] $y \ - [expr {$x + $orad - 1}] [expr {$y - $orad}] \ - [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \ - -fill $ofill -outline $fgcolor -width 1 -tags circle] - } else { - # triangle pointing right for right-side commits - set t [$canv create polygon \ - [expr {$x + $orad - 1}] $y \ - [expr {$x - $orad}] [expr {$y - $orad}] \ - [expr {$x - $orad}] [expr {$y + $orad - 1}] \ - -fill $ofill -outline $fgcolor -width 1 -tags circle] - } - $canv raise $t - $canv bind $t <1> {selcanvline {} %x %y} - set rmx [llength [lindex $rowidlist $row]] - set olds [lindex $parentlist $row] - if {$olds ne {}} { - set nextids [lindex $rowidlist [expr {$row + 1}]] - foreach p $olds { - set i [lsearch -exact $nextids $p] - if {$i > $rmx} { - set rmx $i - } - } - } - set xt [xc $row $rmx] - set rowtextx($row) $xt - set idpos($id) [list $x $xt $y] - if {[info exists idtags($id)] || [info exists idheads($id)] - || [info exists idotherrefs($id)]} { - set xt [drawtags $id $x $xt $y] - } - set headline [lindex $commitinfo($id) 0] - set name [lindex $commitinfo($id) 1] - set date [lindex $commitinfo($id) 2] - set date [formatdate $date] - set font mainfont - set nfont mainfont - set isbold [ishighlighted $row] - if {$isbold > 0} { - lappend boldrows $row - set font mainfontbold - if {$isbold > 1} { - lappend boldnamerows $row - set nfont mainfontbold - } - } - 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 -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] - if {[info exists selectedline] && $selectedline == $row} { - make_secsel $row - } - set xr [expr {$xt + [font measure $font $headline]}] - if {$xr > $canvxmax} { - set canvxmax $xr - setcanvscroll - } -} - -proc drawcmitrow {row} { - global displayorder rowidlist nrows_drawn - global iddrawn markingmatches - global commitinfo parentlist numcommits - global filehighlight fhighlights findpattern nhighlights - global hlview vhighlights - global highlight_related rhighlights - - if {$row >= $numcommits} return - - set id [lindex $displayorder $row] - if {[info exists hlview] && ![info exists vhighlights($row)]} { - askvhighlight $row $id - } - if {[info exists filehighlight] && ![info exists fhighlights($row)]} { - askfilehighlight $row $id - } - if {$findpattern ne {} && ![info exists nhighlights($row)]} { - askfindhighlight $row $id - } - if {$highlight_related ne "None" && ![info exists rhighlights($row)]} { - askrelhighlight $row $id - } - if {![info exists iddrawn($id)]} { - set col [lsearch -exact [lindex $rowidlist $row] $id] - if {$col < 0} { - puts "oops, row $row id $id not in list" - return - } - if {![info exists commitinfo($id)]} { - getcommit $id - } - assigncolor $id - drawcmittext $id $row $col - set iddrawn($id) 1 - incr nrows_drawn - } - if {$markingmatches} { - markrowmatches $row $id - } -} - -proc drawcommits {row {endrow {}}} { - global numcommits iddrawn displayorder curview need_redisplay - global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn - - if {$row < 0} { - set row 0 - } - if {$endrow eq {}} { - set endrow $row - } - if {$endrow >= $numcommits} { - set endrow [expr {$numcommits - 1}] - } - - set rl1 [expr {$row - $downarrowlen - 3}] - if {$rl1 < 0} { - set rl1 0 - } - set ro1 [expr {$row - 3}] - if {$ro1 < 0} { - set ro1 0 - } - set r2 [expr {$endrow + $uparrowlen + 3}] - if {$r2 > $numcommits} { - set r2 $numcommits - } - for {set r $rl1} {$r < $r2} {incr r} { - if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} { - if {$rl1 < $r} { - layoutrows $rl1 $r - } - set rl1 [expr {$r + 1}] - } - } - if {$rl1 < $r} { - layoutrows $rl1 $r - } - optimize_rows $ro1 0 $r2 - if {$need_redisplay || $nrows_drawn > 2000} { - clear_display - drawvisible - } - - # make the lines join to already-drawn rows either side - set r [expr {$row - 1}] - if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} { - set r $row - } - set er [expr {$endrow + 1}] - if {$er >= $numcommits || - ![info exists iddrawn([lindex $displayorder $er])]} { - set er $endrow - } - for {} {$r <= $er} {incr r} { - set id [lindex $displayorder $r] - set wasdrawn [info exists iddrawn($id)] - drawcmitrow $r - if {$r == $er} break - set nextid [lindex $displayorder [expr {$r + 1}]] - if {$wasdrawn && [info exists iddrawn($nextid)]} continue - drawparentlinks $id $r - - set rowids [lindex $rowidlist $r] - foreach lid $rowids { - if {$lid eq {}} continue - if {[info exists lineend($lid)] && $lineend($lid) > $r} continue - if {$lid eq $id} { - # see if this is the first child of any of its parents - foreach p [lindex $parentlist $r] { - if {[lsearch -exact $rowids $p] < 0} { - # make this line extend up to the child - set lineend($p) [drawlineseg $p $r $er 0] - } - } - } else { - set lineend($lid) [drawlineseg $lid $r $er 1] - } - } - } -} - -proc drawfrac {f0 f1} { - global canv linespc - - set ymax [lindex [$canv cget -scrollregion] 3] - if {$ymax eq {} || $ymax == 0} return - set y0 [expr {int($f0 * $ymax)}] - set row [expr {int(($y0 - 3) / $linespc) - 1}] - set y1 [expr {int($f1 * $ymax)}] - set endrow [expr {int(($y1 - 3) / $linespc) + 1}] - drawcommits $row $endrow -} - -proc drawvisible {} { - global canv - eval drawfrac [$canv yview] -} - -proc clear_display {} { - global iddrawn linesegs need_redisplay nrows_drawn - global vhighlights fhighlights nhighlights rhighlights - - allcanvs delete all - catch {unset iddrawn} - catch {unset linesegs} - catch {unset vhighlights} - catch {unset fhighlights} - catch {unset nhighlights} - catch {unset rhighlights} - set need_redisplay 0 - set nrows_drawn 0 -} - -proc findcrossings {id} { - global rowidlist parentlist numcommits displayorder - - set cross {} - set ccross {} - foreach {s e} [rowranges $id] { - if {$e >= $numcommits} { - set e [expr {$numcommits - 1}] - } - if {$e <= $s} continue - for {set row $e} {[incr row -1] >= $s} {} { - set x [lsearch -exact [lindex $rowidlist $row] $id] - if {$x < 0} break - 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 - } - } - } - } - } - return [concat $ccross {{}} $cross] -} - -proc assigncolor {id} { - global colormap colors nextcolor - global commitrow parentlist children children curview - - if {[info exists colormap($id)]} return - set ncolors [llength $colors] - if {[info exists children($curview,$id)]} { - set kids $children($curview,$id) - } else { - set kids {} - } - if {[llength $kids] == 1} { - set child [lindex $kids 0] - if {[info exists colormap($child)] - && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} { - set colormap($id) $colormap($child) - return - } - } - set badcolors {} - 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 {[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 - 1} { - foreach child $kids { - if {[info exists colormap($child)] - && [lsearch -exact $badcolors $colormap($child)] < 0} { - lappend badcolors $colormap($child) - } - foreach p [lindex $parentlist $commitrow($curview,$child)] { - if {[info exists colormap($p)] - && [lsearch -exact $badcolors $colormap($p)] < 0} { - lappend badcolors $colormap($p) - } - } - } - if {[llength $badcolors] >= $ncolors} { - set badcolors $origbad - } - } - for {set i 0} {$i <= $ncolors} {incr i} { - set c [lindex $colors $nextcolor] - if {[incr nextcolor] >= $ncolors} { - set nextcolor 0 - } - if {[lsearch -exact $badcolors $c]} break - } - set colormap($id) $c -} - -proc bindline {t id} { - global canv - - $canv bind $t "lineenter %x %y $id" - $canv bind $t "linemotion %x %y $id" - $canv bind $t "lineleave $id" - $canv bind $t "lineclick %x %y $id 1" -} - -proc drawtags {id x xt y1} { - global idtags idheads idotherrefs mainhead - global linespc lthickness - global canv commitrow rowtextx curview fgcolor bgcolor - - set marks {} - set ntags 0 - set nheads 0 - if {[info exists idtags($id)]} { - set marks $idtags($id) - set ntags [llength $marks] - } - if {[info exists idheads($id)]} { - set marks [concat $marks $idheads($id)] - set nheads [llength $idheads($id)] - } - if {[info exists idotherrefs($id)]} { - set marks [concat $marks $idotherrefs($id)] - } - if {$marks eq {}} { - return $xt - } - - set delta [expr {int(0.5 * ($linespc - $lthickness))}] - set yt [expr {$y1 - 0.5 * $linespc}] - set yb [expr {$yt + $linespc - 1}] - set xvals {} - set wvals {} - set i -1 - foreach tag $marks { - incr i - if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} { - set wid [font measure mainfontbold $tag] - } else { - set wid [font measure mainfont $tag] - } - lappend xvals $xt - lappend wvals $wid - set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}] - } - set t [$canv create line $x $y1 [lindex $xvals end] $y1 \ - -width $lthickness -fill black -tags tag.$id] - $canv lower $t - 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 \ - $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \ - -width 1 -outline black -fill yellow -tags tag.$id] - $canv bind $t <1> [list showtag $tag 1] - set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}] - } else { - # draw a head or other ref - if {[incr nheads -1] >= 0} { - set col green - if {$tag eq $mainhead} { - set font mainfontbold - } - } else { - set col "#ddddff" - } - set xl [expr {$xl - $delta/2}] - $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \ - -width 1 -outline black -fill $col -tags tag.$id - if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} { - set rwid [font measure mainfont $remoteprefix] - set xi [expr {$x + 1}] - set yti [expr {$yt + 1}] - set xri [expr {$x + $rwid}] - $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \ - -width 0 -fill "#ffddaa" -tags tag.$id - } - } - set t [$canv create text $xl $y1 -anchor w -text $tag -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 -} - -proc xcoord {i level ln} { - global canvx0 xspc1 xspc2 - - set x [expr {$canvx0 + $i * $xspc1($ln)}] - if {$i > 0 && $i == $level} { - set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}] - } elseif {$i > $level} { - set x [expr {$x + $xspc2 - $xspc1($ln)}] - } - return $x -} - -proc show_status {msg} { - global canv fgcolor - - clear_display - $canv create text 3 3 -anchor nw -text $msg -font mainfont \ - -tags text -fill $fgcolor -} - -# 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 commitlisted children - global commitrow curview rowidlist rowisopt rowfinal numcommits - global numcommits - global selectedline commitidx ordertok - - 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 $children($curview,$p) - lappend kids $newcmit - set children($curview,$p) $kids - set children($curview,$newcmit) {} - 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 - } - incr commitidx($curview) - set ordertok($curview,$newcmit) $ordertok($curview,$p) - - if {$row < [llength $rowidlist]} { - set idlist [lindex $rowidlist $row] - if {$idlist ne {}} { - if {[llength $kids] == 1} { - set col [lsearch -exact $idlist $p] - lset idlist $col $newcmit - } else { - set col [llength $idlist] - lappend idlist $newcmit - } - } - set rowidlist [linsert $rowidlist $row $idlist] - set rowisopt [linsert $rowisopt $row 0] - set rowfinal [linsert $rowfinal $row [lindex $rowfinal $row]] - } - - incr numcommits - - if {[info exists selectedline] && $selectedline >= $row} { - incr selectedline - } - redisplay -} - -# Remove a commit that was inserted with insertrow on row $row. -proc removerow {row} { - global displayorder parentlist commitlisted children - global commitrow curview rowidlist rowisopt rowfinal numcommits - global numcommits - global linesegends selectedline commitidx - - if {$row >= $numcommits} { - puts "oops, removing row $row but only have $numcommits rows" - return - } - set rp1 [expr {$row + 1}] - set id [lindex $displayorder $row] - set p [lindex $parentlist $row] - set displayorder [lreplace $displayorder $row $row] - set parentlist [lreplace $parentlist $row $row] - set commitlisted [lreplace $commitlisted $row $row] - set kids $children($curview,$p) - set i [lsearch -exact $kids $id] - if {$i >= 0} { - set kids [lreplace $kids $i $i] - set children($curview,$p) $kids - } - set l [llength $displayorder] - for {set r $row} {$r < $l} {incr r} { - set id [lindex $displayorder $r] - set commitrow($curview,$id) $r - } - incr commitidx($curview) -1 - - if {$row < [llength $rowidlist]} { - set rowidlist [lreplace $rowidlist $row $row] - set rowisopt [lreplace $rowisopt $row $row] - set rowfinal [lreplace $rowfinal $row $row] - } - - incr numcommits -1 - - if {[info exists selectedline] && $selectedline > $row} { - incr selectedline -1 - } - 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} { - global ctext curtextcursor - - if {[$ctext cget -cursor] == $curtextcursor} { - $ctext config -cursor $c - } - set curtextcursor $c -} - -proc nowbusy {what {name {}}} { - global isbusy busyname statusw - - if {[array names isbusy] eq {}} { - . config -cursor watch - settextcursor watch - } - set isbusy($what) 1 - set busyname($what) $name - if {$name ne {}} { - $statusw conf -text $name - } -} - -proc notbusy {what} { - global isbusy maincursor textcursor busyname statusw - - catch { - unset isbusy($what) - if {$busyname($what) ne {} && - [$statusw cget -text] eq $busyname($what)} { - $statusw conf -text {} - } - } - if {[array names isbusy] eq {}} { - . config -cursor $maincursor - settextcursor $textcursor - } -} - -proc findmatches {f} { - global findtype findstring - if {$findtype == "Regexp"} { - set matches [regexp -indices -all -inline $findstring $f] - } else { - set fs $findstring - if {$findtype == "IgnCase"} { - set f [string tolower $f] - set fs [string tolower $fs] - } - set matches {} - set i 0 - set l [string length $fs] - while {[set j [string first $fs $f $i]] >= 0} { - lappend matches [list $j [expr {$j+$l-1}]] - set i [expr {$j + $l}] - } - } - return $matches -} - -proc dofind {{dirn 1} {wrap 1}} { - global findstring findstartline findcurline selectedline numcommits - global gdttype filehighlight fh_serial find_dirn findallowwrap - - if {[info exists find_dirn]} { - if {$find_dirn == $dirn} return - stopfinding - } - focus . - if {$findstring eq {} || $numcommits == 0} return - if {![info exists selectedline]} { - set findstartline [lindex [visiblerows] [expr {$dirn < 0}]] - } else { - set findstartline $selectedline - } - set findcurline $findstartline - nowbusy finding "Searching" - if {$gdttype ne "containing:" && ![info exists filehighlight]} { - after cancel do_file_hl $fh_serial - do_file_hl $fh_serial - } - set find_dirn $dirn - set findallowwrap $wrap - run findmore -} - -proc stopfinding {} { - global find_dirn findcurline fprogcoord - - if {[info exists find_dirn]} { - unset find_dirn - unset findcurline - notbusy finding - set fprogcoord 0 - adjustprogress - } -} - -proc findmore {} { - global commitdata commitinfo numcommits findpattern findloc - global findstartline findcurline displayorder - global find_dirn gdttype fhighlights fprogcoord - global findallowwrap - - if {![info exists find_dirn]} { - return 0 - } - set fldtypes {Headline Author Date Committer CDate Comments} - set l $findcurline - set moretodo 0 - if {$find_dirn > 0} { - incr l - if {$l >= $numcommits} { - set l 0 - } - if {$l <= $findstartline} { - set lim [expr {$findstartline + 1}] - } else { - set lim $numcommits - set moretodo $findallowwrap - } - } else { - if {$l == 0} { - set l $numcommits - } - incr l -1 - if {$l >= $findstartline} { - set lim [expr {$findstartline - 1}] - } else { - set lim -1 - set moretodo $findallowwrap - } - } - set n [expr {($lim - $l) * $find_dirn}] - if {$n > 500} { - set n 500 - set moretodo 1 - } - set found 0 - set domore 1 - if {$gdttype eq "containing:"} { - for {} {$n > 0} {incr n -1; incr l $find_dirn} { - set id [lindex $displayorder $l] - # shouldn't happen unless git log doesn't give all the commits... - if {![info exists commitdata($id)]} continue - if {![doesmatch $commitdata($id)]} continue - if {![info exists commitinfo($id)]} { - getcommit $id - } - set info $commitinfo($id) - foreach f $info ty $fldtypes { - if {($findloc eq "All fields" || $findloc eq $ty) && - [doesmatch $f]} { - set found 1 - break - } - } - if {$found} break - } - } else { - for {} {$n > 0} {incr n -1; incr l $find_dirn} { - set id [lindex $displayorder $l] - if {![info exists fhighlights($l)]} { - askfilehighlight $l $id - if {$domore} { - set domore 0 - set findcurline [expr {$l - $find_dirn}] - } - } elseif {$fhighlights($l)} { - set found $domore - break - } - } - } - if {$found || ($domore && !$moretodo)} { - unset findcurline - unset find_dirn - notbusy finding - set fprogcoord 0 - adjustprogress - if {$found} { - findselectline $l - } else { - bell - } - return 0 - } - if {!$domore} { - flushhighlights - } else { - set findcurline [expr {$l - $find_dirn}] - } - set n [expr {($findcurline - $findstartline) * $find_dirn - 1}] - if {$n < 0} { - incr n $numcommits - } - set fprogcoord [expr {$n * 1.0 / $numcommits}] - adjustprogress - return $domore -} - -proc findselectline {l} { - global findloc commentend ctext findcurline markingmatches gdttype - - set markingmatches 1 - set findcurline $l - selectline $l 1 - if {$findloc == "All fields" || $findloc == "Comments"} { - # highlight the matches in the comments - set f [$ctext get 1.0 $commentend] - set matches [findmatches $f] - foreach match $matches { - set start [lindex $match 0] - set end [expr {[lindex $match 1] + 1}] - $ctext tag add found "1.0 + $start c" "1.0 + $end c" - } - } - drawvisible -} - -# mark the bits of a headline or author that match a find string -proc markmatches {canv l str tag matches font row} { - global selectedline - - set bbox [$canv bbox $tag] - set x0 [lindex $bbox 0] - set y0 [lindex $bbox 1] - set y1 [lindex $bbox 3] - foreach match $matches { - set start [lindex $match 0] - set end [lindex $match 1] - if {$start > $end} continue - set xoff [font measure $font [string range $str 0 [expr {$start-1}]]] - set xlen [font measure $font [string range $str 0 [expr {$end}]]] - set t [$canv create rect [expr {$x0+$xoff}] $y0 \ - [expr {$x0+$xlen+2}] $y1 \ - -outline {} -tags [list match$l matches] -fill yellow] - $canv lower $t - if {[info exists selectedline] && $row == $selectedline} { - $canv raise $t secsel - } - } -} - -proc unmarkmatches {} { - global markingmatches - - allcanvs delete matches - set markingmatches 0 - stopfinding -} - -proc selcanvline {w x y} { - global canv canvy0 ctext linespc - global rowtextx - set ymax [lindex [$canv cget -scrollregion] 3] - if {$ymax == {}} return - set yfrac [lindex [$canv yview] 0] - set y [expr {$y + $yfrac * $ymax}] - set l [expr {int(($y - $canvy0) / $linespc + 0.5)}] - if {$l < 0} { - set l 0 - } - if {$w eq $canv} { - if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return - } - unmarkmatches - selectline $l 1 -} - -proc commit_descriptor {p} { - global commitinfo - if {![info exists commitinfo($p)]} { - getcommit $p - } - set l "..." - if {[llength $commitinfo($p)] > 1} { - set l [lindex $commitinfo($p) 0] - } - return "$p ($l)\n" -} - -# append some text to the ctext widget, and make any SHA1 ID -# that we know about be a clickable link. -proc appendwithlinks {text tags} { - global ctext commitrow linknum curview pendinglinks - - set start [$ctext index "end - 1c"] - $ctext insert end $text $tags - set links [regexp -indices -all -inline {[0-9a-f]{40}} $text] - foreach l $links { - set s [lindex $l 0] - set e [lindex $l 1] - set linkid [string range $text $s $e] - incr e - $ctext tag delete link$linknum - $ctext tag add link$linknum "$start + $s c" "$start + $e c" - setlink $linkid link$linknum - incr linknum - } -} - -proc setlink {id lk} { - global curview commitrow ctext pendinglinks commitinterest - - if {[info exists commitrow($curview,$id)]} { - $ctext tag conf $lk -foreground blue -underline 1 - $ctext tag bind $lk <1> [list selectline $commitrow($curview,$id) 1] - $ctext tag bind $lk {linkcursor %W 1} - $ctext tag bind $lk {linkcursor %W -1} - } else { - lappend pendinglinks($id) $lk - lappend commitinterest($id) {makelink %I} - } -} - -proc makelink {id} { - global pendinglinks - - if {![info exists pendinglinks($id)]} return - foreach lk $pendinglinks($id) { - setlink $id $lk - } - unset pendinglinks($id) -} - -proc linkcursor {w inc} { - global linkentercount curtextcursor - - if {[incr linkentercount $inc] > 0} { - $w configure -cursor hand2 - } else { - $w configure -cursor $curtextcursor - if {$linkentercount < 0} { - set linkentercount 0 - } - } -} - -proc viewnextline {dir} { - global canv linespc - - $canv delete hover - set ymax [lindex [$canv cget -scrollregion] 3] - set wnow [$canv yview] - set wtop [expr {[lindex $wnow 0] * $ymax}] - set newtop [expr {$wtop + $dir * $linespc}] - if {$newtop < 0} { - set newtop 0 - } elseif {$newtop > $ymax} { - set newtop $ymax - } - allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}] -} - -# add a list of tag or branch names at position pos -# returns the number of names inserted -proc appendrefs {pos ids var} { - global ctext commitrow linknum curview $var maxrefs - - if {[catch {$ctext index $pos}]} { - return 0 - } - $ctext conf -state normal - $ctext delete $pos "$pos lineend" - set tags {} - foreach id $ids { - foreach tag [set $var\($id\)] { - lappend tags [list $tag $id] - } - } - if {[llength $tags] > $maxrefs} { - $ctext insert $pos "many ([llength $tags])" - } else { - set tags [lsort -index 0 -decreasing $tags] - set sep {} - foreach ti $tags { - set id [lindex $ti 1] - set lk link$linknum - incr linknum - $ctext tag delete $lk - $ctext insert $pos $sep - $ctext insert $pos [lindex $ti 0] $lk - setlink $id $lk - set sep ", " - } - } - $ctext conf -state disabled - return [llength $tags] -} - -# called when we have finished computing the nearby tags -proc dispneartags {delay} { - global selectedline currentid showneartags tagphase - - if {![info exists selectedline] || !$showneartags} return - after cancel dispnexttag - if {$delay} { - after 200 dispnexttag - set tagphase -1 - } else { - after idle dispnexttag - set tagphase 0 - } -} - -proc dispnexttag {} { - global selectedline currentid showneartags tagphase ctext - - if {![info exists selectedline] || !$showneartags} return - switch -- $tagphase { - 0 { - set dtags [desctags $currentid] - if {$dtags ne {}} { - appendrefs precedes $dtags idtags - } - } - 1 { - set atags [anctags $currentid] - if {$atags ne {}} { - appendrefs follows $atags idtags - } - } - 2 { - set dheads [descheads $currentid] - if {$dheads ne {}} { - if {[appendrefs branch $dheads idheads] > 1 - && [$ctext get "branch -3c"] eq "h"} { - # turn "Branch" into "Branches" - $ctext conf -state normal - $ctext insert "branch -2c" "es" - $ctext conf -state disabled - } - } - } - } - if {[incr tagphase] <= 2} { - after idle dispnexttag - } -} - -proc make_secsel {l} { - global linehtag linentag linedtag canv canv2 canv3 - - if {![info exists linehtag($l)]} return - $canv delete secsel - set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \ - -tags secsel -fill [$canv cget -selectbackground]] - $canv lower $t - $canv2 delete secsel - set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \ - -tags secsel -fill [$canv2 cget -selectbackground]] - $canv2 lower $t - $canv3 delete secsel - set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \ - -tags secsel -fill [$canv3 cget -selectbackground]] - $canv3 lower $t -} - -proc selectline {l isnew} { - global canv ctext commitinfo selectedline - global displayorder - global canvy0 linespc parentlist children curview - global currentid sha1entry - global commentend idtags linknum - global mergemax numcommits pending_select - global cmitmode showneartags allcommits - - catch {unset pending_select} - $canv delete hover - normalline - unsel_reflist - stopfinding - if {$l < 0 || $l >= $numcommits} return - set y [expr {$canvy0 + $l * $linespc}] - set ymax [lindex [$canv cget -scrollregion] 3] - set ytop [expr {$y - $linespc - 1}] - set ybot [expr {$y + $linespc + 1}] - set wnow [$canv yview] - set wtop [expr {[lindex $wnow 0] * $ymax}] - set wbot [expr {[lindex $wnow 1] * $ymax}] - set wh [expr {$wbot - $wtop}] - set newtop $wtop - if {$ytop < $wtop} { - if {$ybot < $wtop} { - set newtop [expr {$y - $wh / 2.0}] - } else { - set newtop $ytop - if {$newtop > $wtop - $linespc} { - set newtop [expr {$wtop - $linespc}] - } - } - } elseif {$ybot > $wbot} { - if {$ytop > $wbot} { - set newtop [expr {$y - $wh / 2.0}] - } else { - set newtop [expr {$ybot - $wh}] - if {$newtop < $wtop + $linespc} { - set newtop [expr {$wtop + $linespc}] - } - } - } - if {$newtop != $wtop} { - if {$newtop < 0} { - set newtop 0 - } - allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}] - drawvisible - } - - make_secsel $l - - if {$isnew} { - addtohistory [list selectline $l 0] - } - - set selectedline $l - - set id [lindex $displayorder $l] - set currentid $id - $sha1entry delete 0 end - $sha1entry insert 0 $id - $sha1entry selection from 0 - $sha1entry selection to end - rhighlight_sel $id - - $ctext conf -state normal - clear_ctext - set linknum 0 - set info $commitinfo($id) - set date [formatdate [lindex $info 2]] - $ctext insert end "Author: [lindex $info 1] $date\n" - set date [formatdate [lindex $info 4]] - $ctext insert end "Committer: [lindex $info 3] $date\n" - if {[info exists idtags($id)]} { - $ctext insert end "Tags:" - foreach tag $idtags($id) { - $ctext insert end " $tag" - } - $ctext insert end "\n" - } - - set headers {} - set olds [lindex $parentlist $l] - if {[llength $olds] > 1} { - set np 0 - foreach p $olds { - if {$np >= $mergemax} { - set tag mmax - } else { - set tag m$np - } - $ctext insert end "Parent: " $tag - appendwithlinks [commit_descriptor $p] {} - incr np - } - } else { - foreach p $olds { - append headers "Parent: [commit_descriptor $p]" - } - } - - foreach c $children($curview,$id) { - 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 - $ctext insert end "\nFollows: " - $ctext mark set follows "end -1c" - $ctext mark gravity follows left - $ctext insert end "\nPrecedes: " - $ctext mark set precedes "end -1c" - $ctext mark gravity precedes left - $ctext insert end "\n" - dispneartags 1 - } - $ctext insert end "\n" - set comment [lindex $info 5] - if {[string first "\r" $comment] >= 0} { - set comment [string map {"\r" "\n "} $comment] - } - appendwithlinks $comment {comment} - - $ctext tag remove found 1.0 end - $ctext conf -state disabled - set commentend [$ctext index "end - 1c"] - - init_flist "Comments" - if {$cmitmode eq "tree"} { - gettree $id - } elseif {[llength $olds] <= 1} { - startdiff $id - } else { - mergediff $id $l - } -} - -proc selfirstline {} { - unmarkmatches - selectline 0 1 -} - -proc sellastline {} { - global numcommits - unmarkmatches - set l [expr {$numcommits - 1}] - selectline $l 1 -} - -proc selnextline {dir} { - global selectedline - focus . - if {![info exists selectedline]} return - set l [expr {$selectedline + $dir}] - unmarkmatches - selectline $l 1 -} - -proc selnextpage {dir} { - global canv linespc selectedline numcommits - - set lpp [expr {([winfo height $canv] - 2) / $linespc}] - if {$lpp < 1} { - set lpp 1 - } - allcanvs yview scroll [expr {$dir * $lpp}] units - drawvisible - if {![info exists selectedline]} return - set l [expr {$selectedline + $dir * $lpp}] - if {$l < 0} { - set l 0 - } elseif {$l >= $numcommits} { - set l [expr $numcommits - 1] - } - unmarkmatches - selectline $l 1 -} - -proc unselectline {} { - global selectedline currentid - - catch {unset selectedline} - catch {unset currentid} - allcanvs delete secsel - rhighlight_none -} - -proc reselectline {} { - global selectedline - - if {[info exists selectedline]} { - selectline $selectedline 0 - } -} - -proc addtohistory {cmd} { - global history historyindex curview - - set elt [list $curview $cmd] - if {$historyindex > 0 - && [lindex $history [expr {$historyindex - 1}]] == $elt} { - return - } - - if {$historyindex < [llength $history]} { - set history [lreplace $history $historyindex end $elt] - } else { - lappend history $elt - } - incr historyindex - if {$historyindex > 1} { - .tf.bar.leftbut conf -state normal - } else { - .tf.bar.leftbut conf -state disabled - } - .tf.bar.rightbut conf -state disabled -} - -proc godo {elt} { - global curview - - set view [lindex $elt 0] - set cmd [lindex $elt 1] - if {$curview != $view} { - showview $view - } - eval $cmd -} - -proc goback {} { - global history historyindex - focus . - - if {$historyindex > 1} { - incr historyindex -1 - godo [lindex $history [expr {$historyindex - 1}]] - .tf.bar.rightbut conf -state normal - } - if {$historyindex <= 1} { - .tf.bar.leftbut conf -state disabled - } -} - -proc goforw {} { - global history historyindex - focus . - - if {$historyindex < [llength $history]} { - set cmd [lindex $history $historyindex] - incr historyindex - godo $cmd - .tf.bar.leftbut conf -state normal - } - if {$historyindex >= [llength $history]} { - .tf.bar.rightbut conf -state disabled - } -} - -proc gettree {id} { - global treefilelist treeidlist diffids diffmergeid treepending - global nullid nullid2 - - set diffids $id - catch {unset diffmergeid} - if {![info exists treefilelist($id)]} { - if {![info exists treepending]} { - if {$id eq $nullid} { - set cmd [list | git ls-files] - } elseif {$id eq $nullid2} { - set cmd [list | git ls-files --stage -t] - } else { - set cmd [list | git ls-tree -r $id] - } - if {[catch {set gtf [open $cmd r]}]} { - return - } - set treepending $id - set treefilelist($id) {} - set treeidlist($id) {} - fconfigure $gtf -blocking 0 - filerun $gtf [list gettreeline $gtf $id] - } - } else { - setfilelist $id - } -} - -proc gettreeline {gtf id} { - global treefilelist treeidlist treepending cmitmode diffids nullid nullid2 - - set nl 0 - while {[incr nl] <= 1000 && [gets $gtf line] >= 0} { - if {$diffids eq $nullid} { - set fname $line - } else { - if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue - set i [string first "\t" $line] - if {$i < 0} continue - set sha1 [lindex $line 2] - set fname [string range $line [expr {$i+1}] end] - if {[string index $fname 0] eq "\""} { - set fname [lindex $fname 0] - } - lappend treeidlist($id) $sha1 - } - lappend treefilelist($id) $fname - } - if {![eof $gtf]} { - return [expr {$nl >= 1000? 2: 1}] - } - close $gtf - unset treepending - if {$cmitmode ne "tree"} { - if {![info exists diffmergeid]} { - gettreediffs $diffids - } - } elseif {$id ne $diffids} { - gettree $diffids - } else { - setfilelist $id - } - return 0 -} - -proc showfile {f} { - global treefilelist treeidlist diffids nullid nullid2 - global ctext commentend - - set i [lsearch -exact $treefilelist($diffids) $f] - if {$i < 0} { - puts "oops, $f not in list for id $diffids" - return - } - if {$diffids eq $nullid} { - if {[catch {set bf [open $f r]} err]} { - puts "oops, can't read $f: $err" - return - } - } else { - set blob [lindex $treeidlist($diffids) $i] - if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} { - puts "oops, error reading blob $blob: $err" - return - } - } - fconfigure $bf -blocking 0 - filerun $bf [list getblobline $bf $diffids] - $ctext config -state normal - clear_ctext $commentend - $ctext insert end "\n" - $ctext insert end "$f\n" filesep - $ctext config -state disabled - $ctext yview $commentend - settabs 0 -} - -proc getblobline {bf id} { - global diffids cmitmode ctext - - if {$id ne $diffids || $cmitmode ne "tree"} { - catch {close $bf} - return 0 - } - $ctext config -state normal - set nl 0 - while {[incr nl] <= 1000 && [gets $bf line] >= 0} { - $ctext insert end "$line\n" - } - if {[eof $bf]} { - # delete last newline - $ctext delete "end - 2c" "end - 1c" - close $bf - return 0 - } - $ctext config -state disabled - return [expr {$nl >= 1000? 2: 1}] -} - -proc mergediff {id l} { - global diffmergeid mdifffd - global diffids - global parentlist - global limitdiffs viewfiles curview - - set diffmergeid $id - set diffids $id - # this doesn't seem to actually affect anything... - set cmd [concat | git diff-tree --no-commit-id --cc $id] - if {$limitdiffs && $viewfiles($curview) ne {}} { - set cmd [concat $cmd -- $viewfiles($curview)] - } - if {[catch {set mdf [open $cmd r]} err]} { - error_popup "Error getting merge diffs: $err" - return - } - fconfigure $mdf -blocking 0 - set mdifffd($id) $mdf - set np [llength [lindex $parentlist $l]] - settabs $np - filerun $mdf [list getmergediffline $mdf $id $np] -} - -proc getmergediffline {mdf id np} { - global diffmergeid ctext cflist mergemax - global difffilestart mdifffd - - $ctext conf -state normal - set nr 0 - while {[incr nr] <= 1000 && [gets $mdf line] >= 0} { - if {![info exists diffmergeid] || $id != $diffmergeid - || $mdf != $mdifffd($id)} { - close $mdf - return 0 - } - if {[regexp {^diff --cc (.*)} $line match fname]} { - # start of a new file - $ctext insert end "\n" - set here [$ctext index "end - 1c"] - lappend difffilestart $here - add_flist [list $fname] - set l [expr {(78 - [string length $fname]) / 2}] - set pad [string range "----------------------------------------" 1 $l] - $ctext insert end "$pad $fname $pad\n" filesep - } elseif {[regexp {^@@} $line]} { - $ctext insert end "$line\n" hunksep - } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} { - # do nothing - } else { - # parse the prefix - one ' ', '-' or '+' for each parent - set spaces {} - set minuses {} - set pluses {} - set isbad 0 - for {set j 0} {$j < $np} {incr j} { - set c [string range $line $j $j] - if {$c == " "} { - lappend spaces $j - } elseif {$c == "-"} { - lappend minuses $j - } elseif {$c == "+"} { - lappend pluses $j - } else { - set isbad 1 - break - } - } - set tags {} - set num {} - if {!$isbad && $minuses ne {} && $pluses eq {}} { - # line doesn't appear in result, parents in $minuses have the line - set num [lindex $minuses 0] - } elseif {!$isbad && $pluses ne {} && $minuses eq {}} { - # line appears in result, parents in $pluses don't have the line - lappend tags mresult - set num [lindex $spaces 0] - } - if {$num ne {}} { - if {$num >= $mergemax} { - set num "max" - } - lappend tags m$num - } - $ctext insert end "$line\n" $tags - } - } - $ctext conf -state disabled - if {[eof $mdf]} { - close $mdf - return 0 - } - return [expr {$nr >= 1000? 2: 1}] -} - -proc startdiff {ids} { - global treediffs diffids treepending diffmergeid nullid nullid2 - - settabs 1 - set diffids $ids - catch {unset diffmergeid} - if {![info exists treediffs($ids)] || - [lsearch -exact $ids $nullid] >= 0 || - [lsearch -exact $ids $nullid2] >= 0} { - if {![info exists treepending]} { - gettreediffs $ids - } - } else { - addtocflist $ids - } -} - -proc path_filter {filter name} { - foreach p $filter { - set l [string length $p] - if {[string index $p end] eq "/"} { - if {[string compare -length $l $p $name] == 0} { - return 1 - } - } else { - if {[string compare -length $l $p $name] == 0 && - ([string length $name] == $l || - [string index $name $l] eq "/")} { - return 1 - } - } - } - return 0 -} - -proc addtocflist {ids} { - global treediffs - - add_flist $treediffs($ids) - getblobdiffs $ids -} - -proc diffcmd {ids flags} { - global nullid nullid2 - - set i [lsearch -exact $ids $nullid] - set j [lsearch -exact $ids $nullid2] - if {$i >= 0} { - if {[llength $ids] > 1 && $j < 0} { - # comparing working directory with some specific revision - set cmd [concat | git diff-index $flags] - if {$i == 0} { - lappend cmd -R [lindex $ids 1] - } else { - lappend cmd [lindex $ids 0] - } - } else { - # comparing working directory with index - set cmd [concat | git diff-files $flags] - if {$j == 1} { - lappend cmd -R - } - } - } elseif {$j >= 0} { - set cmd [concat | git diff-index --cached $flags] - if {[llength $ids] > 1} { - # comparing index with specific revision - if {$i == 0} { - lappend cmd -R [lindex $ids 1] - } else { - lappend cmd [lindex $ids 0] - } - } else { - # comparing index with HEAD - lappend cmd HEAD - } - } else { - set cmd [concat | git diff-tree -r $flags $ids] - } - return $cmd -} - -proc gettreediffs {ids} { - global treediff treepending - - set treepending $ids - set treediff {} - if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return - fconfigure $gdtf -blocking 0 - filerun $gdtf [list gettreediffline $gdtf $ids] -} - -proc gettreediffline {gdtf ids} { - global treediff treediffs treepending diffids diffmergeid - global cmitmode viewfiles curview limitdiffs - - set nr 0 - while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} { - set i [string first "\t" $line] - if {$i >= 0} { - set file [string range $line [expr {$i+1}] end] - if {[string index $file 0] eq "\""} { - set file [lindex $file 0] - } - lappend treediff $file - } - } - if {![eof $gdtf]} { - return [expr {$nr >= 1000? 2: 1}] - } - close $gdtf - if {$limitdiffs && $viewfiles($curview) ne {}} { - set flist {} - foreach f $treediff { - if {[path_filter $viewfiles($curview) $f]} { - lappend flist $f - } - } - set treediffs($ids) $flist - } else { - set treediffs($ids) $treediff - } - unset treepending - if {$cmitmode eq "tree"} { - gettree $diffids - } elseif {$ids != $diffids} { - if {![info exists diffmergeid]} { - gettreediffs $diffids - } - } else { - addtocflist $ids - } - return 0 -} - -# empty string or positive integer -proc diffcontextvalidate {v} { - return [regexp {^(|[1-9][0-9]*)$} $v] -} - -proc diffcontextchange {n1 n2 op} { - global diffcontextstring diffcontext - - if {[string is integer -strict $diffcontextstring]} { - if {$diffcontextstring > 0} { - set diffcontext $diffcontextstring - reselectline - } - } -} - -proc getblobdiffs {ids} { - global blobdifffd diffids env - global diffinhdr treediffs - global diffcontext - global limitdiffs viewfiles curview - - set cmd [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"] - if {$limitdiffs && $viewfiles($curview) ne {}} { - set cmd [concat $cmd -- $viewfiles($curview)] - } - if {[catch {set bdf [open $cmd r]} err]} { - puts "error getting diffs: $err" - return - } - set diffinhdr 0 - fconfigure $bdf -blocking 0 - set blobdifffd($ids) $bdf - filerun $bdf [list getblobdiffline $bdf $diffids] -} - -proc setinlist {var i val} { - global $var - - while {[llength [set $var]] < $i} { - lappend $var {} - } - if {[llength [set $var]] == $i} { - lappend $var $val - } else { - lset $var $i $val - } -} - -proc makediffhdr {fname ids} { - global ctext curdiffstart treediffs - - set i [lsearch -exact $treediffs($ids) $fname] - if {$i >= 0} { - setinlist difffilestart $i $curdiffstart - } - set l [expr {(78 - [string length $fname]) / 2}] - set pad [string range "----------------------------------------" 1 $l] - $ctext insert $curdiffstart "$pad $fname $pad" filesep -} - -proc getblobdiffline {bdf ids} { - global diffids blobdifffd ctext curdiffstart - global diffnexthead diffnextnote difffilestart - global diffinhdr treediffs - - set nr 0 - $ctext conf -state normal - while {[incr nr] <= 1000 && [gets $bdf line] >= 0} { - if {$ids != $diffids || $bdf != $blobdifffd($ids)} { - close $bdf - return 0 - } - if {![string compare -length 11 "diff --git " $line]} { - # trim off "diff --git " - set line [string range $line 11 end] - set diffinhdr 1 - # start of a new file - $ctext insert end "\n" - set curdiffstart [$ctext index "end - 1c"] - $ctext insert end "\n" filesep - # If the name hasn't changed the length will be odd, - # the middle char will be a space, and the two bits either - # side will be a/name and b/name, or "a/name" and "b/name". - # If the name has changed we'll get "rename from" and - # "rename to" or "copy from" and "copy to" lines following this, - # and we'll use them to get the filenames. - # This complexity is necessary because spaces in the filename(s) - # don't get escaped. - set l [string length $line] - set i [expr {$l / 2}] - if {!(($l & 1) && [string index $line $i] eq " " && - [string range $line 2 [expr {$i - 1}]] eq \ - [string range $line [expr {$i + 3}] end])} { - continue - } - # unescape if quoted and chop off the a/ from the front - if {[string index $line 0] eq "\""} { - set fname [string range [lindex $line 0] 2 end] - } else { - set fname [string range $line 2 [expr {$i - 1}]] - } - makediffhdr $fname $ids - - } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \ - $line match f1l f1c f2l f2c rest]} { - $ctext insert end "$line\n" hunksep - set diffinhdr 0 - - } elseif {$diffinhdr} { - if {![string compare -length 12 "rename from " $line]} { - set fname [string range $line [expr 6 + [string first " from " $line] ] end] - if {[string index $fname 0] eq "\""} { - set fname [lindex $fname 0] - } - set i [lsearch -exact $treediffs($ids) $fname] - if {$i >= 0} { - setinlist difffilestart $i $curdiffstart - } - } elseif {![string compare -length 10 $line "rename to "] || - ![string compare -length 8 $line "copy to "]} { - set fname [string range $line [expr 4 + [string first " to " $line] ] end] - if {[string index $fname 0] eq "\""} { - set fname [lindex $fname 0] - } - makediffhdr $fname $ids - } elseif {[string compare -length 3 $line "---"] == 0} { - # do nothing - continue - } elseif {[string compare -length 3 $line "+++"] == 0} { - set diffinhdr 0 - continue - } - $ctext insert end "$line\n" filesep - - } else { - set x [string range $line 0 0] - if {$x == "-" || $x == "+"} { - set tag [expr {$x == "+"}] - $ctext insert end "$line\n" d$tag - } elseif {$x == " "} { - $ctext insert end "$line\n" - } else { - # "\ No newline at end of file", - # or something else we don't recognize - $ctext insert end "$line\n" hunksep - } - } - } - $ctext conf -state disabled - if {[eof $bdf]} { - close $bdf - return 0 - } - return [expr {$nr >= 1000? 2: 1}] -} - -proc changediffdisp {} { - global ctext diffelide - - $ctext tag conf d0 -elide [lindex $diffelide 0] - $ctext tag conf d1 -elide [lindex $diffelide 1] -} - -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 - } - } -} - -proc clear_ctext {{first 1.0}} { - global ctext smarktop smarkbot - global pendinglinks - - set l [lindex [split $first .] 0] - if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} { - set smarktop $l - } - if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} { - set smarkbot $l - } - $ctext delete $first end - if {$first eq "1.0"} { - catch {unset pendinglinks} - } -} - -proc settabs {{firstab {}}} { - global firsttabstop tabstop ctext have_tk85 - - if {$firstab ne {} && $have_tk85} { - set firsttabstop $firstab - } - set w [font measure textfont "0"] - if {$firsttabstop != 0} { - $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \ - [expr {($firsttabstop + 2 * $tabstop) * $w}]] - } elseif {$have_tk85 || $tabstop != 8} { - $ctext conf -tabs [expr {$tabstop * $w}] - } else { - $ctext conf -tabs {} - } -} - -proc incrsearch {name ix op} { - global ctext searchstring searchdirn - - $ctext tag remove found 1.0 end - if {[catch {$ctext index anchor}]} { - # no anchor set, use start of selection, or of visible area - set sel [$ctext tag ranges sel] - if {$sel ne {}} { - $ctext mark set anchor [lindex $sel 0] - } elseif {$searchdirn eq "-forwards"} { - $ctext mark set anchor @0,0 - } else { - $ctext mark set anchor @0,[winfo height $ctext] - } - } - if {$searchstring ne {}} { - set here [$ctext search $searchdirn -- $searchstring anchor] - if {$here ne {}} { - $ctext see $here - } - searchmarkvisible 1 - } -} - -proc dosearch {} { - global sstring ctext searchstring searchdirn - - focus $sstring - $sstring icursor end - set searchdirn -forwards - if {$searchstring ne {}} { - set sel [$ctext tag ranges sel] - if {$sel ne {}} { - set start "[lindex $sel 0] + 1c" - } elseif {[catch {set start [$ctext index anchor]}]} { - set start "@0,0" - } - set match [$ctext search -count mlen -- $searchstring $start] - $ctext tag remove sel 1.0 end - if {$match eq {}} { - bell - return - } - $ctext see $match - set mend "$match + $mlen c" - $ctext tag add sel $match $mend - $ctext mark unset anchor - } -} - -proc dosearchback {} { - global sstring ctext searchstring searchdirn - - focus $sstring - $sstring icursor end - set searchdirn -backwards - if {$searchstring ne {}} { - set sel [$ctext tag ranges sel] - if {$sel ne {}} { - set start [lindex $sel 0] - } elseif {[catch {set start [$ctext index anchor]}]} { - set start @0,[winfo height $ctext] - } - set match [$ctext search -backwards -count ml -- $searchstring $start] - $ctext tag remove sel 1.0 end - if {$match eq {}} { - bell - return - } - $ctext see $match - set mend "$match + $ml c" - $ctext tag add sel $match $mend - $ctext mark unset anchor - } -} - -proc searchmark {first last} { - global ctext searchstring - - set mend $first.0 - while {1} { - set match [$ctext search -count mlen -- $searchstring $mend $last.end] - if {$match eq {}} break - set mend "$match + $mlen c" - $ctext tag add found $match $mend - } -} - -proc searchmarkvisible {doall} { - global ctext smarktop smarkbot - - set topline [lindex [split [$ctext index @0,0] .] 0] - set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0] - if {$doall || $botline < $smarktop || $topline > $smarkbot} { - # no overlap with previous - searchmark $topline $botline - set smarktop $topline - set smarkbot $botline - } else { - if {$topline < $smarktop} { - searchmark $topline [expr {$smarktop-1}] - set smarktop $topline - } - if {$botline > $smarkbot} { - searchmark [expr {$smarkbot+1}] $botline - set smarkbot $botline - } - } -} - -proc scrolltext {f0 f1} { - global searchstring - - .bleft.sb set $f0 $f1 - if {$searchstring ne {}} { - searchmarkvisible 0 - } -} - -proc setcoords {} { - global linespc charspc canvx0 canvy0 - global xspc1 xspc2 lthickness - - set linespc [font metrics mainfont -linespace] - set charspc [font measure mainfont "m"] - set canvy0 [expr {int(3 + 0.5 * $linespc)}] - set canvx0 [expr {int(3 + 0.5 * $linespc)}] - set lthickness [expr {int($linespc / 9) + 1}] - set xspc1(0) $linespc - set xspc2 $linespc -} - -proc redisplay {} { - global canv - global selectedline - - set ymax [lindex [$canv cget -scrollregion] 3] - if {$ymax eq {} || $ymax == 0} return - set span [$canv yview] - clear_display - setcanvscroll - allcanvs yview moveto [lindex $span 0] - drawvisible - if {[info exists selectedline]} { - selectline $selectedline 0 - allcanvs yview moveto [lindex $span 0] - } -} - -proc parsefont {f n} { - global fontattr - - set fontattr($f,family) [lindex $n 0] - set s [lindex $n 1] - if {$s eq {} || $s == 0} { - set s 10 - } elseif {$s < 0} { - set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}] - } - set fontattr($f,size) $s - set fontattr($f,weight) normal - set fontattr($f,slant) roman - foreach style [lrange $n 2 end] { - switch -- $style { - "normal" - - "bold" {set fontattr($f,weight) $style} - "roman" - - "italic" {set fontattr($f,slant) $style} - } - } -} - -proc fontflags {f {isbold 0}} { - global fontattr - - return [list -family $fontattr($f,family) -size $fontattr($f,size) \ - -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \ - -slant $fontattr($f,slant)] -} - -proc fontname {f} { - global fontattr - - set n [list $fontattr($f,family) $fontattr($f,size)] - if {$fontattr($f,weight) eq "bold"} { - lappend n "bold" - } - if {$fontattr($f,slant) eq "italic"} { - lappend n "italic" - } - return $n -} - -proc incrfont {inc} { - global mainfont textfont ctext canv phase cflist showrefstop - global stopped entries fontattr - - unmarkmatches - set s $fontattr(mainfont,size) - incr s $inc - if {$s < 1} { - set s 1 - } - set fontattr(mainfont,size) $s - font config mainfont -size $s - font config mainfontbold -size $s - set mainfont [fontname mainfont] - set s $fontattr(textfont,size) - incr s $inc - if {$s < 1} { - set s 1 - } - set fontattr(textfont,size) $s - font config textfont -size $s - font config textfontbold -size $s - set textfont [fontname textfont] - setcoords - settabs - redisplay -} - -proc clearsha1 {} { - global sha1entry sha1string - if {[string length $sha1string] == 40} { - $sha1entry delete 0 end - } -} - -proc sha1change {n1 n2 op} { - global sha1string currentid sha1but - if {$sha1string == {} - || ([info exists currentid] && $sha1string == $currentid)} { - set state disabled - } else { - set state normal - } - if {[$sha1but cget -state] == $state} return - if {$state == "normal"} { - $sha1but conf -state normal -relief raised -text "Goto: " - } else { - $sha1but conf -state disabled -relief flat -text "SHA1 ID: " - } -} - -proc gotocommit {} { - global sha1string currentid commitrow tagids headids - global displayorder numcommits curview - - if {$sha1string == {} - || ([info exists currentid] && $sha1string == $currentid)} return - if {[info exists tagids($sha1string)]} { - set id $tagids($sha1string) - } elseif {[info exists headids($sha1string)]} { - set id $headids($sha1string) - } else { - set id [string tolower $sha1string] - if {[regexp {^[0-9a-f]{4,39}$} $id]} { - set matches {} - foreach i $displayorder { - if {[string match $id* $i]} { - lappend matches $i - } - } - if {$matches ne {}} { - if {[llength $matches] > 1} { - error_popup "Short SHA1 id $id is ambiguous" - return - } - set id [lindex $matches 0] - } - } - } - if {[info exists commitrow($curview,$id)]} { - selectline $commitrow($curview,$id) 1 - return - } - if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} { - set type "SHA1 id" - } else { - set type "Tag/Head" - } - error_popup "$type $sha1string is not known" -} - -proc lineenter {x y id} { - global hoverx hovery hoverid hovertimer - global commitinfo canv - - if {![info exists commitinfo($id)] && ![getcommit $id]} return - set hoverx $x - set hovery $y - set hoverid $id - if {[info exists hovertimer]} { - after cancel $hovertimer - } - set hovertimer [after 500 linehover] - $canv delete hover -} - -proc linemotion {x y id} { - global hoverx hovery hoverid hovertimer - - if {[info exists hoverid] && $id == $hoverid} { - set hoverx $x - set hovery $y - if {[info exists hovertimer]} { - after cancel $hovertimer - } - set hovertimer [after 500 linehover] - } -} - -proc lineleave {id} { - global hoverid hovertimer canv - - if {[info exists hoverid] && $id == $hoverid} { - $canv delete hover - if {[info exists hovertimer]} { - after cancel $hovertimer - unset hovertimer - } - unset hoverid - } -} - -proc linehover {} { - global hoverx hovery hoverid hovertimer - global canv linespc lthickness - global commitinfo - - set text [lindex $commitinfo($hoverid) 0] - set ymax [lindex [$canv cget -scrollregion] 3] - if {$ymax == {}} return - set yfrac [lindex [$canv yview] 0] - set x [expr {$hoverx + 2 * $linespc}] - set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}] - set x0 [expr {$x - 2 * $lthickness}] - set y0 [expr {$y - 2 * $lthickness}] - set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}] - set y1 [expr {$y + $linespc + 2 * $lthickness}] - 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] - $canv raise $t -} - -proc clickisonarrow {id y} { - global lthickness - - set ranges [rowranges $id] - set thresh [expr {2 * $lthickness + 6}] - set n [expr {[llength $ranges] - 1}] - for {set i 1} {$i < $n} {incr i} { - set row [lindex $ranges $i] - if {abs([yc $row] - $y) < $thresh} { - return $i - } - } - return {} -} - -proc arrowjump {id n y} { - global canv - - # 1 <-> 2, 3 <-> 4, etc... - set n [expr {(($n - 1) ^ 1) + 1}] - set row [lindex [rowranges $id] $n] - set yt [yc $row] - set ymax [lindex [$canv cget -scrollregion] 3] - if {$ymax eq {} || $ymax <= 0} return - set view [$canv yview] - set yspan [expr {[lindex $view 1] - [lindex $view 0]}] - set yfrac [expr {$yt / $ymax - $yspan / 2}] - if {$yfrac < 0} { - set yfrac 0 - } - allcanvs yview moveto $yfrac -} - -proc lineclick {x y id isnew} { - global ctext commitinfo children canv thickerline curview commitrow - - if {![info exists commitinfo($id)] && ![getcommit $id]} return - unmarkmatches - unselectline - normalline - $canv delete hover - # draw this line thicker than normal - set thickerline $id - drawlines $id - if {$isnew} { - set ymax [lindex [$canv cget -scrollregion] 3] - if {$ymax eq {}} return - set yfrac [lindex [$canv yview] 0] - set y [expr {$y + $yfrac * $ymax}] - } - set dirn [clickisonarrow $id $y] - if {$dirn ne {}} { - arrowjump $id $dirn $y - return - } - - if {$isnew} { - addtohistory [list lineclick $x $y $id 0] - } - # fill the details pane with info about this line - $ctext conf -state normal - clear_ctext - settabs 0 - $ctext insert end "Parent:\t" - $ctext insert end $id link0 - setlink $id link0 - set info $commitinfo($id) - $ctext insert end "\n\t[lindex $info 0]\n" - $ctext insert end "\tAuthor:\t[lindex $info 1]\n" - set date [formatdate [lindex $info 2]] - $ctext insert end "\tDate:\t$date\n" - set kids $children($curview,$id) - if {$kids ne {}} { - $ctext insert end "\nChildren:" - set i 0 - foreach child $kids { - incr i - if {![info exists commitinfo($child)] && ![getcommit $child]} continue - set info $commitinfo($child) - $ctext insert end "\n\t" - $ctext insert end $child link$i - setlink $child link$i - $ctext insert end "\n\t[lindex $info 0]" - $ctext insert end "\n\tAuthor:\t[lindex $info 1]" - set date [formatdate [lindex $info 2]] - $ctext insert end "\n\tDate:\t$date\n" - } - } - $ctext conf -state disabled - init_flist {} -} - -proc normalline {} { - global thickerline - if {[info exists thickerline]} { - set id $thickerline - unset thickerline - drawlines $id - } -} - -proc selbyid {id} { - global commitrow curview - if {[info exists commitrow($curview,$id)]} { - selectline $commitrow($curview,$id) 1 - } -} - -proc mstime {} { - global startmstime - if {![info exists startmstime]} { - set startmstime [clock clicks -milliseconds] - } - return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]] -} - -proc rowmenu {x y id} { - global rowctxmenu commitrow selectedline rowmenuid curview - global nullid nullid2 fakerowmenu mainhead - - stopfinding - set rowmenuid $id - if {![info exists selectedline] - || $commitrow($curview,$id) eq $selectedline} { - set state disabled - } else { - set state normal - } - if {$id ne $nullid && $id ne $nullid2} { - set menu $rowctxmenu - $menu entryconfigure 7 -label "Reset $mainhead branch to here" - } else { - set menu $fakerowmenu - } - $menu entryconfigure "Diff this*" -state $state - $menu entryconfigure "Diff selected*" -state $state - $menu entryconfigure "Make patch" -state $state - tk_popup $menu $x $y -} - -proc diffvssel {dirn} { - global rowmenuid selectedline displayorder - - if {![info exists selectedline]} return - if {$dirn} { - set oldid [lindex $displayorder $selectedline] - set newid $rowmenuid - } else { - set oldid $rowmenuid - set newid [lindex $displayorder $selectedline] - } - addtohistory [list doseldiff $oldid $newid] - doseldiff $oldid $newid -} - -proc doseldiff {oldid newid} { - global ctext - global commitinfo - - $ctext conf -state normal - clear_ctext - init_flist "Top" - $ctext insert end "From " - $ctext insert end $oldid link0 - setlink $oldid link0 - $ctext insert end "\n " - $ctext insert end [lindex $commitinfo($oldid) 0] - $ctext insert end "\n\nTo " - $ctext insert end $newid link1 - setlink $newid link1 - $ctext insert end "\n " - $ctext insert end [lindex $commitinfo($newid) 0] - $ctext insert end "\n" - $ctext conf -state disabled - $ctext tag remove found 1.0 end - startdiff [list $oldid $newid] -} - -proc mkpatch {} { - global rowmenuid currentid commitinfo patchtop patchnum - - if {![info exists currentid]} return - set oldid $currentid - set oldhead [lindex $commitinfo($oldid) 0] - set newid $rowmenuid - set newhead [lindex $commitinfo($newid) 0] - set top .patch - set patchtop $top - catch {destroy $top} - toplevel $top - label $top.title -text "Generate patch" - grid $top.title - -pady 10 - label $top.from -text "From:" - entry $top.fromsha1 -width 40 -relief flat - $top.fromsha1 insert 0 $oldid - $top.fromsha1 conf -state readonly - grid $top.from $top.fromsha1 -sticky w - entry $top.fromhead -width 60 -relief flat - $top.fromhead insert 0 $oldhead - $top.fromhead conf -state readonly - grid x $top.fromhead -sticky w - label $top.to -text "To:" - entry $top.tosha1 -width 40 -relief flat - $top.tosha1 insert 0 $newid - $top.tosha1 conf -state readonly - grid $top.to $top.tosha1 -sticky w - entry $top.tohead -width 60 -relief flat - $top.tohead insert 0 $newhead - $top.tohead conf -state readonly - grid x $top.tohead -sticky w - button $top.rev -text "Reverse" -command mkpatchrev -padx 5 - grid $top.rev x -pady 10 - label $top.flab -text "Output file:" - entry $top.fname -width 60 - $top.fname insert 0 [file normalize "patch$patchnum.patch"] - incr patchnum - grid $top.flab $top.fname -sticky w - frame $top.buts - button $top.buts.gen -text "Generate" -command mkpatchgo - button $top.buts.can -text "Cancel" -command mkpatchcan - grid $top.buts.gen $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.fname -} - -proc mkpatchrev {} { - global patchtop - - set oldid [$patchtop.fromsha1 get] - set oldhead [$patchtop.fromhead get] - set newid [$patchtop.tosha1 get] - set newhead [$patchtop.tohead get] - foreach e [list fromsha1 fromhead tosha1 tohead] \ - v [list $newid $newhead $oldid $oldhead] { - $patchtop.$e conf -state normal - $patchtop.$e delete 0 end - $patchtop.$e insert 0 $v - $patchtop.$e conf -state readonly - } -} - -proc mkpatchgo {} { - global patchtop nullid nullid2 - - set oldid [$patchtop.fromsha1 get] - set newid [$patchtop.tosha1 get] - set fname [$patchtop.fname get] - set cmd [diffcmd [list $oldid $newid] -p] - # trim off the initial "|" - set cmd [lrange $cmd 1 end] - lappend cmd >$fname & - if {[catch {eval exec $cmd} err]} { - error_popup "Error creating patch: $err" - } - catch {destroy $patchtop} - unset patchtop -} - -proc mkpatchcan {} { - global patchtop - - catch {destroy $patchtop} - unset patchtop -} - -proc mktag {} { - global rowmenuid mktagtop commitinfo - - set top .maketag - set mktagtop $top - catch {destroy $top} - toplevel $top - label $top.title -text "Create tag" - 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 - entry $top.head -width 60 -relief flat - $top.head insert 0 [lindex $commitinfo($rowmenuid) 0] - $top.head conf -state readonly - grid x $top.head -sticky w - label $top.tlab -text "Tag name:" - entry $top.tag -width 60 - grid $top.tlab $top.tag -sticky w - frame $top.buts - button $top.buts.gen -text "Create" -command mktaggo - button $top.buts.can -text "Cancel" -command mktagcan - grid $top.buts.gen $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.tag -} - -proc domktag {} { - global mktagtop env tagids idtags - - set id [$mktagtop.sha1 get] - set tag [$mktagtop.tag get] - if {$tag == {}} { - error_popup "No tag name specified" - return - } - if {[info exists tagids($tag)]} { - error_popup "Tag \"$tag\" already exists" - return - } - if {[catch { - set dir [gitdir] - set fname [file join $dir "refs/tags" $tag] - set f [open $fname w] - puts $f $id - close $f - } err]} { - error_popup "Error creating tag: $err" - return - } - - set tagids($tag) $id - lappend idtags($id) $tag - redrawtags $id - addedtag $id - dispneartags 0 - run refill_reflist -} - -proc redrawtags {id} { - global canv linehtag commitrow idpos selectedline curview - global canvxmax iddrawn - - if {![info exists commitrow($curview,$id)]} return - if {![info exists iddrawn($id)]} return - drawcommits $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 - } -} - -proc mktagcan {} { - global mktagtop - - catch {destroy $mktagtop} - unset mktagtop -} - -proc mktaggo {} { - domktag - mktagcan -} - -proc writecommit {} { - global rowmenuid wrcomtop commitinfo wrcomcmd - - set top .writecommit - set wrcomtop $top - catch {destroy $top} - toplevel $top - label $top.title -text "Write commit to file" - 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 - entry $top.head -width 60 -relief flat - $top.head insert 0 [lindex $commitinfo($rowmenuid) 0] - $top.head conf -state readonly - grid x $top.head -sticky w - label $top.clab -text "Command:" - entry $top.cmd -width 60 -textvariable wrcomcmd - grid $top.clab $top.cmd -sticky w -pady 10 - label $top.flab -text "Output file:" - entry $top.fname -width 60 - $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"] - grid $top.flab $top.fname -sticky w - frame $top.buts - button $top.buts.gen -text "Write" -command wrcomgo - button $top.buts.can -text "Cancel" -command wrcomcan - grid $top.buts.gen $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.fname -} - -proc wrcomgo {} { - global wrcomtop - - set id [$wrcomtop.sha1 get] - set cmd "echo $id | [$wrcomtop.cmd get]" - set fname [$wrcomtop.fname get] - if {[catch {exec sh -c $cmd >$fname &} err]} { - error_popup "Error writing commit: $err" - } - catch {destroy $wrcomtop} - unset wrcomtop -} - -proc wrcomcan {} { - global wrcomtop - - catch {destroy $wrcomtop} - 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 - lappend idheads($id) $name - addedhead $id $name - notbusy newbranch - redrawtags $id - dispneartags 0 - run refill_reflist - } -} - -proc cherrypick {} { - global rowmenuid curview commitrow - global mainhead - - set oldhead [exec git rev-parse HEAD] - set dheads [descheads $rowmenuid] - if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 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 "Cherry-picking" - update - # 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 - } - addnewchild $newhead $oldhead - if {[info exists commitrow($curview,$oldhead)]} { - insertrow $commitrow($curview,$oldhead) $newhead - if {$mainhead ne {}} { - movehead $newhead $mainhead - movedhead $newhead $mainhead - } - redrawtags $oldhead - redrawtags $newhead - } - notbusy cherrypick -} - -proc resethead {} { - global mainheadid mainhead rowmenuid confirm_ok resettype - - set confirm_ok 0 - set w ".confirmreset" - toplevel $w - wm transient $w . - wm title $w "Confirm reset" - message $w.m -text \ - "Reset branch $mainhead to [string range $rowmenuid 0 7]?" \ - -justify center -aspect 1000 - pack $w.m -side top -fill x -padx 20 -pady 20 - frame $w.f -relief sunken -border 2 - message $w.f.rt -text "Reset type:" -aspect 1000 - grid $w.f.rt -sticky w - set resettype mixed - radiobutton $w.f.soft -value soft -variable resettype -justify left \ - -text "Soft: Leave working tree and index untouched" - grid $w.f.soft -sticky w - radiobutton $w.f.mixed -value mixed -variable resettype -justify left \ - -text "Mixed: Leave working tree untouched, reset index" - grid $w.f.mixed -sticky w - radiobutton $w.f.hard -value hard -variable resettype -justify left \ - -text "Hard: Reset working tree and index\n(discard ALL local changes)" - grid $w.f.hard -sticky w - pack $w.f -side top -fill x - button $w.ok -text OK -command "set confirm_ok 1; destroy $w" - pack $w.ok -side left -fill x -padx 20 -pady 20 - button $w.cancel -text Cancel -command "destroy $w" - pack $w.cancel -side right -fill x -padx 20 -pady 20 - bind $w "grab $w; focus $w" - tkwait window $w - if {!$confirm_ok} return - if {[catch {set fd [open \ - [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} { - error_popup $err - } else { - dohidelocalchanges - filerun $fd [list readresetstat $fd] - nowbusy reset "Resetting" - } -} - -proc readresetstat {fd} { - global mainhead mainheadid showlocalchanges rprogcoord - - if {[gets $fd line] >= 0} { - if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} { - set rprogcoord [expr {1.0 * $m / $n}] - adjustprogress - } - return 1 - } - set rprogcoord 0 - adjustprogress - notbusy reset - if {[catch {close $fd} err]} { - error_popup $err - } - set oldhead $mainheadid - set newhead [exec git rev-parse HEAD] - if {$newhead ne $oldhead} { - movehead $newhead $mainhead - movedhead $newhead $mainhead - set mainheadid $newhead - redrawtags $oldhead - redrawtags $newhead - } - if {$showlocalchanges} { - doshowlocalchanges - } - return 0 -} - -# context menu for a head -proc headmenu {x y id head} { - global headmenuid headmenuhead headctxmenu mainhead - - stopfinding - set headmenuid $id - set headmenuhead $head - set state normal - if {$head eq $mainhead} { - set state disabled - } - $headctxmenu entryconfigure 0 -state $state - $headctxmenu entryconfigure 1 -state $state - tk_popup $headctxmenu $x $y -} - -proc cobranch {} { - global headmenuid headmenuhead mainhead headids - global showlocalchanges mainheadid - - # check the tree is clean first?? - set oldmainhead $mainhead - nowbusy checkout "Checking out" - update - dohidelocalchanges - if {[catch { - exec git checkout -q $headmenuhead - } err]} { - notbusy checkout - error_popup $err - } else { - notbusy checkout - set mainhead $headmenuhead - set mainheadid $headmenuid - if {[info exists headids($oldmainhead)]} { - redrawtags $headids($oldmainhead) - } - redrawtags $headmenuid - } - if {$showlocalchanges} { - dodiffindex - } -} - -proc rmbranch {} { - global headmenuid headmenuhead mainhead - global idheads - - set head $headmenuhead - set id $headmenuid - # this check shouldn't be needed any more... - if {$head eq $mainhead} { - error_popup "Cannot delete the currently checked-out branch" - return - } - set dheads [descheads $id] - if {[llength $dheads] == 1 && $idheads($dheads) 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 - } - removehead $id $head - removedhead $id $head - redrawtags $id - notbusy rmbranch - dispneartags 0 - run refill_reflist -} - -# Display a list of tags and heads -proc showrefs {} { - global showrefstop bgcolor fgcolor selectbgcolor - global bglist fglist reflistfilter reflist maincursor - - set top .showrefs - set showrefstop $top - if {[winfo exists $top]} { - raise $top - refill_reflist - return - } - toplevel $top - wm title $top "Tags and heads: [file tail [pwd]]" - text $top.list -background $bgcolor -foreground $fgcolor \ - -selectbackground $selectbgcolor -font mainfont \ - -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \ - -width 30 -height 20 -cursor $maincursor \ - -spacing1 1 -spacing3 1 -state disabled - $top.list tag configure highlight -background $selectbgcolor - lappend bglist $top.list - lappend fglist $top.list - scrollbar $top.ysb -command "$top.list yview" -orient vertical - scrollbar $top.xsb -command "$top.list xview" -orient horizontal - grid $top.list $top.ysb -sticky nsew - grid $top.xsb x -sticky ew - frame $top.f - label $top.f.l -text "Filter: " -font uifont - entry $top.f.e -width 20 -textvariable reflistfilter -font uifont - set reflistfilter "*" - trace add variable reflistfilter write reflistfilter_change - pack $top.f.e -side right -fill x -expand 1 - pack $top.f.l -side left - grid $top.f - -sticky ew -pady 2 - button $top.close -command [list destroy $top] -text "Close" \ - -font uifont - grid $top.close - - grid columnconfigure $top 0 -weight 1 - grid rowconfigure $top 0 -weight 1 - bind $top.list <1> {break} - bind $top.list {break} - bind $top.list {sel_reflist %W %x %y; break} - set reflist {} - refill_reflist -} - -proc sel_reflist {w x y} { - global showrefstop reflist headids tagids otherrefids - - if {![winfo exists $showrefstop]} return - set l [lindex [split [$w index "@$x,$y"] "."] 0] - set ref [lindex $reflist [expr {$l-1}]] - set n [lindex $ref 0] - switch -- [lindex $ref 1] { - "H" {selbyid $headids($n)} - "T" {selbyid $tagids($n)} - "o" {selbyid $otherrefids($n)} - } - $showrefstop.list tag add highlight $l.0 "$l.0 lineend" -} - -proc unsel_reflist {} { - global showrefstop - - if {![info exists showrefstop] || ![winfo exists $showrefstop]} return - $showrefstop.list tag remove highlight 0.0 end -} - -proc reflistfilter_change {n1 n2 op} { - global reflistfilter - - after cancel refill_reflist - after 200 refill_reflist -} - -proc refill_reflist {} { - global reflist reflistfilter showrefstop headids tagids otherrefids - global commitrow curview commitinterest - - if {![info exists showrefstop] || ![winfo exists $showrefstop]} return - set refs {} - foreach n [array names headids] { - if {[string match $reflistfilter $n]} { - if {[info exists commitrow($curview,$headids($n))]} { - lappend refs [list $n H] - } else { - set commitinterest($headids($n)) {run refill_reflist} - } - } - } - foreach n [array names tagids] { - if {[string match $reflistfilter $n]} { - if {[info exists commitrow($curview,$tagids($n))]} { - lappend refs [list $n T] - } else { - set commitinterest($tagids($n)) {run refill_reflist} - } - } - } - foreach n [array names otherrefids] { - if {[string match $reflistfilter $n]} { - if {[info exists commitrow($curview,$otherrefids($n))]} { - lappend refs [list $n o] - } else { - set commitinterest($otherrefids($n)) {run refill_reflist} - } - } - } - set refs [lsort -index 0 $refs] - if {$refs eq $reflist} return - - # Update the contents of $showrefstop.list according to the - # differences between $reflist (old) and $refs (new) - $showrefstop.list conf -state normal - $showrefstop.list insert end "\n" - set i 0 - set j 0 - while {$i < [llength $reflist] || $j < [llength $refs]} { - if {$i < [llength $reflist]} { - if {$j < [llength $refs]} { - set cmp [string compare [lindex $reflist $i 0] \ - [lindex $refs $j 0]] - if {$cmp == 0} { - set cmp [string compare [lindex $reflist $i 1] \ - [lindex $refs $j 1]] - } - } else { - set cmp -1 - } - } else { - set cmp 1 - } - switch -- $cmp { - -1 { - $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0" - incr i - } - 0 { - incr i - incr j - } - 1 { - set l [expr {$j + 1}] - $showrefstop.list image create $l.0 -align baseline \ - -image reficon-[lindex $refs $j 1] -padx 2 - $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n" - incr j - } - } - } - set reflist $refs - # delete last newline - $showrefstop.list delete end-2c end-1c - $showrefstop.list conf -state disabled -} - -# Stuff for finding nearby tags -proc getallcommits {} { - global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate - global idheads idtags idotherrefs allparents tagobjid - - if {![info exists allcommits]} { - set nextarc 0 - set allcommits 0 - set seeds {} - set allcwait 0 - set cachedarcs 0 - set allccache [file join [gitdir] "gitk.cache"] - if {![catch { - set f [open $allccache r] - set allcwait 1 - getcache $f - }]} return - } - - if {$allcwait} { - return - } - set cmd [list | git rev-list --parents] - set allcupdate [expr {$seeds ne {}}] - if {!$allcupdate} { - set ids "--all" - } else { - set refs [concat [array names idheads] [array names idtags] \ - [array names idotherrefs]] - set ids {} - set tagobjs {} - foreach name [array names tagobjid] { - lappend tagobjs $tagobjid($name) - } - foreach id [lsort -unique $refs] { - if {![info exists allparents($id)] && - [lsearch -exact $tagobjs $id] < 0} { - lappend ids $id - } - } - if {$ids ne {}} { - foreach id $seeds { - lappend ids "^$id" - } - } - } - if {$ids ne {}} { - set fd [open [concat $cmd $ids] r] - fconfigure $fd -blocking 0 - incr allcommits - nowbusy allcommits - filerun $fd [list getallclines $fd] - } else { - dispneartags 0 - } -} - -# Since most commits have 1 parent and 1 child, we group strings of -# such commits into "arcs" joining branch/merge points (BMPs), which -# are commits that either don't have 1 parent or don't have 1 child. -# -# arcnos(id) - incoming arcs for BMP, arc we're on for other nodes -# arcout(id) - outgoing arcs for BMP -# arcids(a) - list of IDs on arc including end but not start -# arcstart(a) - BMP ID at start of arc -# arcend(a) - BMP ID at end of arc -# growing(a) - arc a is still growing -# arctags(a) - IDs out of arcids (excluding end) that have tags -# archeads(a) - IDs out of arcids (excluding end) that have heads -# The start of an arc is at the descendent end, so "incoming" means -# coming from descendents, and "outgoing" means going towards ancestors. - -proc getallclines {fd} { - global allparents allchildren idtags idheads nextarc - global arcnos arcids arctags arcout arcend arcstart archeads growing - global seeds allcommits cachedarcs allcupdate - - set nid 0 - while {[incr nid] <= 1000 && [gets $fd line] >= 0} { - set id [lindex $line 0] - if {[info exists allparents($id)]} { - # seen it already - continue - } - set cachedarcs 0 - set olds [lrange $line 1 end] - set allparents($id) $olds - if {![info exists allchildren($id)]} { - set allchildren($id) {} - set arcnos($id) {} - lappend seeds $id - } else { - set a $arcnos($id) - if {[llength $olds] == 1 && [llength $a] == 1} { - lappend arcids($a) $id - if {[info exists idtags($id)]} { - lappend arctags($a) $id - } - if {[info exists idheads($id)]} { - lappend archeads($a) $id - } - if {[info exists allparents($olds)]} { - # seen parent already - if {![info exists arcout($olds)]} { - splitarc $olds - } - lappend arcids($a) $olds - set arcend($a) $olds - unset growing($a) - } - lappend allchildren($olds) $id - lappend arcnos($olds) $a - continue - } - } - foreach a $arcnos($id) { - lappend arcids($a) $id - set arcend($a) $id - unset growing($a) - } - - set ao {} - foreach p $olds { - lappend allchildren($p) $id - set a [incr nextarc] - set arcstart($a) $id - set archeads($a) {} - set arctags($a) {} - set archeads($a) {} - set arcids($a) {} - lappend ao $a - set growing($a) 1 - if {[info exists allparents($p)]} { - # seen it already, may need to make a new branch - if {![info exists arcout($p)]} { - splitarc $p - } - lappend arcids($a) $p - set arcend($a) $p - unset growing($a) - } - lappend arcnos($p) $a - } - set arcout($id) $ao - } - if {$nid > 0} { - global cached_dheads cached_dtags cached_atags - catch {unset cached_dheads} - catch {unset cached_dtags} - catch {unset cached_atags} - } - if {![eof $fd]} { - return [expr {$nid >= 1000? 2: 1}] - } - set cacheok 1 - if {[catch { - fconfigure $fd -blocking 1 - close $fd - } err]} { - # got an error reading the list of commits - # if we were updating, try rereading the whole thing again - if {$allcupdate} { - incr allcommits -1 - dropcache $err - return - } - error_popup "Error reading commit topology information;\ - branch and preceding/following tag information\ - will be incomplete.\n($err)" - set cacheok 0 - } - if {[incr allcommits -1] == 0} { - notbusy allcommits - if {$cacheok} { - run savecache - } - } - dispneartags 0 - return 0 -} - -proc recalcarc {a} { - global arctags archeads arcids idtags idheads - - set at {} - set ah {} - foreach id [lrange $arcids($a) 0 end-1] { - if {[info exists idtags($id)]} { - lappend at $id - } - if {[info exists idheads($id)]} { - lappend ah $id - } - } - set arctags($a) $at - set archeads($a) $ah -} - -proc splitarc {p} { - global arcnos arcids nextarc arctags archeads idtags idheads - global arcstart arcend arcout allparents growing - - set a $arcnos($p) - if {[llength $a] != 1} { - puts "oops splitarc called but [llength $a] arcs already" - return - } - set a [lindex $a 0] - set i [lsearch -exact $arcids($a) $p] - if {$i < 0} { - puts "oops splitarc $p not in arc $a" - return - } - set na [incr nextarc] - if {[info exists arcend($a)]} { - set arcend($na) $arcend($a) - } else { - set l [lindex $allparents([lindex $arcids($a) end]) 0] - set j [lsearch -exact $arcnos($l) $a] - set arcnos($l) [lreplace $arcnos($l) $j $j $na] - } - set tail [lrange $arcids($a) [expr {$i+1}] end] - set arcids($a) [lrange $arcids($a) 0 $i] - set arcend($a) $p - set arcstart($na) $p - set arcout($p) $na - set arcids($na) $tail - if {[info exists growing($a)]} { - set growing($na) 1 - unset growing($a) - } - - foreach id $tail { - if {[llength $arcnos($id)] == 1} { - set arcnos($id) $na - } else { - set j [lsearch -exact $arcnos($id) $a] - set arcnos($id) [lreplace $arcnos($id) $j $j $na] - } - } - - # reconstruct tags and heads lists - if {$arctags($a) ne {} || $archeads($a) ne {}} { - recalcarc $a - recalcarc $na - } else { - set arctags($na) {} - set archeads($na) {} - } -} - -# Update things for a new commit added that is a child of one -# existing commit. Used when cherry-picking. -proc addnewchild {id p} { - global allparents allchildren idtags nextarc - global arcnos arcids arctags arcout arcend arcstart archeads growing - global seeds allcommits - - if {![info exists allcommits] || ![info exists arcnos($p)]} return - set allparents($id) [list $p] - set allchildren($id) {} - set arcnos($id) {} - lappend seeds $id - lappend allchildren($p) $id - set a [incr nextarc] - set arcstart($a) $id - set archeads($a) {} - set arctags($a) {} - set arcids($a) [list $p] - set arcend($a) $p - if {![info exists arcout($p)]} { - splitarc $p - } - lappend arcnos($p) $a - set arcout($id) [list $a] -} - -# This implements a cache for the topology information. -# The cache saves, for each arc, the start and end of the arc, -# the ids on the arc, and the outgoing arcs from the end. -proc readcache {f} { - global arcnos arcids arcout arcstart arcend arctags archeads nextarc - global idtags idheads allparents cachedarcs possible_seeds seeds growing - global allcwait - - set a $nextarc - set lim $cachedarcs - if {$lim - $a > 500} { - set lim [expr {$a + 500}] - } - if {[catch { - if {$a == $lim} { - # finish reading the cache and setting up arctags, etc. - set line [gets $f] - if {$line ne "1"} {error "bad final version"} - close $f - foreach id [array names idtags] { - if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 && - [llength $allparents($id)] == 1} { - set a [lindex $arcnos($id) 0] - if {$arctags($a) eq {}} { - recalcarc $a - } - } - } - foreach id [array names idheads] { - if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 && - [llength $allparents($id)] == 1} { - set a [lindex $arcnos($id) 0] - if {$archeads($a) eq {}} { - recalcarc $a - } - } - } - foreach id [lsort -unique $possible_seeds] { - if {$arcnos($id) eq {}} { - lappend seeds $id - } - } - set allcwait 0 - } else { - while {[incr a] <= $lim} { - set line [gets $f] - if {[llength $line] != 3} {error "bad line"} - set s [lindex $line 0] - set arcstart($a) $s - lappend arcout($s) $a - if {![info exists arcnos($s)]} { - lappend possible_seeds $s - set arcnos($s) {} - } - set e [lindex $line 1] - if {$e eq {}} { - set growing($a) 1 - } else { - set arcend($a) $e - if {![info exists arcout($e)]} { - set arcout($e) {} - } - } - set arcids($a) [lindex $line 2] - foreach id $arcids($a) { - lappend allparents($s) $id - set s $id - lappend arcnos($id) $a - } - if {![info exists allparents($s)]} { - set allparents($s) {} - } - set arctags($a) {} - set archeads($a) {} - } - set nextarc [expr {$a - 1}] - } - } err]} { - dropcache $err - return 0 - } - if {!$allcwait} { - getallcommits - } - return $allcwait -} - -proc getcache {f} { - global nextarc cachedarcs possible_seeds - - if {[catch { - set line [gets $f] - if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"} - # make sure it's an integer - set cachedarcs [expr {int([lindex $line 1])}] - if {$cachedarcs < 0} {error "bad number of arcs"} - set nextarc 0 - set possible_seeds {} - run readcache $f - } err]} { - dropcache $err - } - return 0 -} - -proc dropcache {err} { - global allcwait nextarc cachedarcs seeds - - #puts "dropping cache ($err)" - foreach v {arcnos arcout arcids arcstart arcend growing \ - arctags archeads allparents allchildren} { - global $v - catch {unset $v} - } - set allcwait 0 - set nextarc 0 - set cachedarcs 0 - set seeds {} - getallcommits -} - -proc writecache {f} { - global cachearc cachedarcs allccache - global arcstart arcend arcnos arcids arcout - - set a $cachearc - set lim $cachedarcs - if {$lim - $a > 1000} { - set lim [expr {$a + 1000}] - } - if {[catch { - while {[incr a] <= $lim} { - if {[info exists arcend($a)]} { - puts $f [list $arcstart($a) $arcend($a) $arcids($a)] - } else { - puts $f [list $arcstart($a) {} $arcids($a)] - } - } - } err]} { - catch {close $f} - catch {file delete $allccache} - #puts "writing cache failed ($err)" - return 0 - } - set cachearc [expr {$a - 1}] - if {$a > $cachedarcs} { - puts $f "1" - close $f - return 0 - } - return 1 -} - -proc savecache {} { - global nextarc cachedarcs cachearc allccache - - if {$nextarc == $cachedarcs} return - set cachearc 0 - set cachedarcs $nextarc - catch { - set f [open $allccache w] - puts $f [list 1 $cachedarcs] - run writecache $f - } -} - -# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a, -# or 0 if neither is true. -proc anc_or_desc {a b} { - global arcout arcstart arcend arcnos cached_isanc - - if {$arcnos($a) eq $arcnos($b)} { - # Both are on the same arc(s); either both are the same BMP, - # or if one is not a BMP, the other is also not a BMP or is - # the BMP at end of the arc (and it only has 1 incoming arc). - # Or both can be BMPs with no incoming arcs. - if {$a eq $b || $arcnos($a) eq {}} { - return 0 - } - # assert {[llength $arcnos($a)] == 1} - set arc [lindex $arcnos($a) 0] - set i [lsearch -exact $arcids($arc) $a] - set j [lsearch -exact $arcids($arc) $b] - if {$i < 0 || $i > $j} { - return 1 - } else { - return -1 - } - } - - if {![info exists arcout($a)]} { - set arc [lindex $arcnos($a) 0] - if {[info exists arcend($arc)]} { - set aend $arcend($arc) - } else { - set aend {} - } - set a $arcstart($arc) - } else { - set aend $a - } - if {![info exists arcout($b)]} { - set arc [lindex $arcnos($b) 0] - if {[info exists arcend($arc)]} { - set bend $arcend($arc) - } else { - set bend {} - } - set b $arcstart($arc) - } else { - set bend $b - } - if {$a eq $bend} { - return 1 - } - if {$b eq $aend} { - return -1 - } - if {[info exists cached_isanc($a,$bend)]} { - if {$cached_isanc($a,$bend)} { - return 1 - } - } - if {[info exists cached_isanc($b,$aend)]} { - if {$cached_isanc($b,$aend)} { - return -1 - } - if {[info exists cached_isanc($a,$bend)]} { - return 0 - } - } - - set todo [list $a $b] - set anc($a) a - set anc($b) b - for {set i 0} {$i < [llength $todo]} {incr i} { - set x [lindex $todo $i] - if {$anc($x) eq {}} { - continue - } - foreach arc $arcnos($x) { - set xd $arcstart($arc) - if {$xd eq $bend} { - set cached_isanc($a,$bend) 1 - set cached_isanc($b,$aend) 0 - return 1 - } elseif {$xd eq $aend} { - set cached_isanc($b,$aend) 1 - set cached_isanc($a,$bend) 0 - return -1 - } - if {![info exists anc($xd)]} { - set anc($xd) $anc($x) - lappend todo $xd - } elseif {$anc($xd) ne $anc($x)} { - set anc($xd) {} - } - } - } - set cached_isanc($a,$bend) 0 - set cached_isanc($b,$aend) 0 - return 0 -} - -# This identifies whether $desc has an ancestor that is -# a growing tip of the graph and which is not an ancestor of $anc -# and returns 0 if so and 1 if not. -# If we subsequently discover a tag on such a growing tip, and that -# turns out to be a descendent of $anc (which it could, since we -# don't necessarily see children before parents), then $desc -# isn't a good choice to display as a descendent tag of -# $anc (since it is the descendent of another tag which is -# a descendent of $anc). Similarly, $anc isn't a good choice to -# display as a ancestor tag of $desc. -# -proc is_certain {desc anc} { - global arcnos arcout arcstart arcend growing problems - - set certain {} - if {[llength $arcnos($anc)] == 1} { - # tags on the same arc are certain - if {$arcnos($desc) eq $arcnos($anc)} { - return 1 - } - if {![info exists arcout($anc)]} { - # if $anc is partway along an arc, use the start of the arc instead - set a [lindex $arcnos($anc) 0] - set anc $arcstart($a) - } - } - if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} { - set x $desc - } else { - set a [lindex $arcnos($desc) 0] - set x $arcend($a) - } - if {$x == $anc} { - return 1 - } - set anclist [list $x] - set dl($x) 1 - set nnh 1 - set ngrowanc 0 - for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} { - set x [lindex $anclist $i] - if {$dl($x)} { - incr nnh -1 - } - set done($x) 1 - foreach a $arcout($x) { - if {[info exists growing($a)]} { - if {![info exists growanc($x)] && $dl($x)} { - set growanc($x) 1 - incr ngrowanc - } - } else { - set y $arcend($a) - if {[info exists dl($y)]} { - if {$dl($y)} { - if {!$dl($x)} { - set dl($y) 0 - if {![info exists done($y)]} { - incr nnh -1 - } - if {[info exists growanc($x)]} { - incr ngrowanc -1 - } - set xl [list $y] - for {set k 0} {$k < [llength $xl]} {incr k} { - set z [lindex $xl $k] - foreach c $arcout($z) { - if {[info exists arcend($c)]} { - set v $arcend($c) - if {[info exists dl($v)] && $dl($v)} { - set dl($v) 0 - if {![info exists done($v)]} { - incr nnh -1 - } - if {[info exists growanc($v)]} { - incr ngrowanc -1 - } - lappend xl $v - } - } - } - } - } - } - } elseif {$y eq $anc || !$dl($x)} { - set dl($y) 0 - lappend anclist $y - } else { - set dl($y) 1 - lappend anclist $y - incr nnh - } - } - } - } - foreach x [array names growanc] { - if {$dl($x)} { - return 0 - } - return 0 - } - return 1 -} - -proc validate_arctags {a} { - global arctags idtags - - set i -1 - set na $arctags($a) - foreach id $arctags($a) { - incr i - if {![info exists idtags($id)]} { - set na [lreplace $na $i $i] - incr i -1 - } - } - set arctags($a) $na -} - -proc validate_archeads {a} { - global archeads idheads - - set i -1 - set na $archeads($a) - foreach id $archeads($a) { - incr i - if {![info exists idheads($id)]} { - set na [lreplace $na $i $i] - incr i -1 - } - } - set archeads($a) $na -} - -# Return the list of IDs that have tags that are descendents of id, -# ignoring IDs that are descendents of IDs already reported. -proc desctags {id} { - global arcnos arcstart arcids arctags idtags allparents - global growing cached_dtags - - if {![info exists allparents($id)]} { - return {} - } - set t1 [clock clicks -milliseconds] - set argid $id - if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} { - # part-way along an arc; check that arc first - set a [lindex $arcnos($id) 0] - if {$arctags($a) ne {}} { - validate_arctags $a - set i [lsearch -exact $arcids($a) $id] - set tid {} - foreach t $arctags($a) { - set j [lsearch -exact $arcids($a) $t] - if {$j >= $i} break - set tid $t - } - if {$tid ne {}} { - return $tid - } - } - set id $arcstart($a) - if {[info exists idtags($id)]} { - return $id - } - } - if {[info exists cached_dtags($id)]} { - return $cached_dtags($id) - } - - set origid $id - set todo [list $id] - set queued($id) 1 - set nc 1 - for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} { - set id [lindex $todo $i] - set done($id) 1 - set ta [info exists hastaggedancestor($id)] - if {!$ta} { - incr nc -1 - } - # ignore tags on starting node - if {!$ta && $i > 0} { - if {[info exists idtags($id)]} { - set tagloc($id) $id - set ta 1 - } elseif {[info exists cached_dtags($id)]} { - set tagloc($id) $cached_dtags($id) - set ta 1 - } - } - foreach a $arcnos($id) { - set d $arcstart($a) - if {!$ta && $arctags($a) ne {}} { - validate_arctags $a - if {$arctags($a) ne {}} { - lappend tagloc($id) [lindex $arctags($a) end] - } - } - if {$ta || $arctags($a) ne {}} { - set tomark [list $d] - for {set j 0} {$j < [llength $tomark]} {incr j} { - set dd [lindex $tomark $j] - if {![info exists hastaggedancestor($dd)]} { - if {[info exists done($dd)]} { - foreach b $arcnos($dd) { - lappend tomark $arcstart($b) - } - if {[info exists tagloc($dd)]} { - unset tagloc($dd) - } - } elseif {[info exists queued($dd)]} { - incr nc -1 - } - set hastaggedancestor($dd) 1 - } - } - } - if {![info exists queued($d)]} { - lappend todo $d - set queued($d) 1 - if {![info exists hastaggedancestor($d)]} { - incr nc - } - } - } - } - set tags {} - foreach id [array names tagloc] { - if {![info exists hastaggedancestor($id)]} { - foreach t $tagloc($id) { - if {[lsearch -exact $tags $t] < 0} { - lappend tags $t - } - } - } - } - set t2 [clock clicks -milliseconds] - set loopix $i - - # remove tags that are descendents of other tags - for {set i 0} {$i < [llength $tags]} {incr i} { - set a [lindex $tags $i] - for {set j 0} {$j < $i} {incr j} { - set b [lindex $tags $j] - set r [anc_or_desc $a $b] - if {$r == 1} { - set tags [lreplace $tags $j $j] - incr j -1 - incr i -1 - } elseif {$r == -1} { - set tags [lreplace $tags $i $i] - incr i -1 - break - } - } - } - - if {[array names growing] ne {}} { - # graph isn't finished, need to check if any tag could get - # eclipsed by another tag coming later. Simply ignore any - # tags that could later get eclipsed. - set ctags {} - foreach t $tags { - if {[is_certain $t $origid]} { - lappend ctags $t - } - } - if {$tags eq $ctags} { - set cached_dtags($origid) $tags - } else { - set tags $ctags - } - } else { - set cached_dtags($origid) $tags - } - set t3 [clock clicks -milliseconds] - if {0 && $t3 - $t1 >= 100} { - puts "iterating descendents ($loopix/[llength $todo] nodes) took\ - [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left" - } - return $tags -} - -proc anctags {id} { - global arcnos arcids arcout arcend arctags idtags allparents - global growing cached_atags - - if {![info exists allparents($id)]} { - return {} - } - set t1 [clock clicks -milliseconds] - set argid $id - if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} { - # part-way along an arc; check that arc first - set a [lindex $arcnos($id) 0] - if {$arctags($a) ne {}} { - validate_arctags $a - set i [lsearch -exact $arcids($a) $id] - foreach t $arctags($a) { - set j [lsearch -exact $arcids($a) $t] - if {$j > $i} { - return $t - } - } - } - if {![info exists arcend($a)]} { - return {} - } - set id $arcend($a) - if {[info exists idtags($id)]} { - return $id - } - } - if {[info exists cached_atags($id)]} { - return $cached_atags($id) - } - - set origid $id - set todo [list $id] - set queued($id) 1 - set taglist {} - set nc 1 - for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} { - set id [lindex $todo $i] - set done($id) 1 - set td [info exists hastaggeddescendent($id)] - if {!$td} { - incr nc -1 - } - # ignore tags on starting node - if {!$td && $i > 0} { - if {[info exists idtags($id)]} { - set tagloc($id) $id - set td 1 - } elseif {[info exists cached_atags($id)]} { - set tagloc($id) $cached_atags($id) - set td 1 - } - } - foreach a $arcout($id) { - if {!$td && $arctags($a) ne {}} { - validate_arctags $a - if {$arctags($a) ne {}} { - lappend tagloc($id) [lindex $arctags($a) 0] - } - } - if {![info exists arcend($a)]} continue - set d $arcend($a) - if {$td || $arctags($a) ne {}} { - set tomark [list $d] - for {set j 0} {$j < [llength $tomark]} {incr j} { - set dd [lindex $tomark $j] - if {![info exists hastaggeddescendent($dd)]} { - if {[info exists done($dd)]} { - foreach b $arcout($dd) { - if {[info exists arcend($b)]} { - lappend tomark $arcend($b) - } - } - if {[info exists tagloc($dd)]} { - unset tagloc($dd) - } - } elseif {[info exists queued($dd)]} { - incr nc -1 - } - set hastaggeddescendent($dd) 1 - } - } - } - if {![info exists queued($d)]} { - lappend todo $d - set queued($d) 1 - if {![info exists hastaggeddescendent($d)]} { - incr nc - } - } - } - } - set t2 [clock clicks -milliseconds] - set loopix $i - set tags {} - foreach id [array names tagloc] { - if {![info exists hastaggeddescendent($id)]} { - foreach t $tagloc($id) { - if {[lsearch -exact $tags $t] < 0} { - lappend tags $t - } - } - } - } - - # remove tags that are ancestors of other tags - for {set i 0} {$i < [llength $tags]} {incr i} { - set a [lindex $tags $i] - for {set j 0} {$j < $i} {incr j} { - set b [lindex $tags $j] - set r [anc_or_desc $a $b] - if {$r == -1} { - set tags [lreplace $tags $j $j] - incr j -1 - incr i -1 - } elseif {$r == 1} { - set tags [lreplace $tags $i $i] - incr i -1 - break - } - } - } - - if {[array names growing] ne {}} { - # graph isn't finished, need to check if any tag could get - # eclipsed by another tag coming later. Simply ignore any - # tags that could later get eclipsed. - set ctags {} - foreach t $tags { - if {[is_certain $origid $t]} { - lappend ctags $t - } - } - if {$tags eq $ctags} { - set cached_atags($origid) $tags - } else { - set tags $ctags - } - } else { - set cached_atags($origid) $tags - } - set t3 [clock clicks -milliseconds] - if {0 && $t3 - $t1 >= 100} { - puts "iterating ancestors ($loopix/[llength $todo] nodes) took\ - [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left" - } - return $tags -} - -# Return the list of IDs that have heads that are descendents of id, -# including id itself if it has a head. -proc descheads {id} { - global arcnos arcstart arcids archeads idheads cached_dheads - global allparents - - if {![info exists allparents($id)]} { - return {} - } - set aret {} - if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} { - # part-way along an arc; check it first - set a [lindex $arcnos($id) 0] - if {$archeads($a) ne {}} { - validate_archeads $a - set i [lsearch -exact $arcids($a) $id] - foreach t $archeads($a) { - set j [lsearch -exact $arcids($a) $t] - if {$j > $i} break - lappend aret $t - } - } - set id $arcstart($a) - } - set origid $id - set todo [list $id] - set seen($id) 1 - set ret {} - for {set i 0} {$i < [llength $todo]} {incr i} { - set id [lindex $todo $i] - if {[info exists cached_dheads($id)]} { - set ret [concat $ret $cached_dheads($id)] - } else { - if {[info exists idheads($id)]} { - lappend ret $id - } - foreach a $arcnos($id) { - if {$archeads($a) ne {}} { - validate_archeads $a - if {$archeads($a) ne {}} { - set ret [concat $ret $archeads($a)] - } - } - set d $arcstart($a) - if {![info exists seen($d)]} { - lappend todo $d - set seen($d) 1 - } - } - } - } - set ret [lsort -unique $ret] - set cached_dheads($origid) $ret - return [concat $ret $aret] -} - -proc addedtag {id} { - global arcnos arcout cached_dtags cached_atags - - if {![info exists arcnos($id)]} return - if {![info exists arcout($id)]} { - recalcarc [lindex $arcnos($id) 0] - } - catch {unset cached_dtags} - catch {unset cached_atags} -} - -proc addedhead {hid head} { - global arcnos arcout cached_dheads - - if {![info exists arcnos($hid)]} return - if {![info exists arcout($hid)]} { - recalcarc [lindex $arcnos($hid) 0] - } - catch {unset cached_dheads} -} - -proc removedhead {hid head} { - global cached_dheads - - catch {unset cached_dheads} -} - -proc movedhead {hid head} { - global arcnos arcout cached_dheads - - if {![info exists arcnos($hid)]} return - if {![info exists arcout($hid)]} { - recalcarc [lindex $arcnos($hid) 0] - } - catch {unset cached_dheads} -} - -proc changedrefs {} { - global cached_dheads cached_dtags cached_atags - global arctags archeads arcnos arcout idheads idtags - - foreach id [concat [array names idheads] [array names idtags]] { - if {[info exists arcnos($id)] && ![info exists arcout($id)]} { - set a [lindex $arcnos($id) 0] - if {![info exists donearc($a)]} { - recalcarc $a - set donearc($a) 1 - } - } - } - catch {unset cached_dtags} - catch {unset cached_atags} - catch {unset cached_dheads} -} - -proc rereadrefs {} { - global idtags idheads idotherrefs mainhead - - set refids [concat [array names idtags] \ - [array names idheads] [array names idotherrefs]] - foreach id $refids { - if {![info exists ref($id)]} { - 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 || - ($id eq $oldmainhead && $id ne $mainhead) || - ($id eq $mainhead && $id ne $oldmainhead)} { - redrawtags $id - } - } - run refill_reflist -} - -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 tagobjid - - if {$isnew} { - addtohistory [list showtag $tag 0] - } - $ctext conf -state normal - clear_ctext - settabs 0 - set linknum 0 - if {![info exists tagcontents($tag)]} { - catch { - set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)] - } - } - if {[info exists tagcontents($tag)]} { - set text $tagcontents($tag) - } else { - set text "Tag: $tag\nId: $tagids($tag)" - } - appendwithlinks $text {} - $ctext conf -state disabled - init_flist {} -} - -proc doquit {} { - global stopped - set stopped 100 - savestuff . - destroy . -} - -proc mkfontdisp {font top which} { - global fontattr fontpref $font - - set fontpref($font) [set $font] - button $top.${font}but -text $which -font optionfont \ - -command [list choosefont $font $which] - label $top.$font -relief flat -font $font \ - -text $fontattr($font,family) -justify left - grid x $top.${font}but $top.$font -sticky w -} - -proc choosefont {font which} { - global fontparam fontlist fonttop fontattr - - set fontparam(which) $which - set fontparam(font) $font - set fontparam(family) [font actual $font -family] - set fontparam(size) $fontattr($font,size) - set fontparam(weight) $fontattr($font,weight) - set fontparam(slant) $fontattr($font,slant) - set top .gitkfont - set fonttop $top - if {![winfo exists $top]} { - font create sample - eval font config sample [font actual $font] - toplevel $top - wm title $top "Gitk font chooser" - label $top.l -textvariable fontparam(which) -font uifont - pack $top.l -side top - set fontlist [lsort [font families]] - frame $top.f - listbox $top.f.fam -listvariable fontlist \ - -yscrollcommand [list $top.f.sb set] - bind $top.f.fam <> selfontfam - scrollbar $top.f.sb -command [list $top.f.fam yview] - pack $top.f.sb -side right -fill y - pack $top.f.fam -side left -fill both -expand 1 - pack $top.f -side top -fill both -expand 1 - frame $top.g - spinbox $top.g.size -from 4 -to 40 -width 4 \ - -textvariable fontparam(size) \ - -validatecommand {string is integer -strict %s} - checkbutton $top.g.bold -padx 5 \ - -font {{Times New Roman} 12 bold} -text "B" -indicatoron 0 \ - -variable fontparam(weight) -onvalue bold -offvalue normal - checkbutton $top.g.ital -padx 5 \ - -font {{Times New Roman} 12 italic} -text "I" -indicatoron 0 \ - -variable fontparam(slant) -onvalue italic -offvalue roman - pack $top.g.size $top.g.bold $top.g.ital -side left - pack $top.g -side top - canvas $top.c -width 150 -height 50 -border 2 -relief sunk \ - -background white - $top.c create text 100 25 -anchor center -text $which -font sample \ - -fill black -tags text - bind $top.c [list centertext $top.c] - pack $top.c -side top -fill x - frame $top.buts - button $top.buts.ok -text "OK" -command fontok -default active \ - -font uifont - button $top.buts.can -text "Cancel" -command fontcan -default normal \ - -font uifont - 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 - pack $top.buts -side bottom -fill x - trace add variable fontparam write chg_fontparam - } else { - raise $top - $top.c itemconf text -text $which - } - set i [lsearch -exact $fontlist $fontparam(family)] - if {$i >= 0} { - $top.f.fam selection set $i - $top.f.fam see $i - } -} - -proc centertext {w} { - $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}] -} - -proc fontok {} { - global fontparam fontpref prefstop - - set f $fontparam(font) - set fontpref($f) [list $fontparam(family) $fontparam(size)] - if {$fontparam(weight) eq "bold"} { - lappend fontpref($f) "bold" - } - if {$fontparam(slant) eq "italic"} { - lappend fontpref($f) "italic" - } - set w $prefstop.$f - $w conf -text $fontparam(family) -font $fontpref($f) - - fontcan -} - -proc fontcan {} { - global fonttop fontparam - - if {[info exists fonttop]} { - catch {destroy $fonttop} - catch {font delete sample} - unset fonttop - unset fontparam - } -} - -proc selfontfam {} { - global fonttop fontparam - - set i [$fonttop.f.fam curselection] - if {$i ne {}} { - set fontparam(family) [$fonttop.f.fam get $i] - } -} - -proc chg_fontparam {v sub op} { - global fontparam - - font config sample -$sub $fontparam($sub) -} - -proc doprefs {} { - global maxwidth maxgraphpct - global oldprefs prefstop showneartags showlocalchanges - global bgcolor fgcolor ctext diffcolors selectbgcolor - global uifont tabstop limitdiffs - - set top .gitkprefs - set prefstop $top - if {[winfo exists $top]} { - raise $top - return - } - foreach v {maxwidth maxgraphpct showneartags showlocalchanges \ - limitdiffs tabstop} { - set oldprefs($v) [set $v] - } - toplevel $top - wm title $top "Gitk preferences" - label $top.ldisp -text "Commit list display options" - $top.ldisp configure -font uifont - grid $top.ldisp - -sticky w -pady 10 - label $top.spacer -text " " - label $top.maxwidthl -text "Maximum graph width (lines)" \ - -font optionfont - spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth - grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w - label $top.maxpctl -text "Maximum graph width (% of pane)" \ - -font optionfont - spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct - grid x $top.maxpctl $top.maxpct -sticky w - frame $top.showlocal - label $top.showlocal.l -text "Show local changes" -font optionfont - checkbutton $top.showlocal.b -variable showlocalchanges - pack $top.showlocal.b $top.showlocal.l -side left - grid x $top.showlocal -sticky w - - label $top.ddisp -text "Diff display options" - $top.ddisp configure -font uifont - grid $top.ddisp - -sticky w -pady 10 - label $top.tabstopl -text "Tab spacing" -font optionfont - spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop - grid x $top.tabstopl $top.tabstop -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 - frame $top.ldiff - label $top.ldiff.l -text "Limit diffs to listed paths" -font optionfont - checkbutton $top.ldiff.b -variable limitdiffs - pack $top.ldiff.b $top.ldiff.l -side left - grid x $top.ldiff -sticky w - - label $top.cdisp -text "Colors: press to choose" - $top.cdisp configure -font uifont - 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 - label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor - button $top.selbgbut -text "Select bg" -font optionfont \ - -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg] - grid x $top.selbgbut $top.selbgsep -sticky w - - label $top.cfont -text "Fonts: press to choose" - $top.cfont configure -font uifont - grid $top.cfont - -sticky w -pady 10 - mkfontdisp mainfont $top "Main font" - mkfontdisp textfont $top "Diff display font" - mkfontdisp uifont $top "User interface font" - - frame $top.buts - button $top.buts.ok -text "OK" -command prefsok -default active - $top.buts.ok configure -font uifont - button $top.buts.can -text "Cancel" -command prefscan -default normal - $top.buts.can configure -font uifont - 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 - bind $top "focus $top.buts.ok" -} - -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 setselbg {c} { - global bglist cflist - foreach w $bglist { - $w configure -selectbackground $c - } - $cflist tag configure highlight \ - -background [$cflist cget -selectbackground] - allcanvs itemconf secsel -fill $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 oldprefs prefstop - - foreach v {maxwidth maxgraphpct showneartags showlocalchanges \ - limitdiffs tabstop} { - global $v - set $v $oldprefs($v) - } - catch {destroy $prefstop} - unset prefstop - fontcan -} - -proc prefsok {} { - global maxwidth maxgraphpct - global oldprefs prefstop showneartags showlocalchanges - global fontpref mainfont textfont uifont - global limitdiffs treediffs - - catch {destroy $prefstop} - unset prefstop - fontcan - set fontchanged 0 - if {$mainfont ne $fontpref(mainfont)} { - set mainfont $fontpref(mainfont) - parsefont mainfont $mainfont - eval font configure mainfont [fontflags mainfont] - eval font configure mainfontbold [fontflags mainfont 1] - setcoords - set fontchanged 1 - } - if {$textfont ne $fontpref(textfont)} { - set textfont $fontpref(textfont) - parsefont textfont $textfont - eval font configure textfont [fontflags textfont] - eval font configure textfontbold [fontflags textfont 1] - } - if {$uifont ne $fontpref(uifont)} { - set uifont $fontpref(uifont) - parsefont uifont $uifont - eval font configure uifont [fontflags uifont] - } - settabs - if {$showlocalchanges != $oldprefs(showlocalchanges)} { - if {$showlocalchanges} { - doshowlocalchanges - } else { - dohidelocalchanges - } - } - if {$limitdiffs != $oldprefs(limitdiffs)} { - # treediffs elements are limited by path - catch {unset treediffs} - } - if {$fontchanged || $maxwidth != $oldprefs(maxwidth) - || $maxgraphpct != $oldprefs(maxgraphpct)} { - redisplay - } elseif {$showneartags != $oldprefs(showneartags) || - $limitdiffs != $oldprefs(limitdiffs)} { - reselectline - } -} - -proc formatdate {d} { - global datetimeformat - if {$d ne {}} { - set d [clock format $d -format $datetimeformat] - } - return $d -} - -# This list of encoding names and aliases is distilled from -# http://www.iana.org/assignments/character-sets. -# Not all of them are supported by Tcl. -set encoding_aliases { - { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII - ISO646-US US-ASCII us IBM367 cp367 csASCII } - { ISO-10646-UTF-1 csISO10646UTF1 } - { ISO_646.basic:1983 ref csISO646basic1983 } - { INVARIANT csINVARIANT } - { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion } - { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom } - { NATS-SEFI iso-ir-8-1 csNATSSEFI } - { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD } - { NATS-DANO iso-ir-9-1 csNATSDANO } - { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD } - { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish } - { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames } - { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 } - { ISO-2022-KR csISO2022KR } - { EUC-KR csEUCKR } - { ISO-2022-JP csISO2022JP } - { ISO-2022-JP-2 csISO2022JP2 } - { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7 - csISO13JISC6220jp } - { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro } - { IT iso-ir-15 ISO646-IT csISO15Italian } - { PT iso-ir-16 ISO646-PT csISO16Portuguese } - { ES iso-ir-17 ISO646-ES csISO17Spanish } - { greek7-old iso-ir-18 csISO18Greek7Old } - { latin-greek iso-ir-19 csISO19LatinGreek } - { DIN_66003 iso-ir-21 de ISO646-DE csISO21German } - { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French } - { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 } - { ISO_5427 iso-ir-37 csISO5427Cyrillic } - { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 } - { BS_viewdata iso-ir-47 csISO47BSViewdata } - { INIS iso-ir-49 csISO49INIS } - { INIS-8 iso-ir-50 csISO50INIS8 } - { INIS-cyrillic iso-ir-51 csISO51INISCyrillic } - { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 } - { ISO_5428:1980 iso-ir-55 csISO5428Greek } - { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 } - { GB_2312-80 iso-ir-58 chinese csISO58GB231280 } - { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian - csISO60Norwegian1 } - { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 } - { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French } - { videotex-suppl iso-ir-70 csISO70VideotexSupp1 } - { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 } - { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 } - { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian } - { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 } - { greek7 iso-ir-88 csISO88Greek7 } - { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 } - { iso-ir-90 csISO90 } - { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a } - { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b - csISO92JISC62991984b } - { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd } - { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand } - { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add - csISO95JIS62291984handadd } - { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana } - { ISO_2033-1983 iso-ir-98 e13b csISO2033 } - { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS } - { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819 - CP819 csISOLatin1 } - { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 } - { T.61-7bit iso-ir-102 csISO102T617bit } - { T.61-8bit T.61 iso-ir-103 csISO103T618bit } - { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 } - { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 } - { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic } - { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 } - { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 } - { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr } - { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708 - arabic csISOLatinArabic } - { ISO_8859-6-E csISO88596E ISO-8859-6-E } - { ISO_8859-6-I csISO88596I ISO-8859-6-I } - { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118 - greek greek8 csISOLatinGreek } - { T.101-G2 iso-ir-128 csISO128T101G2 } - { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew - csISOLatinHebrew } - { ISO_8859-8-E csISO88598E ISO-8859-8-E } - { ISO_8859-8-I csISO88598I ISO-8859-8-I } - { CSN_369103 iso-ir-139 csISO139CSN369103 } - { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 } - { ISO_6937-2-add iso-ir-142 csISOTextComm } - { IEC_P27-1 iso-ir-143 csISO143IECP271 } - { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic - csISOLatinCyrillic } - { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian } - { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian } - { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 } - { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT } - { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba } - { ISO_6937-2-25 iso-ir-152 csISO6937Add } - { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 } - { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp } - { ISO_10367-box iso-ir-155 csISO10367Box } - { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 } - { latin-lap lap iso-ir-158 csISO158Lap } - { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 } - { DS_2089 DS2089 ISO646-DK dk csISO646Danish } - { us-dk csUSDK } - { dk-us csDKUS } - { JIS_X0201 X0201 csHalfWidthKatakana } - { KSC5636 ISO646-KR csKSC5636 } - { ISO-10646-UCS-2 csUnicode } - { ISO-10646-UCS-4 csUCS4 } - { DEC-MCS dec csDECMCS } - { hp-roman8 roman8 r8 csHPRoman8 } - { macintosh mac csMacintosh } - { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl - csIBM037 } - { IBM038 EBCDIC-INT cp038 csIBM038 } - { IBM273 CP273 csIBM273 } - { IBM274 EBCDIC-BE CP274 csIBM274 } - { IBM275 EBCDIC-BR cp275 csIBM275 } - { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 } - { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 } - { IBM280 CP280 ebcdic-cp-it csIBM280 } - { IBM281 EBCDIC-JP-E cp281 csIBM281 } - { IBM284 CP284 ebcdic-cp-es csIBM284 } - { IBM285 CP285 ebcdic-cp-gb csIBM285 } - { IBM290 cp290 EBCDIC-JP-kana csIBM290 } - { IBM297 cp297 ebcdic-cp-fr csIBM297 } - { IBM420 cp420 ebcdic-cp-ar1 csIBM420 } - { IBM423 cp423 ebcdic-cp-gr csIBM423 } - { IBM424 cp424 ebcdic-cp-he csIBM424 } - { IBM437 cp437 437 csPC8CodePage437 } - { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 } - { IBM775 cp775 csPC775Baltic } - { IBM850 cp850 850 csPC850Multilingual } - { IBM851 cp851 851 csIBM851 } - { IBM852 cp852 852 csPCp852 } - { IBM855 cp855 855 csIBM855 } - { IBM857 cp857 857 csIBM857 } - { IBM860 cp860 860 csIBM860 } - { IBM861 cp861 861 cp-is csIBM861 } - { IBM862 cp862 862 csPC862LatinHebrew } - { IBM863 cp863 863 csIBM863 } - { IBM864 cp864 csIBM864 } - { IBM865 cp865 865 csIBM865 } - { IBM866 cp866 866 csIBM866 } - { IBM868 CP868 cp-ar csIBM868 } - { IBM869 cp869 869 cp-gr csIBM869 } - { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 } - { IBM871 CP871 ebcdic-cp-is csIBM871 } - { IBM880 cp880 EBCDIC-Cyrillic csIBM880 } - { IBM891 cp891 csIBM891 } - { IBM903 cp903 csIBM903 } - { IBM904 cp904 904 csIBBM904 } - { IBM905 CP905 ebcdic-cp-tr csIBM905 } - { IBM918 CP918 ebcdic-cp-ar2 csIBM918 } - { IBM1026 CP1026 csIBM1026 } - { EBCDIC-AT-DE csIBMEBCDICATDE } - { EBCDIC-AT-DE-A csEBCDICATDEA } - { EBCDIC-CA-FR csEBCDICCAFR } - { EBCDIC-DK-NO csEBCDICDKNO } - { EBCDIC-DK-NO-A csEBCDICDKNOA } - { EBCDIC-FI-SE csEBCDICFISE } - { EBCDIC-FI-SE-A csEBCDICFISEA } - { EBCDIC-FR csEBCDICFR } - { EBCDIC-IT csEBCDICIT } - { EBCDIC-PT csEBCDICPT } - { EBCDIC-ES csEBCDICES } - { EBCDIC-ES-A csEBCDICESA } - { EBCDIC-ES-S csEBCDICESS } - { EBCDIC-UK csEBCDICUK } - { EBCDIC-US csEBCDICUS } - { UNKNOWN-8BIT csUnknown8BiT } - { MNEMONIC csMnemonic } - { MNEM csMnem } - { VISCII csVISCII } - { VIQR csVIQR } - { KOI8-R csKOI8R } - { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro } - { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro } - { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro } - { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro } - { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro } - { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro } - { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro } - { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro } - { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro } - { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro } - { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro } - { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro } - { IBM1047 IBM-1047 } - { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian } - { Amiga-1251 Ami1251 Amiga1251 Ami-1251 } - { UNICODE-1-1 csUnicode11 } - { CESU-8 csCESU-8 } - { BOCU-1 csBOCU-1 } - { UNICODE-1-1-UTF-7 csUnicode11UTF7 } - { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic - l8 } - { ISO-8859-15 ISO_8859-15 Latin-9 } - { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 } - { GBK CP936 MS936 windows-936 } - { JIS_Encoding csJISEncoding } - { Shift_JIS MS_Kanji csShiftJIS } - { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese - EUC-JP } - { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese } - { ISO-10646-UCS-Basic csUnicodeASCII } - { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 } - { ISO-Unicode-IBM-1261 csUnicodeIBM1261 } - { ISO-Unicode-IBM-1268 csUnicodeIBM1268 } - { ISO-Unicode-IBM-1276 csUnicodeIBM1276 } - { ISO-Unicode-IBM-1264 csUnicodeIBM1264 } - { ISO-Unicode-IBM-1265 csUnicodeIBM1265 } - { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 } - { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 } - { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 } - { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 } - { Adobe-Standard-Encoding csAdobeStandardEncoding } - { Ventura-US csVenturaUS } - { Ventura-International csVenturaInternational } - { PC8-Danish-Norwegian csPC8DanishNorwegian } - { PC8-Turkish csPC8Turkish } - { IBM-Symbols csIBMSymbols } - { IBM-Thai csIBMThai } - { HP-Legal csHPLegal } - { HP-Pi-font csHPPiFont } - { HP-Math8 csHPMath8 } - { Adobe-Symbol-Encoding csHPPSMath } - { HP-DeskTop csHPDesktop } - { Ventura-Math csVenturaMath } - { Microsoft-Publishing csMicrosoftPublishing } - { Windows-31J csWindows31J } - { GB2312 csGB2312 } - { Big5 csBig5 } -} - -proc tcl_encoding {enc} { - global encoding_aliases - set names [encoding names] - set lcnames [string tolower $names] - set enc [string tolower $enc] - set i [lsearch -exact $lcnames $enc] - if {$i < 0} { - # look for "isonnn" instead of "iso-nnn" or "iso_nnn" - if {[regsub {^iso[-_]} $enc iso encx]} { - set i [lsearch -exact $lcnames $encx] - } - } - if {$i < 0} { - foreach l $encoding_aliases { - set ll [string tolower $l] - if {[lsearch -exact $ll $enc] < 0} continue - # look through the aliases for one that tcl knows about - foreach e $ll { - set i [lsearch -exact $lcnames $e] - if {$i < 0} { - if {[regsub {^iso[-_]} $e iso ex]} { - set i [lsearch -exact $lcnames $ex] - } - } - if {$i >= 0} break - } - break - } - } - if {$i >= 0} { - return [lindex $names $i] - } - return {} -} - -# First check that Tcl/Tk is recent enough -if {[catch {package require Tk 8.4} err]} { - show_error {} . "Sorry, gitk cannot run with this version of Tcl/Tk.\n\ - Gitk requires at least Tcl/Tk 8.4." - exit 1 -} - -# defaults... -set datemode 0 -set wrcomcmd "git diff-tree --stdin -p --pretty" - -set gitencoding {} -catch { - set gitencoding [exec git config --get i18n.commitencoding] -} -if {$gitencoding == ""} { - set gitencoding "utf-8" -} -set tclencoding [tcl_encoding $gitencoding] -if {$tclencoding == {}} { - puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk" -} - -set mainfont {Helvetica 9} -set textfont {Courier 9} -set uifont {Helvetica 9 bold} -set tabstop 8 -set findmergefiles 0 -set maxgraphpct 50 -set maxwidth 16 -set revlistorder 0 -set fastdate 0 -set uparrowlen 5 -set downarrowlen 5 -set mingaplen 100 -set cmitmode "patch" -set wrapcomment "none" -set showneartags 1 -set maxrefs 20 -set maxlinelen 200 -set showlocalchanges 1 -set limitdiffs 1 -set datetimeformat "%Y-%m-%d %H:%M:%S" - -set colors {green red blue magenta darkgrey brown orange} -set bgcolor white -set fgcolor black -set diffcolors {red "#00a000" blue} -set diffcontext 3 -set selectbgcolor gray85 - -catch {source ~/.gitk} - -font create optionfont -family sans-serif -size -12 - -parsefont mainfont $mainfont -eval font create mainfont [fontflags mainfont] -eval font create mainfontbold [fontflags mainfont 1] - -parsefont textfont $textfont -eval font create textfont [fontflags textfont] -eval font create textfontbold [fontflags textfont 1] - -parsefont uifont $uifont -eval font create uifont [fontflags uifont] - -# check that we can find a .git directory somewhere... -if {[catch {set gitdir [gitdir]}]} { - show_error {} . "Cannot find a git repository here." - exit 1 -} -if {![file isdirectory $gitdir]} { - show_error {} . "Cannot find the git directory \"$gitdir\"." - exit 1 -} - -set mergeonly 0 -set revtreeargs {} -set cmdline_files {} -set i 0 -foreach arg $argv { - switch -- $arg { - "" { } - "-d" { set datemode 1 } - "--merge" { - set mergeonly 1 - lappend revtreeargs $arg - } - "--" { - set cmdline_files [lrange $argv [expr {$i + 1}] end] - break - } - default { - lappend revtreeargs $arg - } - } - incr i -} - -if {$i >= [llength $argv] && $revtreeargs ne {}} { - # no -- on command line, but some arguments (other than -d) - if {[catch { - set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs] - set cmdline_files [split $f "\n"] - set n [llength $cmdline_files] - set revtreeargs [lrange $revtreeargs 0 end-$n] - # Unfortunately git rev-parse doesn't produce an error when - # something is both a revision and a filename. To be consistent - # with git log and git rev-list, check revtreeargs for filenames. - foreach arg $revtreeargs { - if {[file exists $arg]} { - show_error {} . "Ambiguous argument '$arg': both revision\ - and filename" - exit 1 - } - } - } err]} { - # unfortunately we get both stdout and stderr in $err, - # so look for "fatal:". - set i [string first "fatal:" $err] - if {$i > 0} { - set err [string range $err [expr {$i + 6}] end] - } - show_error {} . "Bad arguments to gitk:\n$err" - exit 1 - } -} - -if {$mergeonly} { - # find the list of unmerged files - set mlist {} - set nr_unmerged 0 - if {[catch { - set fd [open "| git ls-files -u" r] - } err]} { - show_error {} . "Couldn't get list of unmerged files: $err" - exit 1 - } - while {[gets $fd line] >= 0} { - set i [string first "\t" $line] - if {$i < 0} continue - set fname [string range $line [expr {$i+1}] end] - if {[lsearch -exact $mlist $fname] >= 0} continue - incr nr_unmerged - if {$cmdline_files eq {} || [path_filter $cmdline_files $fname]} { - lappend mlist $fname - } - } - catch {close $fd} - if {$mlist eq {}} { - if {$nr_unmerged == 0} { - show_error {} . "No files selected: --merge specified but\ - no files are unmerged." - } else { - show_error {} . "No files selected: --merge specified but\ - no unmerged files are within file limit." - } - exit 1 - } - set cmdline_files $mlist -} - -set nullid "0000000000000000000000000000000000000000" -set nullid2 "0000000000000000000000000000000000000001" - -set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}] - -set runq {} -set history {} -set historyindex 0 -set fh_serial 0 -set nhl_names {} -set highlight_paths {} -set findpattern {} -set searchdirn -forwards -set boldrows {} -set boldnamerows {} -set diffelide {0 0} -set markingmatches 0 -set linkentercount 0 -set need_redisplay 0 -set nrows_drawn 0 -set firsttabstop 0 - -set nextviewnum 1 -set curview 0 -set selectedview 0 -set selectedhlview None -set highlight_related None -set highlight_files {} -set viewfiles(0) {} -set viewperm(0) 0 -set viewargs(0) {} - -set cmdlineok 0 -set stopped 0 -set stuffsaved 0 -set patchnum 0 -set localirow -1 -set localfrow -1 -set lserial 0 -setcoords -makewindow -# wait for the window to become visible -tkwait visibility . -wm title . "[file tail $argv0]: [file tail [pwd]]" -readrefs - -if {$cmdline_files ne {} || $revtreeargs ne {}} { - # create a view for the files/dirs specified on the command line - set curview 1 - set selectedview 1 - set nextviewnum 2 - set viewname(1) "Command line" - set viewfiles(1) $cmdline_files - set viewargs(1) $revtreeargs - set viewperm(1) 0 - addviewmenu 1 - .bar.view entryconf Edit* -state normal - .bar.view entryconf Delete* -state normal -} - -if {[info exists permviews]} { - foreach v $permviews { - set n $nextviewnum - incr nextviewnum - set viewname($n) [lindex $v 0] - set viewfiles($n) [lindex $v 1] - set viewargs($n) [lindex $v 2] - set viewperm($n) 1 - addviewmenu $n - } -} -getcommits -- cgit v1.2.3