![[tokkee]](http://tokkee.org/images/avatar.png){kind=avatar}
index 2d6a6ef9cef40b0ea5090f49d13c30836f0f1c20..300fdceb350ca6d0419ef3b0bf3f1e7b82700a59 100755 (executable)
--- a/gitk
+++ b/gitk
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 rev-list --header $order \
- --parents --boundary --default HEAD $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
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
}
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
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
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]
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} {
proc updatecommits {} {
global viewdata curview phase displayorder
- global children commitrow selectedline thickerline
+ global children commitrow selectedline thickerline showneartags
if {$phase ne {}} {
stop_rev_list
catch {unset viewdata($n)}
readrefs
changedrefs
- regetallcommits
+ if {$showneartags} {
+ getallcommits
+ }
showview $n
}
lappend idotherrefs($id) $name
}
}
- close $refd
+ catch {close $refd}
set mainhead {}
set mainheadid {}
catch {
}
}
+# 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
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
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
-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}]" \
wm geometry . "$geometry(main)"
}
+ if {[tk windowingsystem] eq {aqua}} {
+ set M1B M1
+ } else {
+ set M1B Control
+ }
+
bind .pwbottom <Configure> {resizecdetpanes %W %w}
pack .ctop -fill both -expand 1
bindall <1> {selcanvline %W %x %y}
#bindall <B1-Motion> {selcanvline %W %x %y}
- bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
- bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
+ if {[tk windowingsystem] == "win32"} {
+ bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
+ bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
+ } else {
+ bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
+ bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
+ }
bindall <2> "canvscan mark %W %x %y"
bindall <B2-Motion> "canvscan dragto %W %x %y"
bindkey <Home> selfirstline
bindkey <Key-Left> "goback"
bind . <Key-Prior> "selnextpage -1"
bind . <Key-Next> "selnextpage 1"
- bind . <Control-Home> "allcanvs yview moveto 0.0"
- bind . <Control-End> "allcanvs yview moveto 1.0"
- bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
- bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
- bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
- bind . <Control-Key-Next> "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 <Key-Delete> "$ctext yview scroll -1 pages"
bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
bindkey <Key-space> "$ctext yview scroll 1 pages"
bindkey ? findprev
bindkey f nextfile
bindkey <F5> updatecommits
- bind . <Control-q> doquit
- bind . <Control-f> dofind
- bind . <Control-g> {findnext 0}
- bind . <Control-r> dosearchback
- bind . <Control-s> dosearch
- bind . <Control-equal> {incrfont 1}
- bind . <Control-KP_Add> {incrfont 1}
- bind . <Control-minus> {incrfont -1}
- bind . <Control-KP_Subtract> {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 . <Button-1> "click %W"
bind $fstring <Key-Return> dofind
bind $cflist <1> {sel_flist %W %x %y; break}
bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
+ bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
set maincursor [. cget -cursor]
set textcursor [$ctext cget -cursor]
-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
# 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 .
global stuffsaved findmergefiles maxgraphpct
global maxwidth showneartags showlocalchanges
global viewname viewfiles viewargs viewperm nextviewnum
- global cmitmode wrapcomment
- global colors bgcolor fgcolor diffcolors selectbgcolor
+ global cmitmode wrapcomment datetimeformat
+ global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
if {$stuffsaved} return
if {![winfo viewable .]} return
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]
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 .]"
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:
-<Ctrl-Q> Quit
+<$M1T-Q> Quit
<Home> Move to first commit
<End> Move to last commit
<Up>, p, i Move up one commit
<Right>, x, l Go forward in history list
<PageUp> Move up one page in commit list
<PageDown> Move down one page in commit list
-<Ctrl-Home> Scroll to top of commit list
-<Ctrl-End> Scroll to bottom of commit list
-<Ctrl-Up> Scroll commit list up one line
-<Ctrl-Down> Scroll commit list down one line
-<Ctrl-PageUp> Scroll commit list up one page
-<Ctrl-PageDown> 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
<Shift-Up> Move to previous highlighted line
<Shift-Down> Move to next highlighted line
<Delete>, b Scroll diff view up one page
<Space> Scroll diff view down one page
u Scroll diff view up 18 lines
d Scroll diff view down 18 lines
-<Ctrl-F> Find
-<Ctrl-G> Move to next find hit
+<$M1T-F> Find
+<$M1T-G> Move to next find hit
<Return> 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
-<Ctrl-S> Search for next hit in diff view
-<Ctrl-R> Search for previous hit in diff view
-<Ctrl-KP+> Increase font size
-<Ctrl-plus> Increase font size
-<Ctrl-KP-> Decrease font size
-<Ctrl-minus> 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
<F5> 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
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
}
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
}
}
+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} {
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
}
unselectline
normalline
- stopfindproc
if {$curview >= 0} {
set vparentlist($curview) $parentlist
set vdisporder($curview) $displayorder
[list {} $rowidlist $rowoffsets $rowrangelist]
}
}
- catch {unset matchinglines}
catch {unset treediffs}
clear_display
if {[info exists hlview] && $hlview == $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 {
} elseif {$numcommits == 0} {
show_status "No commits selected"
}
+ run refill_reflist
}
# Stuff relating to the highlighting facility
set boldnamerows {}
catch {unset nhighlights}
unbolden
+ unmarkmatches
if {$findtype ne "Regexp"} {
set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
$findstring]
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
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 $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
proc showstuff {canshow last} {
global numcommits commitrow pending_select selectedline curview
- global lookingforhead mainheadid displayorder nullid selectfirst
- global lastscrollset
+ global lookingforhead mainheadid displayorder selectfirst
+ 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
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
}
}
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
+
+ # 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 {$serial == $lserial && $localrow == -1} {
+ 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
}
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 nev [expr {[llength $idlist] + [llength $newolds]
- + [llength $oldolds] - $maxwidth + 1}]
if {$nev > 0} {
if {!$last &&
$row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
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]
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
set col [expr {[llength $idlist] - 1}]
set id [lindex $idlist $col]
addextraid $id $row
- unset idinlist($id)
- lappend idrowranges($id) $row
+ catch {unset idinlist($id)}
+ lappend idrowranges($id) $id
lappend rowrangelist $idrowranges($id)
unset idrowranges($id)
incr row
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
}
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
- 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 green
} 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]]
proc drawcmitrow {row} {
global displayorder rowidlist
- global iddrawn
+ global iddrawn markingmatches
global commitinfo parentlist numcommits
global filehighlight fhighlights findstring nhighlights
global hlview vhighlights
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 {}}} {
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)]} {
}
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
+ 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 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]
+ # 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)
- set doesmatch 0
foreach f $info ty $fldtypes {
- if {$findloc != "All fields" && $findloc != $ty} {
- continue
+ if {($findloc eq "All fields" || $findloc eq $ty) &&
+ [doesmatch $f]} {
+ findselectline $l
+ notbusy finding
+ return 0
}
- 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 {$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 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]} {
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} {
- 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
$ctext tag add found "1.0 + $start c" "1.0 + $end c"
}
}
+ drawvisible
}
-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
- 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 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 or author that match a find string
+proc markmatches {canv l str tag matches font row} {
+ global selectedline
-# mark the bits of a headline, author or date that match a find string
-proc markmatches {canv l str tag matches font} {
set bbox [$canv bbox $tag]
set x0 [lindex $bbox 0]
set y0 [lindex $bbox 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 matches -fill yellow]
+ -outline {} -tags [list match$l matches] -fill yellow]
$canv lower $t
+ if {[info exists selectedline] && $row == $selectedline} {
+ $canv raise $t secsel
+ }
}
}
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} {
$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]
proc selnextline {dir} {
global selectedline
+ focus .
if {![info exists selectedline]} return
set l [expr {$selectedline + $dir}]
unmarkmatches
proc goback {} {
global history historyindex
+ focus .
if {$historyindex > 1} {
incr historyindex -1
proc goforw {} {
global history historyindex
+ focus .
if {$historyindex < [llength $history]} {
set cmd [lindex $history $historyindex]
}
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
}
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]
set fname [lindex $fname 0]
}
lappend treeidlist($id) $sha1
- } else {
- set fname $line
}
lappend treefilelist($id) $fname
}
}
proc showfile {f} {
- global treefilelist treeidlist diffids nullid
+ global treefilelist treeidlist diffids nullid nullid2
global ctext commentend
set i [lsearch -exact $treefilelist($diffids) $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
}
}
}
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
}
}
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
}
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]
}
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}] r]} err]} {
+ if {[catch {set bdf [open [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"] r]} err]} {
puts "error getting diffs: $err"
return
}
# 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]
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]
}
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]
}
}
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
if {$phase eq "getcommits"} {
$canv itemconf textitems -font $mainfont
}
+ if {[info exists showrefstop] && [winfo exists $showrefstop]} {
+ $showrefstop.list conf -font $mainfont
+ }
redisplay
}
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]
} 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 {
}
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"
lappend idtags($id) $tag
redrawtags $id
addedtag $id
+ dispneartags 0
+ run refill_reflist
}
proc redrawtags {id} {
notbusy newbranch
redrawtags $id
dispneartags 0
+ run refill_reflist
}
}
proc rmbranch {} {
global headmenuid headmenuhead mainhead
- global headids idheads
+ global idheads
set head $headmenuhead
set id $headmenuid
return
}
set dheads [descheads $id]
- if {$dheads eq $headids($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
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 <B1-Motion> {break}
+ bind $top.list <ButtonRelease-1> {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 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 {
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) {}
# 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}
redrawtags $id
}
}
+ run refill_reflist
}
proc listrefs {id} {
}
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
}
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
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
+# 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 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
+ }
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:".
}
set nullid "0000000000000000000000000000000000000000"
+set nullid2 "0000000000000000000000000000000000000001"
+
set runq {}
set history {}
set boldrows {}
set boldnamerows {}
set diffelide {0 0}
+set markingmatches 0
set optim_delay 16
set stuffsaved 0
set patchnum 0
set lookingforhead 0
-set localrow -1
+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