# Tcl ignores the next line -*- tcl -*- \
exec wish "$0" -- "$@"
-# Copyright (C) 2005 Paul Mackerras. All rights reserved.
+# Copyright (C) 2005-2006 Paul Mackerras. All rights reserved.
# This program is free software; it may be used, copied, modified
# and distributed under the terms of the GNU General Public Licence,
# either version 2, or (at your option) any later version.
}
proc start_rev_list {view} {
- global startmsecs nextupdate ncmupdate
+ global startmsecs nextupdate
global commfd leftover tclencoding datemode
global viewargs viewfiles commitidx
set startmsecs [clock clicks -milliseconds]
set nextupdate [expr {$startmsecs + 100}]
- set ncmupdate 1
set commitidx($view) 0
set args $viewargs($view)
if {$viewfiles($view) ne {}} {
set order "--date-order"
}
if {[catch {
- set fd [open [concat | git-rev-list --header $order \
+ set fd [open [concat | git rev-list --header $order \
--parents --boundary --default HEAD $args] r]
} err]} {
- puts stderr "Error executing git-rev-list: $err"
+ puts stderr "Error executing git rev-list: $err"
exit 1
}
set commfd($view) $fd
global parentlist childlist children curview hlview
global vparentlist vchildlist vdisporder vcmitlisted
- set stuff [read $fd]
+ set stuff [read $fd 500000]
if {$stuff == {}} {
if {![eof $fd]} return
global viewname
}
if {[string range $err 0 4] == "usage"} {
set err "Gitk: error reading commits$fv:\
- bad arguments to git-rev-list."
+ bad arguments to git rev-list."
if {$viewname($view) eq "Command line"} {
append err \
- " (Note: arguments to gitk are passed to git-rev-list\
+ " (Note: arguments to gitk are passed to git rev-list\
to allow selection of commits to be displayed.)"
}
} else {
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 rev-list output: {$shortcmit}"
exit 1
}
set id [lindex $ids 0]
}
if {$gotsome} {
if {$view == $curview} {
- layoutmore
+ while {[layoutmore $nextupdate]} doupdate
} elseif {[info exists hlview] && $view == $hlview} {
vhighlightmore
}
}
proc doupdate {} {
- global commfd nextupdate numcommits ncmupdate
+ global commfd nextupdate numcommits
foreach v [array names commfd] {
fileevent $commfd($v) readable {}
}
update
set nextupdate [expr {[clock clicks -milliseconds] + 100}]
- if {$numcommits < 100} {
- set ncmupdate [expr {$numcommits + 1}]
- } elseif {$numcommits < 10000} {
- set ncmupdate [expr {$numcommits + 10}]
- } else {
- set ncmupdate [expr {$numcommits + 100}]
- }
foreach v [array names commfd] {
set fd $commfd($v)
fileevent $fd readable [list getcommitlines $fd $v]
}
proc readcommit {id} {
- if {[catch {set contents [exec git-cat-file commit $id]}]} return
+ if {[catch {set contents [exec git cat-file commit $id]}]} return
parsecommit $id $contents 0
}
catch {unset selectedline}
catch {unset thickerline}
catch {unset viewdata($n)}
+ discardallcommits
readrefs
showview $n
}
set headline $comment
}
if {!$listed} {
- # git-rev-list indents the comment by 4 spaces;
- # if we got this via git-cat-file, add the indentation
+ # 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 " "
proc readrefs {} {
global tagids idtags headids idheads tagcontents
- global otherrefids idotherrefs
+ global otherrefids idotherrefs mainhead
foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
catch {unset $v}
set type {}
set tag {}
catch {
- set commit [exec git-rev-parse "$id^0"]
- if {"$commit" != "$id"} {
+ 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 tagcontents($name) [exec git cat-file tag $id]
}
} elseif { $type == "heads" } {
set headids($name) $id
}
}
close $refd
+ set mainhead {}
+ catch {
+ set thehead [exec git symbolic-ref HEAD]
+ if {[string match "refs/heads/*" $thehead]} {
+ set mainhead [string range $thehead 11 end]
+ }
+ }
}
-proc show_error {w msg} {
+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 $w"
+ button $w.ok -text OK -command "destroy $top"
pack $w.ok -side bottom -fill x
- bind $w <Visibility> "grab $w; focus $w"
- bind $w <Key-Return> "destroy $w"
- tkwait window $w
+ bind $top <Visibility> "grab $top; focus $top"
+ bind $top <Key-Return> "destroy $top"
+ tkwait window $top
}
proc error_popup msg {
set w .error
toplevel $w
wm transient $w .
- show_error $w $msg
+ show_error $w $w $msg
+}
+
+proc confirm_popup msg {
+ global confirm_ok
+ set confirm_ok 0
+ set w .confirm
+ toplevel $w
+ wm transient $w .
+ message $w.m -text $msg -justify center -aspect 400
+ pack $w.m -side top -fill x -padx 20 -pady 20
+ button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
+ pack $w.ok -side left -fill x
+ button $w.cancel -text Cancel -command "destroy $w"
+ pack $w.cancel -side right -fill x
+ bind $w <Visibility> "grab $w; focus $w"
+ tkwait window $w
+ return $confirm_ok
}
proc makewindow {} {
global findtype findtypemenu findloc findstring fstring geometry
global entries sha1entry sha1string sha1but
global maincursor textcursor curtextcursor
- global rowctxmenu mergemax
+ global rowctxmenu mergemax wrapcomment
global highlight_files gdttype
global searchstring sstring
+ global bgcolor fgcolor bglist fglist diffcolors
+ global headctxmenu
menu .bar
.bar add cascade -label "File" -menu .bar.file
.ctop add .ctop.top
set canv .ctop.top.clist.canv
canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
- -bg white -bd 0 \
+ -background $bgcolor -bd 0 \
-yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
.ctop.top.clist add $canv
set canv2 .ctop.top.clist.canv2
canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
- -bg white -bd 0 -yscrollincr $linespc
+ -background $bgcolor -bd 0 -yscrollincr $linespc
.ctop.top.clist add $canv2
set canv3 .ctop.top.clist.canv3
canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
- -bg white -bd 0 -yscrollincr $linespc
+ -background $bgcolor -bd 0 -yscrollincr $linespc
.ctop.top.clist add $canv3
bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
+ lappend bglist $canv $canv2 $canv3
set sha1entry .ctop.top.bar.sha1
set entries $sha1entry
pack .ctop.top.lbar.vlabel -side left -fill y
global viewhlmenu selectedhlview
set viewhlmenu [tk_optionMenu .ctop.top.lbar.vhl selectedhlview None]
- $viewhlmenu entryconf 0 -command delvhighlight
+ $viewhlmenu entryconf None -command delvhighlight
$viewhlmenu conf -font $uifont
.ctop.top.lbar.vhl conf -font $uifont
pack .ctop.top.lbar.vhl -side left -fill y
+ label .ctop.top.lbar.rlabel -text " OR " -font $uifont
+ pack .ctop.top.lbar.rlabel -side left -fill y
+ global highlight_related
+ set m [tk_optionMenu .ctop.top.lbar.relm highlight_related None \
+ "Descendent" "Not descendent" "Ancestor" "Not ancestor"]
+ $m conf -font $uifont
+ .ctop.top.lbar.relm conf -font $uifont
+ trace add variable highlight_related write vrel_change
+ pack .ctop.top.lbar.relm -side left -fill y
panedwindow .ctop.cdet -orient horizontal
.ctop add .ctop.cdet
trace add variable searchstring write incrsearch
pack $sstring -side left -expand 1 -fill x
set ctext .ctop.cdet.left.ctext
- text $ctext -bg white -state disabled -font $textfont \
+ text $ctext -background $bgcolor -foreground $fgcolor \
+ -state disabled -font $textfont \
-width $geometry(ctextw) -height $geometry(ctexth) \
-yscrollcommand scrolltext -wrap none
scrollbar .ctop.cdet.left.sb -command "$ctext yview"
pack .ctop.cdet.left.sb -side right -fill y
pack $ctext -side left -fill both -expand 1
.ctop.cdet add .ctop.cdet.left
+ lappend bglist $ctext
+ lappend fglist $ctext
+ $ctext tag conf comment -wrap $wrapcomment
$ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
- $ctext tag conf hunksep -fore blue
- $ctext tag conf d0 -fore red
- $ctext tag conf d1 -fore "#00a000"
+ $ctext tag conf hunksep -fore [lindex $diffcolors 2]
+ $ctext tag conf d0 -fore [lindex $diffcolors 0]
+ $ctext tag conf d1 -fore [lindex $diffcolors 1]
$ctext tag conf m0 -fore red
$ctext tag conf m1 -fore blue
$ctext tag conf m2 -fore green
pack .ctop.cdet.right.mode -side top -fill x
set cflist .ctop.cdet.right.cfiles
set indent [font measure $mainfont "nn"]
- text $cflist -width $geometry(cflistw) -background white -font $mainfont \
+ text $cflist -width $geometry(cflistw) \
+ -background $bgcolor -foreground $fgcolor \
+ -font $mainfont \
-tabs [list $indent [expr {2 * $indent}]] \
-yscrollcommand ".ctop.cdet.right.sb set" \
-cursor [. cget -cursor] \
-spacing1 1 -spacing3 1
+ lappend bglist $cflist
+ lappend fglist $cflist
scrollbar .ctop.cdet.right.sb -command "$cflist yview"
pack .ctop.cdet.right.sb -side right -fill y
pack $cflist -side left -fill both -expand 1
bindkey <End> sellastline
bind . <Key-Up> "selnextline -1"
bind . <Key-Down> "selnextline 1"
+ bind . <Shift-Key-Up> "next_highlight -1"
+ bind . <Shift-Key-Down> "next_highlight 1"
bindkey <Key-Right> "goforw"
bindkey <Key-Left> "goback"
bind . <Key-Prior> "selnextpage -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
+
+ set headctxmenu .headctxmenu
+ menu $headctxmenu -tearoff 0
+ $headctxmenu add command -label "Check out this branch" \
+ -command cobranch
+ $headctxmenu add command -label "Remove this branch" \
+ -command rmbranch
}
# mouse-2 makes all windows scan vertically, but only the one
proc savestuff {w} {
global canv canv2 canv3 ctext cflist mainfont textfont uifont
global stuffsaved findmergefiles maxgraphpct
- global maxwidth
+ global maxwidth showneartags
global viewname viewfiles viewargs viewperm nextviewnum
- global cmitmode
+ global cmitmode wrapcomment
+ global colors bgcolor fgcolor diffcolors
if {$stuffsaved} return
if {![winfo viewable .]} return
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 bgcolor $bgcolor]
+ puts $f [list set fgcolor $fgcolor]
+ puts $f [list set colors $colors]
+ puts $f [list set diffcolors $diffcolors]
puts $f "set geometry(width) [winfo width .ctop]"
puts $f "set geometry(height) [winfo height .ctop]"
puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
<Ctrl-Down> Scroll commit list down one line
<Ctrl-PageUp> Scroll commit list up one page
<Ctrl-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
<Backspace> Scroll diff view up one page
<Space> Scroll diff view down one page
d Scroll diff view down 18 lines
<Ctrl-F> Find
<Ctrl-G> Move to next find hit
-<Ctrl-R> Move to previous 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
checkbutton $top.perm -text "Remember this view" -variable newviewperm($n)
grid $top.perm - -pady 5 -sticky w
message $top.al -aspect 1000 -font $uifont \
- -text "Commits to include (arguments to git-rev-list):"
+ -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
proc allviewmenus {n op args} {
global viewhlmenu
- doviewmenu .bar.view 7 [list showview $n] $op $args
+ doviewmenu .bar.view 5 [list showview $n] $op $args
doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
}
set viewperm($n) $newviewperm($n)
if {$newviewname($n) ne $viewname($n)} {
set viewname($n) $newviewname($n)
- doviewmenu .bar.view 7 [list showview $n] \
+ doviewmenu .bar.view 5 [list showview $n] \
entryconf [list -label $viewname($n)]
doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
entryconf [list -label $viewname($n) -value $viewname($n)]
set curview $n
set selectedview $n
- .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
- .bar.view entryconf 3 -state [expr {$n == 0? "disabled": "normal"}]
+ .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
+ .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
if {![info exists viewdata($n)]} {
set pending_select $selid
show_status "Reading commits..."
}
if {[info exists commfd($n)]} {
- layoutmore
+ layoutmore {}
} else {
finishcommits
}
# Stuff relating to the highlighting facility
proc ishighlighted {row} {
- global vhighlights fhighlights nhighlights
+ global vhighlights fhighlights nhighlights rhighlights
if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
return $nhighlights($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
+ global canv linehtag selectedline boldrows
+ lappend boldrows $row
$canv itemconf $linehtag($row) -font $font
if {[info exists selectedline] && $row == $selectedline} {
$canv delete secsel
}
proc bolden_name {row font} {
- global canv2 linentag selectedline
+ global canv2 linentag selectedline boldnamerows
+ lappend boldnamerows $row
$canv2 itemconf $linentag($row) -font $font
if {[info exists selectedline] && $row == $selectedline} {
$canv2 delete secsel
}
}
-proc unbolden {rows} {
- global mainfont
+proc unbolden {} {
+ global mainfont boldrows
- foreach row $rows {
+ set stillbold {}
+ foreach row $boldrows {
if {![ishighlighted $row]} {
bolden $row $mainfont
+ } else {
+ lappend stillbold $row
}
}
+ set boldrows $stillbold
}
proc addvhighlight {n} {
if {![info exists hlview]} return
unset hlview
- set rows [array names vhighlights]
- if {$rows ne {}} {
- unset vhighlights
- unbolden $rows
- }
+ catch {unset vhighlights}
+ unbolden
}
proc vhighlightmore {} {
# delete previous highlights
catch {close $filehighlight}
unset filehighlight
- set rows [array names fhighlights]
- if {$rows ne {}} {
- unset fhighlights
- unbolden $rows
- }
+ catch {unset fhighlights}
+ unbolden
unhighlight_filelist
}
set highlight_paths {}
}
proc do_file_hl {serial} {
- global highlight_files filehighlight highlight_paths gdttype
+ global highlight_files filehighlight highlight_paths gdttype fhl_list
if {$gdttype eq "touching paths:"} {
if {[catch {set paths [shellsplit $highlight_files]}]} return
set filehighlight [open $cmd r+]
fconfigure $filehighlight -blocking 0
fileevent $filehighlight readable readfhighlight
+ set fhl_list {}
drawvisible
flushhighlights
}
proc flushhighlights {} {
- global filehighlight
+ global filehighlight fhl_list
if {[info exists filehighlight]} {
+ lappend fhl_list {}
puts $filehighlight ""
flush $filehighlight
}
}
proc askfilehighlight {row id} {
- global filehighlight fhighlights
+ global filehighlight fhighlights fhl_list
- set fhighlights($row) 0
+ lappend fhl_list $id
+ set fhighlights($row) -1
puts $filehighlight $id
}
proc readfhighlight {} {
global filehighlight fhighlights commitrow curview mainfont iddrawn
-
- set n [gets $filehighlight line]
- if {$n < 0} {
- if {[eof $filehighlight]} {
- # strange...
- puts "oops, git-diff-tree died"
- catch {close $filehighlight}
- unset filehighlight
+ global fhl_list
+
+ while {[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
+ }
}
- return
+ 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 [concat $mainfont bold]
+ }
+ set fhighlights($row) 1
}
- set line [string trim $line]
- if {$line eq {}} return
- if {![info exists commitrow($curview,$line)]} return
- set row $commitrow($curview,$line)
- if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
- bolden $row [concat $mainfont bold]
+ if {[eof $filehighlight]} {
+ # strange...
+ puts "oops, git-diff-tree died"
+ catch {close $filehighlight}
+ unset filehighlight
}
- set fhighlights($row) 1
+ next_hlcont
}
proc find_change {name ix op} {
- global nhighlights mainfont
+ global nhighlights mainfont boldnamerows
global findstring findpattern findtype
# delete previous highlights, if any
- set rows [array names nhighlights]
- if {$rows ne {}} {
- foreach row $rows {
- if {$nhighlights($row) >= 2} {
- bolden_name $row $mainfont
- }
- }
- unset nhighlights
- unbolden $rows
+ foreach row $boldnamerows {
+ bolden_name $row $mainfont
}
+ set boldnamerows {}
+ catch {unset nhighlights}
+ unbolden
if {$findtype ne "Regexp"} {
set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
$findstring]
set nhighlights($row) $isbold
}
+proc vrel_change {name ix op} {
+ global highlight_related
+
+ rhighlight_none
+ if {$highlight_related ne "None"} {
+ after idle 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
+ after idle 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 mainfont 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 [concat $mainfont bold]
+ }
+ }
+ 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} {
return [list $r0 $r1]
}
-proc layoutmore {} {
+proc layoutmore {tmax} {
global rowlaidout rowoptim commitidx numcommits optim_delay
global uparrowlen curview
- set row $rowlaidout
- set rowlaidout [layoutrows $row $commitidx($curview) 0]
- set orow [expr {$rowlaidout - $uparrowlen - 1}]
- if {$orow > $rowoptim} {
- optimize_rows $rowoptim 0 $orow
- set rowoptim $orow
- }
- set canshow [expr {$rowoptim - $optim_delay}]
- if {$canshow > $numcommits} {
- showstuff $canshow
+ while {1} {
+ if {$rowoptim - $optim_delay > $numcommits} {
+ showstuff [expr {$rowoptim - $optim_delay}]
+ } elseif {$rowlaidout - $uparrowlen - 1 > $rowoptim} {
+ set nr [expr {$rowlaidout - $uparrowlen - 1 - $rowoptim}]
+ if {$nr > 100} {
+ set nr 100
+ }
+ optimize_rows $rowoptim 0 [expr {$rowoptim + $nr}]
+ incr rowoptim $nr
+ } elseif {$commitidx($curview) > $rowlaidout} {
+ set nr [expr {$commitidx($curview) - $rowlaidout}]
+ # may need to increase this threshold if uparrowlen or
+ # mingaplen are increased...
+ if {$nr > 150} {
+ set nr 150
+ }
+ set row $rowlaidout
+ set rowlaidout [layoutrows $row [expr {$row + $nr}] 0]
+ if {$rowlaidout == $row} {
+ return 0
+ }
+ } else {
+ return 0
+ }
+ if {$tmax ne {} && [clock clicks -milliseconds] >= $tmax} {
+ return 1
+ }
}
}
}
proc drawcmittext {id row col rmx} {
- global linespc canv canv2 canv3 canvy0
+ global linespc canv canv2 canv3 canvy0 fgcolor
global commitlisted commitinfo rowidlist
global rowtextx idpos idtags idheads idotherrefs
global linehtag linentag linedtag
- global mainfont canvxmax
+ global mainfont canvxmax boldrows boldnamerows fgcolor
set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
set x [xc $row $col]
set orad [expr {$linespc / 3}]
set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
[expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
- -fill $ofill -outline black -width 1]
+ -fill $ofill -outline $fgcolor -width 1 -tags circle]
$canv raise $t
$canv bind $t <1> {selcanvline {} %x %y}
set xt [xc $row [llength [lindex $rowidlist $row]]]
set nfont $mainfont
set isbold [ishighlighted $row]
if {$isbold > 0} {
+ lappend boldrows $row
lappend font bold
if {$isbold > 1} {
+ lappend boldnamerows $row
lappend nfont bold
}
}
- set linehtag($row) [$canv create text $xt $y -anchor w \
- -text $headline -font $font]
+ set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
+ -text $headline -font $font -tags text]
$canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
- set linentag($row) [$canv2 create text 3 $y -anchor w \
- -text $name -font $nfont]
- set linedtag($row) [$canv3 create text 3 $y -anchor w \
- -text $date -font $mainfont]
+ set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
+ -text $name -font $nfont -tags text]
+ set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
+ -text $date -font $mainfont -tags text]
set xr [expr {$xt + [font measure $mainfont $headline]}]
if {$xr > $canvxmax} {
set canvxmax $xr
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 {$findstring 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)]} return
set col [lsearch -exact [lindex $rowidlist $row] $id]
if {$col < 0} {
proc clear_display {} {
global iddrawn idrangedrawn
- global vhighlights fhighlights nhighlights
+ global vhighlights fhighlights nhighlights rhighlights
allcanvs delete all
catch {unset iddrawn}
catch {unset vhighlights}
catch {unset fhighlights}
catch {unset nhighlights}
+ catch {unset rhighlights}
}
proc findcrossings {id} {
}
proc drawtags {id x xt y1} {
- global idtags idheads idotherrefs
+ global idtags idheads idotherrefs mainhead
global linespc lthickness
- global canv mainfont commitrow rowtextx curview
+ global canv mainfont commitrow rowtextx curview fgcolor bgcolor
set marks {}
set ntags 0
set yb [expr {$yt + $linespc - 1}]
set xvals {}
set wvals {}
+ set i -1
foreach tag $marks {
- set wid [font measure $mainfont $tag]
+ incr i
+ if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
+ set wid [font measure [concat $mainfont bold] $tag]
+ } else {
+ set wid [font measure $mainfont $tag]
+ }
lappend xvals $xt
lappend wvals $wid
set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
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 \
# draw a head or other ref
if {[incr nheads -1] >= 0} {
set col green
+ if {$tag eq $mainhead} {
+ lappend font bold
+ }
} else {
set col "#ddddff"
}
-width 0 -fill "#ffddaa" -tags tag.$id
}
}
- set t [$canv create text $xl $y1 -anchor w -text $tag \
- -font $mainfont -tags tag.$id]
+ set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
+ -font $font -tags [list tag.$id text]]
if {$ntags >= 0} {
$canv bind $t <1> [list showtag $tag 1]
+ } elseif {$nheads >= 0} {
+ $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
}
}
return $xt
}
proc show_status {msg} {
- global canv mainfont
+ global canv mainfont fgcolor
clear_display
- $canv create text 3 3 -anchor nw -text $msg -font $mainfont -tags textitems
+ $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
+ -tags text -fill $fgcolor
}
proc finishcommits {} {
global commitidx phase curview
- global canv mainfont ctext maincursor textcursor
- global findinprogress pending_select
+ global pending_select
if {$commitidx($curview) > 0} {
drawrest
catch {unset pending_select}
}
+# Insert a new commit as the child of the commit on row $row.
+# The new commit will be displayed on row $row and the commits
+# on that row and below will move down one row.
+proc insertrow {row newcmit} {
+ global displayorder parentlist childlist commitlisted
+ global commitrow curview rowidlist rowoffsets numcommits
+ global rowrangelist idrowranges rowlaidout rowoptim numcommits
+ global linesegends selectedline
+
+ if {$row >= $numcommits} {
+ puts "oops, inserting new row $row but only have $numcommits rows"
+ return
+ }
+ set p [lindex $displayorder $row]
+ set displayorder [linsert $displayorder $row $newcmit]
+ set parentlist [linsert $parentlist $row $p]
+ set kids [lindex $childlist $row]
+ lappend kids $newcmit
+ lset childlist $row $kids
+ set childlist [linsert $childlist $row {}]
+ set commitlisted [linsert $commitlisted $row 1]
+ set l [llength $displayorder]
+ for {set r $row} {$r < $l} {incr r} {
+ set id [lindex $displayorder $r]
+ set commitrow($curview,$id) $r
+ }
+
+ set idlist [lindex $rowidlist $row]
+ set offs [lindex $rowoffsets $row]
+ set newoffs {}
+ foreach x $idlist {
+ if {$x eq {} || ($x eq $p && [llength $kids] == 1)} {
+ lappend newoffs {}
+ } else {
+ lappend newoffs 0
+ }
+ }
+ if {[llength $kids] == 1} {
+ set col [lsearch -exact $idlist $p]
+ lset idlist $col $newcmit
+ } else {
+ set col [llength $idlist]
+ lappend idlist $newcmit
+ lappend offs {}
+ lset rowoffsets $row $offs
+ }
+ set rowidlist [linsert $rowidlist $row $idlist]
+ set rowoffsets [linsert $rowoffsets [expr {$row+1}] $newoffs]
+
+ set rowrangelist [linsert $rowrangelist $row {}]
+ set l [llength $rowrangelist]
+ for {set r 0} {$r < $l} {incr r} {
+ set ranges [lindex $rowrangelist $r]
+ if {$ranges ne {} && [lindex $ranges end] >= $row} {
+ set newranges {}
+ foreach x $ranges {
+ if {$x >= $row} {
+ lappend newranges [expr {$x + 1}]
+ } else {
+ lappend newranges $x
+ }
+ }
+ lset rowrangelist $r $newranges
+ }
+ }
+ if {[llength $kids] > 1} {
+ set rp1 [expr {$row + 1}]
+ set ranges [lindex $rowrangelist $rp1]
+ if {$ranges eq {}} {
+ set ranges [list $row $rp1]
+ } elseif {[lindex $ranges end-1] == $rp1} {
+ lset ranges end-1 $row
+ }
+ lset rowrangelist $rp1 $ranges
+ }
+ foreach id [array names idrowranges] {
+ set ranges $idrowranges($id)
+ if {$ranges ne {} && [lindex $ranges end] >= $row} {
+ set newranges {}
+ foreach x $ranges {
+ if {$x >= $row} {
+ lappend newranges [expr {$x + 1}]
+ } else {
+ lappend newranges $x
+ }
+ }
+ set idrowranges($id) $newranges
+ }
+ }
+
+ set linesegends [linsert $linesegends $row {}]
+
+ incr rowlaidout
+ incr rowoptim
+ incr numcommits
+
+ if {[info exists selectedline] && $selectedline >= $row} {
+ incr selectedline
+ }
+ redisplay
+}
+
# Don't change the text pane cursor if it is currently the hand cursor,
# showing that we are over a sha1 ID link.
proc settextcursor {c} {
}
proc drawrest {} {
- global numcommits
global startmsecs
- global canvy0 numcommits linespc
global rowlaidout commitidx curview
global pending_select
}
set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
+ #global numcommits
#puts "overall $drawmsecs ms for $numcommits commits"
}
stopfindproc
unmarkmatches
+ cancel_next_highlight
focus .
set matchinglines {}
if {$findtype == "IgnCase"} {
if {[llength $commitinfo($p)] > 1} {
set l [lindex $commitinfo($p) 0]
}
- return "$p ($l)"
+ return "$p ($l)\n"
}
# append some text to the ctext widget, and make any SHA1 ID
# that we know about be a clickable link.
-proc appendwithlinks {text} {
+proc appendwithlinks {text tags} {
global ctext commitrow linknum curview
set start [$ctext index "end - 1c"]
- $ctext insert end $text
- $ctext insert end "\n"
+ $ctext insert end $text $tags
set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
foreach l $links {
set s [lindex $l 0]
allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
}
+# add a list of tag or branch names at position pos
+# returns the number of names inserted
+proc appendrefs {pos tags var} {
+ global ctext commitrow linknum curview $var
+
+ if {[catch {$ctext index $pos}]} {
+ return 0
+ }
+ set tags [lsort $tags]
+ set sep {}
+ foreach tag $tags {
+ set id [set $var\($tag\)]
+ set lk link$linknum
+ incr linknum
+ $ctext insert $pos $sep
+ $ctext insert $pos $tag $lk
+ $ctext tag conf $lk -foreground blue
+ if {[info exists commitrow($curview,$id)]} {
+ $ctext tag bind $lk <1> \
+ [list selectline $commitrow($curview,$id) 1]
+ $ctext tag conf $lk -underline 1
+ $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
+ $ctext tag bind $lk <Leave> { %W configure -cursor $curtextcursor }
+ }
+ set sep ", "
+ }
+ return [llength $tags]
+}
+
+proc taglist {ids} {
+ global idtags
+
+ set tags {}
+ foreach id $ids {
+ foreach tag $idtags($id) {
+ lappend tags $tag
+ }
+ }
+ return $tags
+}
+
+# called when we have finished computing the nearby tags
+proc dispneartags {} {
+ global selectedline currentid ctext anc_tags desc_tags showneartags
+ global desc_heads
+
+ if {![info exists selectedline] || !$showneartags} return
+ set id $currentid
+ $ctext conf -state normal
+ if {[info exists desc_heads($id)]} {
+ if {[appendrefs branch $desc_heads($id) headids] > 1} {
+ $ctext insert "branch -2c" "es"
+ }
+ }
+ if {[info exists anc_tags($id)]} {
+ appendrefs follows [taglist $anc_tags($id)] tagids
+ }
+ if {[info exists desc_tags($id)]} {
+ appendrefs precedes [taglist $desc_tags($id)] tagids
+ }
+ $ctext conf -state disabled
+}
+
proc selectline {l isnew} {
global canv canv2 canv3 ctext commitinfo selectedline
global displayorder linehtag linentag linedtag
global currentid sha1entry
global commentend idtags linknum
global mergemax numcommits pending_select
- global cmitmode
+ global cmitmode desc_tags anc_tags showneartags allcommits desc_heads
catch {unset pending_select}
$canv delete hover
normalline
+ cancel_next_highlight
if {$l < 0 || $l >= $numcommits} return
set y [expr {$canvy0 + $l * $linespc}]
set ymax [lindex [$canv cget -scrollregion] 3]
$sha1entry insert 0 $id
$sha1entry selection from 0
$sha1entry selection to end
+ rhighlight_sel $id
$ctext conf -state normal
clear_ctext
$ctext insert end "\n"
}
- set comment {}
+ set headers {}
set olds [lindex $parentlist $l]
if {[llength $olds] > 1} {
set np 0
set tag m$np
}
$ctext insert end "Parent: " $tag
- appendwithlinks [commit_descriptor $p]
+ appendwithlinks [commit_descriptor $p] {}
incr np
}
} else {
foreach p $olds {
- append comment "Parent: [commit_descriptor $p]\n"
+ append headers "Parent: [commit_descriptor $p]"
}
}
foreach c [lindex $childlist $l] {
- append comment "Child: [commit_descriptor $c]\n"
+ append headers "Child: [commit_descriptor $c]"
}
- append comment "\n"
- append comment [lindex $info 5]
# make anything that looks like a SHA1 ID be a clickable link
- appendwithlinks $comment
+ appendwithlinks $headers {}
+ if {$showneartags} {
+ if {![info exists allcommits]} {
+ getallcommits
+ }
+ $ctext insert end "Branch: "
+ $ctext mark set branch "end -1c"
+ $ctext mark gravity branch left
+ if {[info exists desc_heads($id)]} {
+ if {[appendrefs branch $desc_heads($id) headids] > 1} {
+ # turn "Branch" into "Branches"
+ $ctext insert "branch -2c" "es"
+ }
+ }
+ $ctext insert end "\nFollows: "
+ $ctext mark set follows "end -1c"
+ $ctext mark gravity follows left
+ if {[info exists anc_tags($id)]} {
+ appendrefs follows [taglist $anc_tags($id)] tagids
+ }
+ $ctext insert end "\nPrecedes: "
+ $ctext mark set precedes "end -1c"
+ $ctext mark gravity precedes left
+ if {[info exists desc_tags($id)]} {
+ appendrefs precedes [taglist $desc_tags($id)] tagids
+ }
+ $ctext insert end "\n"
+ }
+ $ctext insert end "\n"
+ appendwithlinks [lindex $info 5] {comment}
$ctext tag delete Comments
$ctext tag remove found 1.0 end
catch {unset selectedline}
catch {unset currentid}
allcanvs delete secsel
+ rhighlight_none
+ cancel_next_highlight
}
proc reselectline {} {
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 {[catch {set gtf [open [concat | git ls-tree -r $id] r]}]} {
return
}
set treepending $id
return
}
set blob [lindex $treeidlist($diffids) $i]
- if {[catch {set bf [open [concat | git-cat-file blob $blob] r]} err]} {
+ if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
puts "oops, error reading blob $blob: $err"
return
}
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]
+ 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"
return
set treepending $ids
set treediff {}
if {[catch \
- {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
+ {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]
global nextupdate diffinhdr treediffs
set env(GIT_DIFF_OPTS) $diffopts
- set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
+ set cmd [concat | git diff-tree --no-commit-id -r -p -C $ids]
if {[catch {set bdf [open $cmd r]} err]} {
puts "error getting diffs: $err"
return
}
}
+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
}
}
}
drawvisible
if {[info exists selectedline]} {
selectline $selectedline 0
+ allcanvs yview moveto [lindex $span 0]
}
}
set t [$canv create rectangle $x0 $y0 $x1 $y1 \
-fill \#ffff80 -outline black -width 1 -tags hover]
$canv raise $t
- set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
+ set t [$canv create text $x $y -anchor nw -text $text -tags hover \
+ -font $mainfont]
$canv raise $t
}
} else {
set state normal
}
- $rowctxmenu entryconfigure 0 -state $state
- $rowctxmenu entryconfigure 1 -state $state
- $rowctxmenu entryconfigure 2 -state $state
+ $rowctxmenu entryconfigure "Diff this*" -state $state
+ $rowctxmenu entryconfigure "Diff selected*" -state $state
+ $rowctxmenu entryconfigure "Make patch" -state $state
set rowmenuid $id
tk_popup $rowctxmenu $x $y
}
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 {[catch {exec git diff-tree -p $oldid $newid >$fname &} err]} {
error_popup "Error creating patch: $err"
}
catch {destroy $patchtop}
set tagids($tag) $id
lappend idtags($id) $tag
redrawtags $id
+ addedtag $id
}
proc redrawtags {id} {
global canv linehtag commitrow idpos selectedline curview
+ global mainfont canvxmax
if {![info exists commitrow($curview,$id)]} return
drawcmitrow $commitrow($curview,$id)
$canv delete tag.$id
set xt [eval drawtags $id $idpos($id)]
$canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
+ set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
+ set xr [expr {$xt + [font measure $mainfont $text]}]
+ if {$xr > $canvxmax} {
+ set canvxmax $xr
+ setcanvscroll
+ }
if {[info exists selectedline]
&& $selectedline == $commitrow($curview,$id)} {
selectline $selectedline 0
unset wrcomtop
}
-proc listrefs {id} {
- global idtags idheads idotherrefs
+proc mkbranch {} {
+ global rowmenuid mkbrtop
- set x {}
+ set top .makebranch
+ catch {destroy $top}
+ toplevel $top
+ label $top.title -text "Create new branch"
+ grid $top.title - -pady 10
+ label $top.id -text "ID:"
+ entry $top.sha1 -width 40 -relief flat
+ $top.sha1 insert 0 $rowmenuid
+ $top.sha1 conf -state readonly
+ grid $top.id $top.sha1 -sticky w
+ label $top.nlab -text "Name:"
+ entry $top.name -width 40
+ grid $top.nlab $top.name -sticky w
+ frame $top.buts
+ button $top.buts.go -text "Create" -command [list mkbrgo $top]
+ button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
+ grid $top.buts.go $top.buts.can
+ grid columnconfigure $top.buts 0 -weight 1 -uniform a
+ grid columnconfigure $top.buts 1 -weight 1 -uniform a
+ grid $top.buts - -pady 10 -sticky ew
+ focus $top.name
+}
+
+proc mkbrgo {top} {
+ global headids idheads
+
+ set name [$top.name get]
+ set id [$top.sha1 get]
+ if {$name eq {}} {
+ error_popup "Please specify a name for the new branch"
+ return
+ }
+ catch {destroy $top}
+ nowbusy newbranch
+ update
+ if {[catch {
+ exec git branch $name $id
+ } err]} {
+ notbusy newbranch
+ error_popup $err
+ } else {
+ addedhead $id $name
+ # XXX should update list of heads displayed for selected commit
+ notbusy newbranch
+ redrawtags $id
+ }
+}
+
+proc cherrypick {} {
+ global rowmenuid curview commitrow
+ global mainhead desc_heads anc_tags desc_tags allparents allchildren
+
+ if {[info exists desc_heads($rowmenuid)]
+ && [lsearch -exact $desc_heads($rowmenuid) $mainhead] >= 0} {
+ set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
+ included in branch $mainhead -- really re-apply it?"]
+ if {!$ok} return
+ }
+ nowbusy cherrypick
+ update
+ set oldhead [exec git rev-parse HEAD]
+ # Unfortunately git-cherry-pick writes stuff to stderr even when
+ # no error occurs, and exec takes that as an indication of error...
+ if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
+ notbusy cherrypick
+ error_popup $err
+ return
+ }
+ set newhead [exec git rev-parse HEAD]
+ if {$newhead eq $oldhead} {
+ notbusy cherrypick
+ error_popup "No changes committed"
+ return
+ }
+ set allparents($newhead) $oldhead
+ lappend allchildren($oldhead) $newhead
+ set desc_heads($newhead) $mainhead
+ if {[info exists anc_tags($oldhead)]} {
+ set anc_tags($newhead) $anc_tags($oldhead)
+ }
+ set desc_tags($newhead) {}
+ if {[info exists commitrow($curview,$oldhead)]} {
+ insertrow $commitrow($curview,$oldhead) $newhead
+ if {$mainhead ne {}} {
+ movedhead $newhead $mainhead
+ }
+ redrawtags $oldhead
+ redrawtags $newhead
+ }
+ notbusy cherrypick
+}
+
+# context menu for a head
+proc headmenu {x y id head} {
+ global headmenuid headmenuhead headctxmenu
+
+ set headmenuid $id
+ set headmenuhead $head
+ tk_popup $headctxmenu $x $y
+}
+
+proc cobranch {} {
+ global headmenuid headmenuhead mainhead headids
+
+ # check the tree is clean first??
+ set oldmainhead $mainhead
+ nowbusy checkout
+ update
+ if {[catch {
+ exec git checkout $headmenuhead
+ } err]} {
+ notbusy checkout
+ error_popup $err
+ } else {
+ notbusy checkout
+ set mainhead $headmenuhead
+ if {[info exists headids($oldmainhead)]} {
+ redrawtags $headids($oldmainhead)
+ }
+ redrawtags $headmenuid
+ }
+}
+
+proc rmbranch {} {
+ global desc_heads headmenuid headmenuhead mainhead
+ global headids idheads
+
+ set head $headmenuhead
+ set id $headmenuid
+ if {$head eq $mainhead} {
+ error_popup "Cannot delete the currently checked-out branch"
+ return
+ }
+ if {$desc_heads($id) eq $head} {
+ # the stuff on this branch isn't on any other branch
+ if {![confirm_popup "The commits on branch $head aren't on any other\
+ branch.\nReally delete branch $head?"]} return
+ }
+ nowbusy rmbranch
+ update
+ if {[catch {exec git branch -D $head} err]} {
+ notbusy rmbranch
+ error_popup $err
+ return
+ }
+ removedhead $id $head
+ redrawtags $id
+ notbusy rmbranch
+}
+
+# Stuff for finding nearby tags
+proc getallcommits {} {
+ global allcstart allcommits allcfd allids
+
+ set allids {}
+ set fd [open [concat | git rev-list --all --topo-order --parents] r]
+ set allcfd $fd
+ fconfigure $fd -blocking 0
+ set allcommits "reading"
+ nowbusy allcommits
+ restartgetall $fd
+}
+
+proc discardallcommits {} {
+ global allparents allchildren allcommits allcfd
+ global desc_tags anc_tags alldtags tagisdesc allids desc_heads
+
+ if {![info exists allcommits]} return
+ if {$allcommits eq "reading"} {
+ catch {close $allcfd}
+ }
+ foreach v {allcommits allchildren allparents allids desc_tags anc_tags
+ alldtags tagisdesc desc_heads} {
+ catch {unset $v}
+ }
+}
+
+proc restartgetall {fd} {
+ global allcstart
+
+ fileevent $fd readable [list getallclines $fd]
+ set allcstart [clock clicks -milliseconds]
+}
+
+proc combine_dtags {l1 l2} {
+ global tagisdesc notfirstd
+
+ set res [lsort -unique [concat $l1 $l2]]
+ for {set i 0} {$i < [llength $res]} {incr i} {
+ set x [lindex $res $i]
+ for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
+ set y [lindex $res $j]
+ if {[info exists tagisdesc($x,$y)]} {
+ if {$tagisdesc($x,$y) > 0} {
+ # x is a descendent of y, exclude x
+ set res [lreplace $res $i $i]
+ incr i -1
+ break
+ } else {
+ # y is a descendent of x, exclude y
+ set res [lreplace $res $j $j]
+ }
+ } else {
+ # no relation, keep going
+ incr j
+ }
+ }
+ }
+ return $res
+}
+
+proc combine_atags {l1 l2} {
+ global tagisdesc
+
+ set res [lsort -unique [concat $l1 $l2]]
+ for {set i 0} {$i < [llength $res]} {incr i} {
+ set x [lindex $res $i]
+ for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
+ set y [lindex $res $j]
+ if {[info exists tagisdesc($x,$y)]} {
+ if {$tagisdesc($x,$y) < 0} {
+ # x is an ancestor of y, exclude x
+ set res [lreplace $res $i $i]
+ incr i -1
+ break
+ } else {
+ # y is an ancestor of x, exclude y
+ set res [lreplace $res $j $j]
+ }
+ } else {
+ # no relation, keep going
+ incr j
+ }
+ }
+ }
+ return $res
+}
+
+proc forward_pass {id children} {
+ global idtags desc_tags idheads desc_heads alldtags tagisdesc
+
+ set dtags {}
+ set dheads {}
+ foreach child $children {
+ if {[info exists idtags($child)]} {
+ set ctags [list $child]
+ } else {
+ set ctags $desc_tags($child)
+ }
+ if {$dtags eq {}} {
+ set dtags $ctags
+ } elseif {$ctags ne $dtags} {
+ set dtags [combine_dtags $dtags $ctags]
+ }
+ set cheads $desc_heads($child)
+ if {$dheads eq {}} {
+ set dheads $cheads
+ } elseif {$cheads ne $dheads} {
+ set dheads [lsort -unique [concat $dheads $cheads]]
+ }
+ }
+ set desc_tags($id) $dtags
if {[info exists idtags($id)]} {
- set x $idtags($id)
+ set adt $dtags
+ foreach tag $dtags {
+ set adt [concat $adt $alldtags($tag)]
+ }
+ set adt [lsort -unique $adt]
+ set alldtags($id) $adt
+ foreach tag $adt {
+ set tagisdesc($id,$tag) -1
+ set tagisdesc($tag,$id) 1
+ }
}
- set y {}
if {[info exists idheads($id)]} {
- set y $idheads($id)
+ set dheads [concat $dheads $idheads($id)]
}
- set z {}
- if {[info exists idotherrefs($id)]} {
- set z $idotherrefs($id)
+ set desc_heads($id) $dheads
+}
+
+proc getallclines {fd} {
+ global allparents allchildren allcommits allcstart
+ global desc_tags anc_tags idtags tagisdesc allids
+ global idheads travindex
+
+ while {[gets $fd line] >= 0} {
+ set id [lindex $line 0]
+ lappend allids $id
+ set olds [lrange $line 1 end]
+ set allparents($id) $olds
+ if {![info exists allchildren($id)]} {
+ set allchildren($id) {}
+ }
+ foreach p $olds {
+ lappend allchildren($p) $id
+ }
+ # compute nearest tagged descendents as we go
+ # also compute descendent heads
+ forward_pass $id $allchildren($id)
+ if {[clock clicks -milliseconds] - $allcstart >= 50} {
+ fileevent $fd readable {}
+ after idle restartgetall $fd
+ return
+ }
+ }
+ if {[eof $fd]} {
+ set travindex [llength $allids]
+ set allcommits "traversing"
+ after idle restartatags
+ if {[catch {close $fd} err]} {
+ error_popup "Error reading full commit graph: $err.\n\
+ Results may be incomplete."
+ }
+ }
+}
+
+# walk backward through the tree and compute nearest tagged ancestors
+proc restartatags {} {
+ global allids allparents idtags anc_tags travindex
+
+ set t0 [clock clicks -milliseconds]
+ set i $travindex
+ while {[incr i -1] >= 0} {
+ set id [lindex $allids $i]
+ set atags {}
+ foreach p $allparents($id) {
+ if {[info exists idtags($p)]} {
+ set ptags [list $p]
+ } else {
+ set ptags $anc_tags($p)
+ }
+ if {$atags eq {}} {
+ set atags $ptags
+ } elseif {$ptags ne $atags} {
+ set atags [combine_atags $atags $ptags]
+ }
+ }
+ set anc_tags($id) $atags
+ if {[clock clicks -milliseconds] - $t0 >= 50} {
+ set travindex $i
+ after idle restartatags
+ return
+ }
+ }
+ set allcommits "done"
+ set travindex 0
+ notbusy allcommits
+ dispneartags
+}
+
+# update the desc_tags and anc_tags arrays for a new tag just added
+proc addedtag {id} {
+ global desc_tags anc_tags allparents allchildren allcommits
+ global idtags tagisdesc alldtags
+
+ if {![info exists desc_tags($id)]} return
+ set adt $desc_tags($id)
+ foreach t $desc_tags($id) {
+ set adt [concat $adt $alldtags($t)]
+ }
+ set adt [lsort -unique $adt]
+ set alldtags($id) $adt
+ foreach t $adt {
+ set tagisdesc($id,$t) -1
+ set tagisdesc($t,$id) 1
+ }
+ if {[info exists anc_tags($id)]} {
+ set todo $anc_tags($id)
+ while {$todo ne {}} {
+ set do [lindex $todo 0]
+ set todo [lrange $todo 1 end]
+ if {[info exists tagisdesc($id,$do)]} continue
+ set tagisdesc($do,$id) -1
+ set tagisdesc($id,$do) 1
+ if {[info exists anc_tags($do)]} {
+ set todo [concat $todo $anc_tags($do)]
+ }
+ }
+ }
+
+ set lastold $desc_tags($id)
+ set lastnew [list $id]
+ set nup 0
+ set nch 0
+ set todo $allparents($id)
+ while {$todo ne {}} {
+ set do [lindex $todo 0]
+ set todo [lrange $todo 1 end]
+ if {![info exists desc_tags($do)]} continue
+ if {$desc_tags($do) ne $lastold} {
+ set lastold $desc_tags($do)
+ set lastnew [combine_dtags $lastold [list $id]]
+ incr nch
+ }
+ if {$lastold eq $lastnew} continue
+ set desc_tags($do) $lastnew
+ incr nup
+ if {![info exists idtags($do)]} {
+ set todo [concat $todo $allparents($do)]
+ }
+ }
+
+ if {![info exists anc_tags($id)]} return
+ set lastold $anc_tags($id)
+ set lastnew [list $id]
+ set nup 0
+ set nch 0
+ set todo $allchildren($id)
+ while {$todo ne {}} {
+ set do [lindex $todo 0]
+ set todo [lrange $todo 1 end]
+ if {![info exists anc_tags($do)]} continue
+ if {$anc_tags($do) ne $lastold} {
+ set lastold $anc_tags($do)
+ set lastnew [combine_atags $lastold [list $id]]
+ incr nch
+ }
+ if {$lastold eq $lastnew} continue
+ set anc_tags($do) $lastnew
+ incr nup
+ if {![info exists idtags($do)]} {
+ set todo [concat $todo $allchildren($do)]
+ }
+ }
+}
+
+# update the desc_heads array for a new head just added
+proc addedhead {hid head} {
+ global desc_heads allparents headids idheads
+
+ set headids($head) $hid
+ lappend idheads($hid) $head
+
+ set todo [list $hid]
+ while {$todo ne {}} {
+ set do [lindex $todo 0]
+ set todo [lrange $todo 1 end]
+ if {![info exists desc_heads($do)] ||
+ [lsearch -exact $desc_heads($do) $head] >= 0} continue
+ set oldheads $desc_heads($do)
+ lappend desc_heads($do) $head
+ set heads $desc_heads($do)
+ while {1} {
+ set p $allparents($do)
+ if {[llength $p] != 1 || ![info exists desc_heads($p)] ||
+ $desc_heads($p) ne $oldheads} break
+ set do $p
+ set desc_heads($do) $heads
+ }
+ set todo [concat $todo $p]
+ }
+}
+
+# update the desc_heads array for a head just removed
+proc removedhead {hid head} {
+ global desc_heads allparents headids idheads
+
+ unset headids($head)
+ if {$idheads($hid) eq $head} {
+ unset idheads($hid)
+ } else {
+ set i [lsearch -exact $idheads($hid) $head]
+ if {$i >= 0} {
+ set idheads($hid) [lreplace $idheads($hid) $i $i]
+ }
+ }
+
+ set todo [list $hid]
+ while {$todo ne {}} {
+ set do [lindex $todo 0]
+ set todo [lrange $todo 1 end]
+ if {![info exists desc_heads($do)]} continue
+ set i [lsearch -exact $desc_heads($do) $head]
+ if {$i < 0} continue
+ set oldheads $desc_heads($do)
+ set heads [lreplace $desc_heads($do) $i $i]
+ while {1} {
+ set desc_heads($do) $heads
+ set p $allparents($do)
+ if {[llength $p] != 1 || ![info exists desc_heads($p)] ||
+ $desc_heads($p) ne $oldheads} break
+ set do $p
+ }
+ set todo [concat $todo $p]
+ }
+}
+
+# update things for a head moved to a child of its previous location
+proc movedhead {id name} {
+ global headids idheads
+
+ set oldid $headids($name)
+ set headids($name) $id
+ if {$idheads($oldid) eq $name} {
+ unset idheads($oldid)
+ } else {
+ set i [lsearch -exact $idheads($oldid) $name]
+ if {$i >= 0} {
+ set idheads($oldid) [lreplace $idheads($oldid) $i $i]
+ }
+ }
+ lappend idheads($id) $name
+}
+
+proc changedrefs {} {
+ global desc_heads desc_tags anc_tags allcommits allids
+ global allchildren allparents idtags travindex
+
+ if {![info exists allcommits]} return
+ catch {unset desc_heads}
+ catch {unset desc_tags}
+ catch {unset anc_tags}
+ catch {unset alldtags}
+ catch {unset tagisdesc}
+ foreach id $allids {
+ forward_pass $id $allchildren($id)
+ }
+ if {$allcommits ne "reading"} {
+ set travindex [llength $allids]
+ if {$allcommits ne "traversing"} {
+ set allcommits "traversing"
+ after idle restartatags
+ }
}
- return [list $x $y $z]
}
proc rereadrefs {} {
- global idtags idheads idotherrefs
+ global idtags idheads idotherrefs mainhead
set refids [concat [array names idtags] \
[array names idheads] [array names idotherrefs]]
set ref($id) [listrefs $id]
}
}
+ set oldmainhead $mainhead
readrefs
+ changedrefs
set refids [lsort -unique [concat $refids [array names idtags] \
[array names idheads] [array names idotherrefs]]]
foreach id $refids {
set v [listrefs $id]
- if {![info exists ref($id)] || $ref($id) != $v} {
+ if {![info exists ref($id)] || $ref($id) != $v ||
+ ($id eq $oldmainhead && $id ne $mainhead) ||
+ ($id eq $mainhead && $id ne $oldmainhead)} {
redrawtags $id
}
}
}
+proc listrefs {id} {
+ global idtags idheads idotherrefs
+
+ set x {}
+ if {[info exists idtags($id)]} {
+ set x $idtags($id)
+ }
+ set y {}
+ if {[info exists idheads($id)]} {
+ set y $idheads($id)
+ }
+ set z {}
+ if {[info exists idotherrefs($id)]} {
+ set z $idotherrefs($id)
+ }
+ return [list $x $y $z]
+}
+
proc showtag {tag isnew} {
global ctext tagcontents tagids linknum
} else {
set text "Tag: $tag\nId: $tagids($tag)"
}
- appendwithlinks $text
+ appendwithlinks $text {}
$ctext conf -state disabled
init_flist {}
}
proc doprefs {} {
global maxwidth maxgraphpct diffopts
- global oldprefs prefstop
+ global oldprefs prefstop showneartags
+ global bgcolor fgcolor ctext diffcolors
set top .gitkprefs
set prefstop $top
raise $top
return
}
- foreach v {maxwidth maxgraphpct diffopts} {
+ foreach v {maxwidth maxgraphpct diffopts showneartags} {
set oldprefs($v) [set $v]
}
toplevel $top
-font optionfont
spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
grid x $top.maxpctl $top.maxpct -sticky w
+
label $top.ddisp -text "Diff display options"
grid $top.ddisp - -sticky w -pady 10
label $top.diffoptl -text "Options for diff program" \
-font optionfont
entry $top.diffopt -width 20 -textvariable diffopts
grid x $top.diffoptl $top.diffopt -sticky w
+ frame $top.ntag
+ label $top.ntag.l -text "Display nearby tags" -font optionfont
+ checkbutton $top.ntag.b -variable showneartags
+ pack $top.ntag.b $top.ntag.l -side left
+ grid x $top.ntag -sticky w
+
+ label $top.cdisp -text "Colors: press to choose"
+ grid $top.cdisp - -sticky w -pady 10
+ label $top.bg -padx 40 -relief sunk -background $bgcolor
+ button $top.bgbut -text "Background" -font optionfont \
+ -command [list choosecolor bgcolor 0 $top.bg background setbg]
+ grid x $top.bgbut $top.bg -sticky w
+ label $top.fg -padx 40 -relief sunk -background $fgcolor
+ button $top.fgbut -text "Foreground" -font optionfont \
+ -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
+ grid x $top.fgbut $top.fg -sticky w
+ label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
+ button $top.diffoldbut -text "Diff: old lines" -font optionfont \
+ -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
+ [list $ctext tag conf d0 -foreground]]
+ grid x $top.diffoldbut $top.diffold -sticky w
+ label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
+ button $top.diffnewbut -text "Diff: new lines" -font optionfont \
+ -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
+ [list $ctext tag conf d1 -foreground]]
+ grid x $top.diffnewbut $top.diffnew -sticky w
+ label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
+ button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
+ -command [list choosecolor diffcolors 2 $top.hunksep \
+ "diff hunk header" \
+ [list $ctext tag conf hunksep -foreground]]
+ grid x $top.hunksepbut $top.hunksep -sticky w
+
frame $top.buts
button $top.buts.ok -text "OK" -command prefsok
button $top.buts.can -text "Cancel" -command prefscan
grid $top.buts - - -pady 10 -sticky ew
}
+proc choosecolor {v vi w x cmd} {
+ global $v
+
+ set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
+ -title "Gitk: choose color for $x"]
+ if {$c eq {}} return
+ $w conf -background $c
+ lset $v $vi $c
+ eval $cmd $c
+}
+
+proc setbg {c} {
+ global bglist
+
+ foreach w $bglist {
+ $w conf -background $c
+ }
+}
+
+proc setfg {c} {
+ global fglist canv
+
+ foreach w $fglist {
+ $w conf -foreground $c
+ }
+ allcanvs itemconf text -fill $c
+ $canv itemconf circle -outline $c
+}
+
proc prefscan {} {
global maxwidth maxgraphpct diffopts
- global oldprefs prefstop
+ global oldprefs prefstop showneartags
- foreach v {maxwidth maxgraphpct diffopts} {
+ foreach v {maxwidth maxgraphpct diffopts showneartags} {
set $v $oldprefs($v)
}
catch {destroy $prefstop}
proc prefsok {} {
global maxwidth maxgraphpct
- global oldprefs prefstop
+ global oldprefs prefstop showneartags
catch {destroy $prefstop}
unset prefstop
if {$maxwidth != $oldprefs(maxwidth)
|| $maxgraphpct != $oldprefs(maxgraphpct)} {
redisplay
+ } elseif {$showneartags != $oldprefs(showneartags)} {
+ reselectline
}
}
# defaults...
set datemode 0
set diffopts "-U 5 -p"
-set wrcomcmd "git-diff-tree --stdin -p --pretty"
+set wrcomcmd "git diff-tree --stdin -p --pretty"
set gitencoding {}
catch {
- set gitencoding [exec git-repo-config --get i18n.commitencoding]
+ set gitencoding [exec git repo-config --get i18n.commitencoding]
}
if {$gitencoding == ""} {
set gitencoding "utf-8"
set downarrowlen 7
set mingaplen 30
set cmitmode "patch"
+set wrapcomment "none"
+set showneartags 1
set colors {green red blue magenta darkgrey brown orange}
+set bgcolor white
+set fgcolor black
+set diffcolors {red "#00a000" blue}
catch {source ~/.gitk}
# check that we can find a .git directory somewhere...
set gitdir [gitdir]
if {![file isdirectory $gitdir]} {
- show_error . "Cannot find the git directory \"$gitdir\"."
+ show_error {} . "Cannot find the git directory \"$gitdir\"."
exit 1
}
set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
} elseif {$revtreeargs ne {}} {
if {[catch {
- set f [eval exec git-rev-parse --no-revs --no-flags $revtreeargs]
+ 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]
# so look for "fatal:".
set i [string first "fatal:" $err]
if {$i > 0} {
- set err [string range [expr {$i + 6}] end]
+ set err [string range $err [expr {$i + 6}] end]
}
- show_error . "Bad arguments to gitk:\n$err"
+ show_error {} . "Bad arguments to gitk:\n$err"
exit 1
}
}
set nhl_names {}
set highlight_paths {}
set searchdirn -forwards
+set boldrows {}
+set boldnamerows {}
set optim_delay 16
set viewargs(1) $revtreeargs
set viewperm(1) 0
addviewmenu 1
- .bar.view entryconf 2 -state normal
- .bar.view entryconf 3 -state normal
+ .bar.view entryconf Edit* -state normal
+ .bar.view entryconf Delete* -state normal
}
if {[info exists permviews]} {