lappend runq [list $fd $script]
}
+proc nukefile {fd} {
+ global runq
+
+ for {set i 0} {$i < [llength $runq]} {} {
+ if {[lindex $runq $i 0] eq $fd} {
+ set runq [lreplace $runq $i $i]
+ } else {
+ incr i
+ }
+ }
+}
+
proc dorunq {} {
global isonrunq runq
set tstart [clock clicks -milliseconds]
set t0 $tstart
- while {$runq ne {}} {
+ while {[llength $runq] > 0} {
set fd [lindex $runq 0 0]
set script [lindex $runq 0 1]
set repeat [eval $script]
global viewargs viewfiles commitidx viewcomplete vnextroot
global showlocalchanges commitinterest mainheadid
global progressdirn progresscoords proglastnc curview
+ global viewincl viewactive loginstance viewinstances
set startmsecs [clock clicks -milliseconds]
set commitidx($view) 0
set viewcomplete($view) 0
+ set viewactive($view) 1
set vnextroot($view) 0
- set order "--topo-order"
- if {$datemode} {
- set order "--date-order"
+ varcinit $view
+
+ set commits [exec git rev-parse --default HEAD --revs-only \
+ $viewargs($view)]
+ set viewincl($view) {}
+ foreach c $commits {
+ if {![string match "^*" $c]} {
+ lappend viewincl($view) $c
+ }
}
if {[catch {
- set fd [open [concat | git log -z --pretty=raw $order --parents \
- --boundary $viewargs($view) "--" $viewfiles($view)] r]
+ set fd [open [concat | git log --no-color -z --pretty=raw --parents \
+ --boundary $commits "--" $viewfiles($view)] r]
} err]} {
- error_popup "Error executing git rev-list: $err"
+ error_popup "Error executing git log: $err"
exit 1
}
- set commfd($view) $fd
- set leftover($view) {}
+ set i [incr loginstance]
+ set viewinstances($view) [list $i]
+ set commfd($i) $fd
+ set leftover($i) {}
if {$showlocalchanges} {
lappend commitinterest($mainheadid) {dodiffindex}
}
if {$tclencoding != {}} {
fconfigure $fd -encoding $tclencoding
}
- filerun $fd [list getcommitlines $fd $view]
- nowbusy $view
+ filerun $fd [list getcommitlines $fd $i $view]
+ nowbusy $view "Reading"
if {$view == $curview} {
set progressdirn 1
set progresscoords {0 0}
}
}
-proc stop_rev_list {} {
- global commfd curview
+proc stop_rev_list {view} {
+ global commfd viewinstances leftover
- if {![info exists commfd($curview)]} return
- set fd $commfd($curview)
- catch {
- set pid [pid $fd]
- exec kill $pid
+ foreach inst $viewinstances($view) {
+ set fd $commfd($inst)
+ catch {
+ set pid [pid $fd]
+ exec kill $pid
+ }
+ catch {close $fd}
+ nukefile $fd
+ unset commfd($inst)
+ unset leftover($inst)
}
- catch {close $fd}
- unset commfd($curview)
+ set viewinstances($view) {}
}
proc getcommits {} {
- global phase canv mainfont curview
+ global canv curview
- set phase getcommits
initlayout
start_rev_list $curview
show_status "Reading commits..."
}
+proc updatecommits {} {
+ global curview viewargs viewfiles viewincl viewinstances
+ global viewactive viewcomplete loginstance tclencoding
+ global varcid startmsecs commfd getdbg showneartags leftover
+
+ set getdbg 1
+ set view $curview
+ set commits [exec git rev-parse --default HEAD --revs-only \
+ $viewargs($view)]
+ set pos {}
+ set neg {}
+ foreach c $commits {
+ if {[string match "^*" $c]} {
+ lappend neg $c
+ } else {
+ if {!([info exists varcid($view,$c)] ||
+ [lsearch -exact $viewincl($view) $c] >= 0)} {
+ lappend pos $c
+ }
+ }
+ }
+ if {$pos eq {}} {
+ return
+ }
+ foreach id $viewincl($view) {
+ lappend neg "^$id"
+ }
+ set viewincl($view) [concat $viewincl($view) $pos]
+ if {[catch {
+ set fd [open [concat | git log --no-color -z --pretty=raw --parents \
+ --boundary $pos $neg "--" $viewfiles($view)] r]
+ } err]} {
+ error_popup "Error executing git log: $err"
+ exit 1
+ }
+ if {$viewactive($view) == 0} {
+ set startmsecs [clock clicks -milliseconds]
+ }
+ set i [incr loginstance]
+ lappend viewinstances($view) $i
+ set commfd($i) $fd
+ set leftover($i) {}
+ fconfigure $fd -blocking 0 -translation lf -eofchar {}
+ if {$tclencoding != {}} {
+ fconfigure $fd -encoding $tclencoding
+ }
+ filerun $fd [list getcommitlines $fd $i $view]
+ incr viewactive($view)
+ set viewcomplete($view) 0
+ nowbusy $view "Reading"
+ readrefs
+ changedrefs
+ if {$showneartags} {
+ getallcommits
+ }
+}
+
+proc reloadcommits {} {
+ global curview viewcomplete selectedline currentid thickerline
+ global showneartags treediffs commitinterest cached_commitrow
+ global progresscoords
+
+ if {!$viewcomplete($curview)} {
+ stop_rev_list $curview
+ set progresscoords {0 0}
+ adjustprogress
+ }
+ resetvarcs $curview
+ catch {unset selectedline}
+ catch {unset currentid}
+ catch {unset thickerline}
+ catch {unset treediffs}
+ readrefs
+ changedrefs
+ if {$showneartags} {
+ getallcommits
+ }
+ clear_display
+ catch {unset commitinterest}
+ catch {unset cached_commitrow}
+ setcanvscroll
+ getcommits
+}
+
# This makes a string representation of a positive integer which
# sorts as a string in numerical order
proc strrep {n} {
return [format "z%.8x" $n]
}
-proc getcommitlines {fd view} {
- global commitlisted commitinterest
- global leftover commfd
- global displayorder commitidx viewcomplete commitrow commitdata
- global parentlist children curview hlview
- global vparentlist vdisporder vcmitlisted
+# Procedures used in reordering commits from git log (without
+# --topo-order) into the order for display.
+
+proc varcinit {view} {
+ global vseeds varcstart vupptr vdownptr vleftptr varctok varcrow
+ global vtokmod varcmod varcix uat
+
+ set vseeds($view) {}
+ set varcstart($view) {{}}
+ set vupptr($view) {0}
+ set vdownptr($view) {0}
+ set vleftptr($view) {0}
+ set varctok($view) {{}}
+ set varcrow($view) {{}}
+ set vtokmod($view) {}
+ set varcmod($view) 0
+ set varcix($view) {{}}
+ set uat 0
+}
+
+proc resetvarcs {view} {
+ global varcid varccommits parents children vseedcount ordertok
+
+ foreach vid [array names varcid $view,*] {
+ unset varcid($vid)
+ unset children($vid)
+ unset parents($vid)
+ }
+ # some commits might have children but haven't been seen yet
+ foreach vid [array names children $view,*] {
+ unset children($vid)
+ }
+ foreach va [array names varccommits $view,*] {
+ unset varccommits($va)
+ }
+ foreach vd [array names vseedcount $view,*] {
+ unset vseedcount($vd)
+ }
+ foreach vid [array names ordertok $view,*] {
+ unset ordertok($vid)
+ }
+}
+
+proc newvarc {view id} {
+ global varcid varctok parents children vseeds
+ global vupptr vdownptr vleftptr varcrow varcix varcstart
+ global commitdata commitinfo vseedcount
+
+ set a [llength $varctok($view)]
+ set vid $view,$id
+ if {[llength $children($vid)] == 0} {
+ if {![info exists commitinfo($id)]} {
+ parsecommit $id $commitdata($id) 1
+ }
+ set cdate [lindex $commitinfo($id) 4]
+ if {![string is integer -strict $cdate]} {
+ set cdate 0
+ }
+ if {![info exists vseedcount($view,$cdate)]} {
+ set vseedcount($view,$cdate) -1
+ }
+ set c [incr vseedcount($view,$cdate)]
+ set cdate [expr {$cdate ^ 0xffffffff}]
+ set tok "s[strrep $cdate][strrep $c]"
+ lappend vseeds($view) $id
+ lappend vupptr($view) 0
+ set ka [lindex $vdownptr($view) 0]
+ if {$ka == 0 ||
+ [string compare $tok [lindex $varctok($view) $ka]] < 0} {
+ lset vdownptr($view) 0 $a
+ lappend vleftptr($view) $ka
+ } else {
+ while {[set b [lindex $vleftptr($view) $ka]] != 0 &&
+ [string compare $tok [lindex $varctok($view) $b]] >= 0} {
+ set ka $b
+ }
+ lset vleftptr($view) $ka $a
+ lappend vleftptr($view) $b
+ }
+ } else {
+ set tok {}
+ foreach k $children($vid) {
+ set ka $varcid($view,$k)
+ if {[string compare [lindex $varctok($view) $ka] $tok] > 0} {
+ set ki $k
+ set tok [lindex $varctok($view) $ka]
+ }
+ }
+ set ka $varcid($view,$ki)
+ lappend vupptr($view) $ka
+ set i [lsearch -exact $parents($view,$ki) $id]
+ set j [expr {[llength $parents($view,$ki)] - 1 - $i}]
+ set rsib 0
+ while {[incr i] < [llength $parents($view,$ki)]} {
+ set bi [lindex $parents($view,$ki) $i]
+ if {[info exists varcid($view,$bi)]} {
+ set b $varcid($view,$bi)
+ if {[lindex $vupptr($view) $b] == $ka} {
+ set rsib $b
+ lappend vleftptr($view) [lindex $vleftptr($view) $b]
+ lset vleftptr($view) $b $a
+ break
+ }
+ }
+ }
+ if {$rsib == 0} {
+ lappend vleftptr($view) [lindex $vdownptr($view) $ka]
+ lset vdownptr($view) $ka $a
+ }
+ append tok [strrep $j]
+ }
+ lappend varctok($view) $tok
+ lappend varcstart($view) $id
+ lappend vdownptr($view) 0
+ lappend varcrow($view) {}
+ lappend varcix($view) {}
+ return $a
+}
+
+proc splitvarc {p v} {
+ global varcid varcstart varccommits varctok
+ global vupptr vdownptr vleftptr varcix varcrow
+
+ set oa $varcid($v,$p)
+ set ac $varccommits($v,$oa)
+ set i [lsearch -exact $varccommits($v,$oa) $p]
+ if {$i <= 0} return
+ set na [llength $varctok($v)]
+ # "%" sorts before "0"...
+ set tok "[lindex $varctok($v) $oa]%[strrep $i]"
+ lappend varctok($v) $tok
+ lappend varcrow($v) {}
+ lappend varcix($v) {}
+ set varccommits($v,$oa) [lrange $ac 0 [expr {$i - 1}]]
+ set varccommits($v,$na) [lrange $ac $i end]
+ lappend varcstart($v) $p
+ foreach id $varccommits($v,$na) {
+ set varcid($v,$id) $na
+ }
+ lappend vdownptr($v) [lindex $vdownptr($v) $oa]
+ lset vdownptr($v) $oa $na
+ lappend vupptr($v) $oa
+ lappend vleftptr($v) 0
+ for {set b [lindex $vdownptr($v) $na]} {$b != 0} {set b [lindex $vleftptr($v) $b]} {
+ lset vupptr($v) $b $na
+ }
+}
+
+proc renumbervarc {a v} {
+ global parents children varctok varcstart varccommits
+ global vupptr vdownptr vleftptr varcid vtokmod varcmod
+
+ set t1 [clock clicks -milliseconds]
+ set todo {}
+ set isrelated($a) 1
+ set ntot 0
+ while {$a != 0} {
+ if {[info exists isrelated($a)]} {
+ lappend todo $a
+ set id [lindex $varccommits($v,$a) end]
+ foreach p $parents($v,$id) {
+ if {[info exists varcid($v,$p)]} {
+ set isrelated($varcid($v,$p)) 1
+ }
+ }
+ }
+ incr ntot
+ set b [lindex $vdownptr($v) $a]
+ if {$b == 0} {
+ while {$a != 0} {
+ set b [lindex $vleftptr($v) $a]
+ if {$b != 0} break
+ set a [lindex $vupptr($v) $a]
+ }
+ }
+ set a $b
+ }
+ foreach a $todo {
+ set id [lindex $varcstart($v) $a]
+ set tok {}
+ foreach k $children($v,$id) {
+ set ka $varcid($v,$k)
+ if {[string compare [lindex $varctok($v) $ka] $tok] > 0} {
+ set ki $k
+ set tok [lindex $varctok($v) $ka]
+ }
+ }
+ if {$tok ne {}} {
+ set ka $varcid($v,$ki)
+ set i [lsearch -exact $parents($v,$ki) $id]
+ set j [expr {[llength $parents($v,$ki)] - 1 - $i}]
+ append tok [strrep $j]
+ set oldtok [lindex $varctok($v) $a]
+ if {$tok eq $oldtok} continue
+ lset varctok($v) $a $tok
+ } else {
+ set ka 0
+ }
+ set b [lindex $vupptr($v) $a]
+ if {$b != $ka} {
+ set tok [lindex $varctok($v) $ka]
+ if {[string compare $tok $vtokmod($v)] < 0} {
+ set vtokmod($v) $tok
+ set varcmod($v) $ka
+ }
+ set tok [lindex $varctok($v) $b]
+ if {[string compare $tok $vtokmod($v)] < 0} {
+ set vtokmod($v) $tok
+ set varcmod($v) $b
+ }
+ set c [lindex $vdownptr($v) $b]
+ if {$c == $a} {
+ lset vdownptr($v) $b [lindex $vleftptr($v) $a]
+ } else {
+ set b $c
+ while {$b != 0 && [lindex $vleftptr($v) $b] != $a} {
+ set b [lindex $vleftptr($v) $b]
+ }
+ if {$b != 0} {
+ lset vleftptr($v) $b [lindex $vleftptr($v) $a]
+ } else {
+ puts "oops couldn't find $a in chain for [lindex $vupptr($v) $a]"
+ }
+ }
+ lset vupptr($v) $a $ka
+ set rsib 0
+ while {[incr i] < [llength $parents($v,$ki)]} {
+ set bi [lindex $parents($v,$ki) $i]
+ if {[info exists varcid($v,$bi)]} {
+ set b $varcid($v,$bi)
+ if {[lindex $vupptr($v) $b] == $ka} {
+ set rsib $b
+ lset vleftptr($v) $a [lindex $vleftptr($v) $b]
+ lset vleftptr($v) $b $a
+ break
+ }
+ }
+ }
+ if {$rsib == 0} {
+ lset vleftptr($v) $a [lindex $vdownptr($v) $ka]
+ lset vdownptr($v) $ka $a
+ }
+ }
+ }
+ set t2 [clock clicks -milliseconds]
+ #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
+}
+
+proc fix_reversal {p a v} {
+ global varcid varcstart varctok vupptr vseeds
+
+ set pa $varcid($v,$p)
+ if {$p ne [lindex $varcstart($v) $pa]} {
+ splitvarc $p $v
+ set pa $varcid($v,$p)
+ }
+ # seeds always need to be renumbered (and taken out of the seeds list)
+ if {[lindex $vupptr($v) $pa] == 0} {
+ set i [lsearch -exact $vseeds($v) $p]
+ if {$i >= 0} {
+ set vseeds($v) [lreplace $vseeds($v) $i $i]
+ } else {
+ puts "oops couldn't find [shortids $p] in seeds"
+ }
+ renumbervarc $pa $v
+ } elseif {[string compare [lindex $varctok($v) $a] \
+ [lindex $varctok($v) $pa]] > 0} {
+ renumbervarc $pa $v
+ }
+}
+
+proc insertrow {id p v} {
+ global varcid varccommits parents children cmitlisted ordertok
+ global commitidx varctok vtokmod varcmod
+
+ set a $varcid($v,$p)
+ set i [lsearch -exact $varccommits($v,$a) $p]
+ if {$i < 0} {
+ puts "oops: insertrow can't find [shortids $p] on arc $a"
+ return
+ }
+ set children($v,$id) {}
+ set parents($v,$id) [list $p]
+ set varcid($v,$id) $a
+ if {[llength [lappend children($v,$p) $id]] > 1 &&
+ [vtokcmp $v [lindex $children($v,$p) end-1] $id] > 0} {
+ set children($v,$p) [lsort -command [list vtokcmp $v] $children($v,$p)]
+ }
+ set cmitlisted($v,$id) 1
+ incr commitidx($v)
+ set ordertok($v,$id) $ordertok($v,$p)
+ # note we deliberately don't update varcstart($v) even if $i == 0
+ set varccommits($v,$a) [linsert $varccommits($v,$a) $i $id]
+ set tok [lindex $varctok($v) $a]
+ if {[string compare $tok $vtokmod($v)] < 0} {
+ set vtokmod($v) $tok
+ set varcmod($v) $a
+ }
+ update_arcrows $v
+}
+
+proc removerow {id v} {
+ global varcid varccommits parents children commitidx ordertok
+ global varctok vtokmod varcmod
+
+ if {[llength $parents($v,$id)] != 1} {
+ puts "oops: removerow [shortids $id] has [llength $parents($v,$id)] parents"
+ return
+ }
+ set p [lindex $parents($v,$id) 0]
+ set a $varcid($v,$id)
+ set i [lsearch -exact $varccommits($v,$a) $id]
+ if {$i < 0} {
+ puts "oops: removerow can't find [shortids $id] on arc $a"
+ return
+ }
+ unset varcid($v,$id)
+ set varccommits($v,$a) [lreplace $varccommits($v,$a) $i $i]
+ unset parents($v,$id)
+ unset children($v,$id)
+ unset cmitlisted($v,$id)
+ unset ordertok($v,$id)
+ incr commitidx($v) -1
+ set j [lsearch -exact $children($v,$p) $id]
+ if {$j >= 0} {
+ set children($v,$p) [lreplace $children($v,$p) $j $j]
+ }
+ set tok [lindex $varctok($v) $a]
+ if {[string compare $tok $vtokmod($v)] < 0} {
+ set vtokmod($v) $tok
+ set varcmod($v) $a
+ }
+ update_arcrows $v
+}
+
+proc vtokcmp {v a b} {
+ global varctok varcid
+
+ return [string compare [lindex $varctok($v) $varcid($v,$a)] \
+ [lindex $varctok($v) $varcid($v,$b)]]
+}
+
+proc update_arcrows {v} {
+ global vtokmod varcmod varcrow commitidx currentid selectedline
+ global varcid vseeds vrownum varcorder varcix varccommits
+ global vupptr vdownptr vleftptr varctok
+ global uat displayorder parentlist curview cached_commitrow
+
+ set t1 [clock clicks -milliseconds]
+ set narctot [expr {[llength $varctok($v)] - 1}]
+ set a $varcmod($v)
+ while {$a != 0 && [lindex $varcix($v) $a] eq {}} {
+ # go up the tree until we find something that has a row number,
+ # or we get to a seed
+ set a [lindex $vupptr($v) $a]
+ }
+ if {$a == 0} {
+ set a [lindex $vdownptr($v) 0]
+ if {$a == 0} return
+ set vrownum($v) {0}
+ set varcorder($v) [list $a]
+ lset varcix($v) $a 0
+ lset varcrow($v) $a 0
+ set arcn 0
+ set row 0
+ } else {
+ set arcn [lindex $varcix($v) $a]
+ # see if a is the last arc; if so, nothing to do
+ if {$arcn == $narctot - 1} {
+ return
+ }
+ if {[llength $vrownum($v)] > $arcn + 1} {
+ set vrownum($v) [lrange $vrownum($v) 0 $arcn]
+ set varcorder($v) [lrange $varcorder($v) 0 $arcn]
+ }
+ set row [lindex $varcrow($v) $a]
+ }
+ if {[llength $displayorder] > $row} {
+ set displayorder [lrange $displayorder 0 [expr {$row - 1}]]
+ set parentlist [lrange $parentlist 0 [expr {$row - 1}]]
+ }
+ if {$v == $curview} {
+ catch {unset cached_commitrow}
+ }
+ set startrow $row
+ while {1} {
+ set p $a
+ incr row [llength $varccommits($v,$a)]
+ # go down if possible
+ set b [lindex $vdownptr($v) $a]
+ if {$b == 0} {
+ # if not, go left, or go up until we can go left
+ while {$a != 0} {
+ set b [lindex $vleftptr($v) $a]
+ if {$b != 0} break
+ set a [lindex $vupptr($v) $a]
+ }
+ if {$a == 0} break
+ }
+ set a $b
+ incr arcn
+ lappend vrownum($v) $row
+ lappend varcorder($v) $a
+ lset varcix($v) $a $arcn
+ lset varcrow($v) $a $row
+ }
+ if {[info exists currentid]} {
+ set selectedline [rowofcommit $currentid]
+ }
+ undolayout $startrow
+ if {$row != $commitidx($v)} {
+ puts "oops update_arcrows got to row $row out of $commitidx($v)"
+ set vtokmod($v) {}
+ set varcmod($v) 0
+ } else {
+ set vtokmod($v) [lindex $varctok($v) $p]
+ set varcmod($v) $p
+ }
+ set t2 [clock clicks -milliseconds]
+ incr uat [expr {$t2-$t1}]
+}
+
+# Test whether view $v contains commit $id
+proc commitinview {id v} {
+ global varcid
+
+ return [info exists varcid($v,$id)]
+}
+
+# Return the row number for commit $id in the current view
+proc rowofcommit {id} {
+ global varcid varccommits varcrow curview cached_commitrow
+
+ if {[info exists cached_commitrow($id)]} {
+ return $cached_commitrow($id)
+ }
+ set v $curview
+ if {![info exists varcid($v,$id)]} {
+ puts "oops rowofcommit no arc for [shortids $id]"
+ return {}
+ }
+ set a $varcid($v,$id)
+ set i [lsearch -exact $varccommits($v,$a) $id]
+ if {$i < 0} {
+ puts "oops didn't find commit [shortids $id] in arc $a"
+ return {}
+ }
+ incr i [lindex $varcrow($v) $a]
+ set cached_commitrow($id) $i
+ return $i
+}
+
+proc bsearch {l elt} {
+ if {[llength $l] == 0 || $elt <= [lindex $l 0]} {
+ return 0
+ }
+ set lo 0
+ set hi [llength $l]
+ while {$hi - $lo > 1} {
+ set mid [expr {int(($lo + $hi) / 2)}]
+ set t [lindex $l $mid]
+ if {$elt < $t} {
+ set hi $mid
+ } elseif {$elt > $t} {
+ set lo $mid
+ } else {
+ return $mid
+ }
+ }
+ return $lo
+}
+
+# Make sure rows $start..$end-1 are valid in displayorder and parentlist
+proc make_disporder {start end} {
+ global vrownum curview commitidx displayorder parentlist
+ global varccommits varcorder parents
+ global d_valid_start d_valid_end
+
+ set ai [bsearch $vrownum($curview) $start]
+ set start [lindex $vrownum($curview) $ai]
+ set narc [llength $vrownum($curview)]
+ for {set r $start} {$ai < $narc && $r < $end} {incr ai} {
+ set a [lindex $varcorder($curview) $ai]
+ set l [llength $displayorder]
+ set al [llength $varccommits($curview,$a)]
+ if {$l < $r + $al} {
+ if {$l < $r} {
+ set pad [ntimes [expr {$r - $l}] {}]
+ set displayorder [concat $displayorder $pad]
+ set parentlist [concat $parentlist $pad]
+ } elseif {$l > $r} {
+ set displayorder [lrange $displayorder 0 [expr {$r - 1}]]
+ set parentlist [lrange $parentlist 0 [expr {$r - 1}]]
+ }
+ foreach id $varccommits($curview,$a) {
+ lappend displayorder $id
+ lappend parentlist $parents($curview,$id)
+ }
+ } elseif {[lindex $displayorder $r] eq {}} {
+ set i $r
+ foreach id $varccommits($curview,$a) {
+ lset displayorder $i $id
+ lset parentlist $i $parents($curview,$id)
+ incr i
+ }
+ }
+ incr r $al
+ }
+}
+
+proc commitonrow {row} {
+ global displayorder
+
+ set id [lindex $displayorder $row]
+ if {$id eq {}} {
+ make_disporder $row [expr {$row + 1}]
+ set id [lindex $displayorder $row]
+ }
+ return $id
+}
+
+proc closevarcs {v} {
+ global varctok varccommits varcid parents children
+ global cmitlisted commitidx commitinterest vtokmod varcmod
+
+ set missing_parents 0
+ set scripts {}
+ set narcs [llength $varctok($v)]
+ for {set a 1} {$a < $narcs} {incr a} {
+ set id [lindex $varccommits($v,$a) end]
+ foreach p $parents($v,$id) {
+ if {[info exists varcid($v,$p)]} continue
+ # add p as a new commit
+ incr missing_parents
+ set cmitlisted($v,$p) 0
+ set parents($v,$p) {}
+ if {[llength $children($v,$p)] == 1 &&
+ [llength $parents($v,$id)] == 1} {
+ set b $a
+ } else {
+ set b [newvarc $v $p]
+ }
+ set varcid($v,$p) $b
+ lappend varccommits($v,$b) $p
+ set tok [lindex $varctok($v) $b]
+ if {[string compare $tok $vtokmod($v)] < 0} {
+ set vtokmod($v) $tok
+ set varcmod($v) $b
+ }
+ incr commitidx($v)
+ if {[info exists commitinterest($p)]} {
+ foreach script $commitinterest($p) {
+ lappend scripts [string map [list "%I" $p] $script]
+ }
+ unset commitinterest($id)
+ }
+ }
+ }
+ if {$missing_parents > 0} {
+ update_arcrows $v
+ foreach s $scripts {
+ eval $s
+ }
+ }
+}
+
+proc getcommitlines {fd inst view} {
+ global cmitlisted commitinterest leftover getdbg
+ global commitidx commitdata
+ global parents children curview hlview
global ordertok vnextroot idpending
+ global varccommits varcid varctok vtokmod varcmod
set stuff [read $fd 500000]
# git log doesn't terminate the last commit with a null...
- if {$stuff == {} && $leftover($view) ne {} && [eof $fd]} {
+ if {$stuff == {} && $leftover($inst) ne {} && [eof $fd]} {
set stuff "\0"
}
if {$stuff == {}} {
if {![eof $fd]} {
return 1
}
- # Check if we have seen any ids listed as parents that haven't
- # appeared in the list
- foreach vid [array names idpending "$view,*"] {
- # should only get here if git log is buggy
- set id [lindex [split $vid ","] 1]
- set commitrow($vid) $commitidx($view)
- incr commitidx($view)
- if {$view == $curview} {
- lappend parentlist {}
- lappend displayorder $id
- lappend commitlisted 0
- } else {
- lappend vparentlist($view) {}
- lappend vdisporder($view) $id
- lappend vcmitlisted($view) 0
- }
+ global commfd viewcomplete viewactive viewname progresscoords
+ global viewinstances
+ unset commfd($inst)
+ set i [lsearch -exact $viewinstances($view) $inst]
+ if {$i >= 0} {
+ set viewinstances($view) [lreplace $viewinstances($view) $i $i]
}
- set viewcomplete($view) 1
- global viewname progresscoords
- unset commfd($view)
- notbusy $view
- set progresscoords {0 0}
- adjustprogress
# set it blocking so we wait for the process to terminate
fconfigure $fd -blocking 1
if {[catch {close $fd} err]} {
}
error_popup $err
}
+ if {[incr viewactive($view) -1] <= 0} {
+ set viewcomplete($view) 1
+ # Check if we have seen any ids listed as parents that haven't
+ # appeared in the list
+ closevarcs $view
+ notbusy $view
+ set progresscoords {0 0}
+ adjustprogress
+ }
if {$view == $curview} {
run chewcommits $view
}
}
set start 0
set gotsome 0
+ set scripts {}
while 1 {
set i [string first "\0" $stuff $start]
if {$i < 0} {
- append leftover($view) [string range $stuff $start end]
+ append leftover($inst) [string range $stuff $start end]
break
}
if {$start == 0} {
- set cmit $leftover($view)
+ set cmit $leftover($inst)
append cmit [string range $stuff 0 [expr {$i - 1}]]
- set leftover($view) {}
+ set leftover($inst) {}
} else {
set cmit [string range $stuff $start [expr {$i - 1}]]
}
exit 1
}
set id [lindex $ids 0]
- if {![info exists ordertok($view,$id)]} {
+ set vid $view,$id
+ if {!$listed && [info exists parents($vid)]} continue
+ if {![info exists ordertok($vid)]} {
set otok "o[strrep $vnextroot($view)]"
incr vnextroot($view)
- set ordertok($view,$id) $otok
+ set ordertok($vid) $otok
} else {
- set otok $ordertok($view,$id)
- unset idpending($view,$id)
+ set otok $ordertok($vid)
}
if {$listed} {
set olds [lrange $ids 1 end]
if {[llength $olds] == 1} {
set p [lindex $olds 0]
- lappend children($view,$p) $id
if {![info exists ordertok($view,$p)]} {
- set ordertok($view,$p) $ordertok($view,$id)
- set idpending($view,$p) 1
+ set ordertok($view,$p) $ordertok($vid)
}
} else {
set i 0
foreach p $olds {
- if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
- lappend children($view,$p) $id
- }
if {![info exists ordertok($view,$p)]} {
set ordertok($view,$p) "$otok[strrep $i]]"
- set idpending($view,$p) 1
}
incr i
}
} else {
set olds {}
}
- if {![info exists children($view,$id)]} {
- set children($view,$id) {}
- }
set commitdata($id) [string range $cmit [expr {$j + 1}] end]
- set commitrow($view,$id) $commitidx($view)
- incr commitidx($view)
- if {$view == $curview} {
- lappend parentlist $olds
- lappend displayorder $id
- lappend commitlisted $listed
+ set cmitlisted($vid) $listed
+ set parents($vid) $olds
+ set a 0
+ if {![info exists children($vid)]} {
+ set children($vid) {}
} else {
- lappend vparentlist($view) $olds
- lappend vdisporder($view) $id
- lappend vcmitlisted($view) $listed
+ if {[llength $children($vid)] == 1} {
+ set k [lindex $children($vid) 0]
+ if {[llength $parents($view,$k)] == 1} {
+ set a $varcid($view,$k)
+ }
+ }
+ }
+ if {$a == 0} {
+ # new arc
+ set a [newvarc $view $id]
}
+ set varcid($vid) $a
+ lappend varccommits($view,$a) $id
+ set tok [lindex $varctok($view) $a]
+ set i 0
+ foreach p $olds {
+ if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
+ set vp $view,$p
+ if {[llength [lappend children($vp) $id]] > 1 &&
+ [vtokcmp $view [lindex $children($vp) end-1] $id] > 0} {
+ set children($vp) [lsort -command [list vtokcmp $view] \
+ $children($vp)]
+ }
+ }
+ if {[info exists varcid($view,$p)]} {
+ fix_reversal $p $a $view
+ }
+ incr i
+ }
+ if {[string compare $tok $vtokmod($view)] < 0} {
+ set vtokmod($view) $tok
+ set varcmod($view) $a
+ }
+
+ incr commitidx($view)
if {[info exists commitinterest($id)]} {
foreach script $commitinterest($id) {
- eval [string map [list "%I" $id] $script]
+ lappend scripts [string map [list "%I" $id] $script]
}
unset commitinterest($id)
}
set gotsome 1
}
if {$gotsome} {
+ update_arcrows $view
run chewcommits $view
+ foreach s $scripts {
+ eval $s
+ }
if {$view == $curview} {
# update progress bar
global progressdirn progresscoords proglastnc
proc chewcommits {view} {
global curview hlview viewcomplete
- global selectedline pending_select
+ global pending_select
if {$view == $curview} {
layoutmore
if {$viewcomplete($view)} {
- global displayorder commitidx phase
+ global commitidx
global numcommits startmsecs
+ global mainheadid commitinfo nullid
if {[info exists pending_select]} {
set row [first_real_row]
if {$commitidx($curview) > 0} {
#set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
#puts "overall $ms ms for $numcommits commits"
+ #global uat
+ #puts "${uat}ms in update_arcrows"
} else {
show_status "No commits selected"
}
notbusy layout
- set phase {}
}
}
if {[info exists hlview] && $view == $hlview} {
parsecommit $id $contents 0
}
-proc updatecommits {} {
- global viewdata curview phase displayorder ordertok idpending
- global children commitrow selectedline thickerline showneartags
-
- if {$phase ne {}} {
- stop_rev_list
- set phase {}
- }
- set n $curview
- foreach id $displayorder {
- catch {unset children($n,$id)}
- catch {unset commitrow($n,$id)}
- catch {unset ordertok($n,$id)}
- }
- foreach vid [array names idpending "$n,*"] {
- unset idpending($vid)
- }
- set curview -1
- catch {unset selectedline}
- catch {unset thickerline}
- catch {unset viewdata($n)}
- readrefs
- changedrefs
- if {$showneartags} {
- getallcommits
- }
- showview $n
-}
-
proc parsecommit {id contents listed} {
global commitinfo cdate
# skip over fake commits
proc first_real_row {} {
- global nullid nullid2 displayorder numcommits
+ global nullid nullid2 numcommits
for {set row 0} {$row < $numcommits} {incr row} {
- set id [lindex $displayorder $row]
+ set id [commitonrow $row]
if {$id ne $nullid && $id ne $nullid2} {
break
}
proc makewindow {} {
global canv canv2 canv3 linespc charspc ctext cflist
- global textfont mainfont uifont tabstop
+ global tabstop
global findtype findtypemenu findloc findstring fstring geometry
global entries sha1entry sha1string sha1but
global diffcontextstring diffcontext
global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
global headctxmenu progresscanv progressitem progresscoords statusw
global fprogitem fprogcoord lastprogupdate progupdatepending
+ global rprogitem rprogcoord
+ global have_tk85
menu .bar
.bar add cascade -label "File" -menu .bar.file
- .bar configure -font $uifont
+ .bar configure -font uifont
menu .bar.file
.bar.file add command -label "Update" -command updatecommits
+ .bar.file add command -label "Reload" -command reloadcommits
.bar.file add command -label "Reread references" -command rereadrefs
.bar.file add command -label "List references" -command showrefs
.bar.file add command -label "Quit" -command doquit
- .bar.file configure -font $uifont
+ .bar.file configure -font uifont
menu .bar.edit
.bar add cascade -label "Edit" -menu .bar.edit
.bar.edit add command -label "Preferences" -command doprefs
- .bar.edit configure -font $uifont
+ .bar.edit configure -font uifont
- menu .bar.view -font $uifont
+ menu .bar.view -font uifont
.bar add cascade -label "View" -menu .bar.view
.bar.view add command -label "New view..." -command {newview 0}
.bar.view add command -label "Edit view..." -command editview \
.bar add cascade -label "Help" -menu .bar.help
.bar.help add command -label "About gitk" -command about
.bar.help add command -label "Key bindings" -command keys
- .bar.help configure -font $uifont
+ .bar.help configure -font uifont
. configure -menu .bar
# the gui has upper and lower half, parts of a paned window.
set entries $sha1entry
set sha1but .tf.bar.sha1label
button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
- -command gotocommit -width 8 -font $uifont
+ -command gotocommit -width 8 -font uifont
$sha1but conf -disabledforeground [$sha1but cget -foreground]
pack .tf.bar.sha1label -side left
- entry $sha1entry -width 40 -font $textfont -textvariable sha1string
+ entry $sha1entry -width 40 -font textfont -textvariable sha1string
trace add variable sha1string write sha1change
pack $sha1entry -side left -pady 2
# Status label and progress bar
set statusw .tf.bar.status
- label $statusw -width 15 -relief sunken -font $uifont
+ label $statusw -width 15 -relief sunken -font uifont
pack $statusw -side left -padx 5
- set h [expr {[font metrics $uifont -linespace] + 2}]
+ set h [expr {[font metrics uifont -linespace] + 2}]
set progresscanv .tf.bar.progress
canvas $progresscanv -relief sunken -height $h -borderwidth 2
set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
+ set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
pack $progresscanv -side right -expand 1 -fill x
set progresscoords {0 0}
set fprogcoord 0
+ set rprogcoord 0
bind $progresscanv <Configure> adjustprogress
set lastprogupdate [clock clicks -milliseconds]
set progupdatepending 0
# build up the bottom bar of upper window
- label .tf.lbar.flabel -text "Find " -font $uifont
- button .tf.lbar.fnext -text "next" -command dofind -font $uifont
- button .tf.lbar.fprev -text "prev" -command {dofind 1} -font $uifont
- label .tf.lbar.flab2 -text " commit " -font $uifont
+ label .tf.lbar.flabel -text "Find " -font uifont
+ button .tf.lbar.fnext -text "next" -command {dofind 1 1} -font uifont
+ button .tf.lbar.fprev -text "prev" -command {dofind -1 1} -font uifont
+ label .tf.lbar.flab2 -text " commit " -font uifont
pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
-side left -fill y
set gdttype "containing:"
"touching paths:" \
"adding/removing string:"]
trace add variable gdttype write gdttype_change
- $gm conf -font $uifont
- .tf.lbar.gdttype conf -font $uifont
+ $gm conf -font uifont
+ .tf.lbar.gdttype conf -font uifont
pack .tf.lbar.gdttype -side left -fill y
set findstring {}
set fstring .tf.lbar.findstring
lappend entries $fstring
- entry $fstring -width 30 -font $textfont -textvariable findstring
+ entry $fstring -width 30 -font textfont -textvariable findstring
trace add variable findstring write find_change
set findtype Exact
set findtypemenu [tk_optionMenu .tf.lbar.findtype \
findtype Exact IgnCase Regexp]
trace add variable findtype write findcom_change
- .tf.lbar.findtype configure -font $uifont
- .tf.lbar.findtype.menu configure -font $uifont
+ .tf.lbar.findtype configure -font uifont
+ .tf.lbar.findtype.menu configure -font uifont
set findloc "All fields"
tk_optionMenu .tf.lbar.findloc findloc "All fields" Headline \
Comments Author Committer
trace add variable findloc write find_change
- .tf.lbar.findloc configure -font $uifont
- .tf.lbar.findloc.menu configure -font $uifont
+ .tf.lbar.findloc configure -font uifont
+ .tf.lbar.findloc.menu configure -font uifont
pack .tf.lbar.findloc -side right
pack .tf.lbar.findtype -side right
pack $fstring -side left -expand 1 -fill x
frame .bleft.mid
button .bleft.top.search -text "Search" -command dosearch \
- -font $uifont
+ -font uifont
pack .bleft.top.search -side left -padx 5
set sstring .bleft.top.sstring
- entry $sstring -width 20 -font $textfont -textvariable searchstring
+ entry $sstring -width 20 -font textfont -textvariable searchstring
lappend entries $sstring
trace add variable searchstring write incrsearch
pack $sstring -side left -expand 1 -fill x
- radiobutton .bleft.mid.diff -text "Diff" \
+ radiobutton .bleft.mid.diff -text "Diff" -font uifont \
-command changediffdisp -variable diffelide -value {0 0}
- radiobutton .bleft.mid.old -text "Old version" \
+ radiobutton .bleft.mid.old -text "Old version" -font uifont \
-command changediffdisp -variable diffelide -value {0 1}
- radiobutton .bleft.mid.new -text "New version" \
+ radiobutton .bleft.mid.new -text "New version" -font uifont \
-command changediffdisp -variable diffelide -value {1 0}
label .bleft.mid.labeldiffcontext -text " Lines of context: " \
- -font $uifont
+ -font uifont
pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
- spinbox .bleft.mid.diffcontext -width 5 -font $textfont \
+ spinbox .bleft.mid.diffcontext -width 5 -font textfont \
-from 1 -increment 1 -to 10000000 \
-validate all -validatecommand "diffcontextvalidate %P" \
-textvariable diffcontextstring
pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
set ctext .bleft.ctext
text $ctext -background $bgcolor -foreground $fgcolor \
- -tabs "[expr {$tabstop * $charspc}]" \
- -state disabled -font $textfont \
+ -state disabled -font textfont \
-yscrollcommand scrolltext -wrap none
+ if {$have_tk85} {
+ $ctext conf -tabstyle wordprocessor
+ }
scrollbar .bleft.sb -command "$ctext yview"
pack .bleft.top -side top -fill x
pack .bleft.mid -side top -fill x
lappend fglist $ctext
$ctext tag conf comment -wrap $wrapcomment
- $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
+ $ctext tag conf filesep -font textfontbold -back "#aaaaaa"
$ctext tag conf hunksep -fore [lindex $diffcolors 2]
$ctext tag conf d0 -fore [lindex $diffcolors 0]
$ctext tag conf d1 -fore [lindex $diffcolors 1]
$ctext tag conf m15 -fore "#ff70b0"
$ctext tag conf mmax -fore darkgrey
set mergemax 16
- $ctext tag conf mresult -font [concat $textfont bold]
- $ctext tag conf msep -font [concat $textfont bold]
+ $ctext tag conf mresult -font textfontbold
+ $ctext tag conf msep -font textfontbold
$ctext tag conf found -back yellow
.pwbottom add .bleft
frame .bright.mode
radiobutton .bright.mode.patch -text "Patch" \
-command reselectline -variable cmitmode -value "patch"
- .bright.mode.patch configure -font $uifont
+ .bright.mode.patch configure -font uifont
radiobutton .bright.mode.tree -text "Tree" \
-command reselectline -variable cmitmode -value "tree"
- .bright.mode.tree configure -font $uifont
+ .bright.mode.tree configure -font uifont
grid .bright.mode.patch .bright.mode.tree -sticky ew
pack .bright.mode -side top -fill x
set cflist .bright.cfiles
- set indent [font measure $mainfont "nn"]
+ set indent [font measure mainfont "nn"]
text $cflist \
-selectbackground $selectbgcolor \
-background $bgcolor -foreground $fgcolor \
- -font $mainfont \
+ -font mainfont \
-tabs [list $indent [expr {2 * $indent}]] \
-yscrollcommand ".bright.sb set" \
-cursor [. cget -cursor] \
pack $cflist -side left -fill both -expand 1
$cflist tag configure highlight \
-background [$cflist cget -selectbackground]
- $cflist tag configure bold -font [concat $mainfont bold]
+ $cflist tag configure bold -font mainfontbold
.pwbottom add .bright
.ctop add .pwbottom
} else {
bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
+ if {[tk windowingsystem] eq "aqua"} {
+ bindall <MouseWheel> {
+ set delta [expr {- (%D)}]
+ allcanvs yview scroll $delta units
+ }
+ }
}
bindall <2> "canvscan mark %W %x %y"
bindall <B2-Motion> "canvscan dragto %W %x %y"
bindkey <End> sellastline
bind . <Key-Up> "selnextline -1"
bind . <Key-Down> "selnextline 1"
+ bind . <Shift-Key-Up> "dofind -1 0"
+ bind . <Shift-Key-Down> "dofind 1 0"
bindkey <Key-Right> "goforw"
bindkey <Key-Left> "goback"
bind . <Key-Prior> "selnextpage -1"
bindkey b "$ctext yview scroll -1 pages"
bindkey d "$ctext yview scroll 18 units"
bindkey u "$ctext yview scroll -18 units"
- bindkey / {findnext 1}
- bindkey <Key-Return> {findnext 0}
- bindkey ? findprev
+ bindkey / {dofind 1 1}
+ bindkey <Key-Return> {dofind 1 1}
+ bindkey ? {dofind -1 1}
bindkey f nextfile
bindkey <F5> updatecommits
bind . <$M1B-q> doquit
- bind . <$M1B-f> dofind
- bind . <$M1B-g> {findnext 0}
+ bind . <$M1B-f> {dofind 1 1}
+ bind . <$M1B-g> {dofind 1 0}
bind . <$M1B-r> dosearchback
bind . <$M1B-s> dosearch
bind . <$M1B-equal> {incrfont 1}
bind . <$M1B-KP_Subtract> {incrfont -1}
wm protocol . WM_DELETE_WINDOW doquit
bind . <Button-1> "click %W"
- bind $fstring <Key-Return> dofind
+ bind $fstring <Key-Return> {dofind 1 1}
bind $sha1entry <Key-Return> gotocommit
bind $sha1entry <<PasteSelection>> clearsha1
bind $cflist <1> {sel_flist %W %x %y; break}
proc adjustprogress {} {
global progresscanv progressitem progresscoords
global fprogitem fprogcoord lastprogupdate progupdatepending
+ global rprogitem rprogcoord
set w [expr {[winfo width $progresscanv] - 4}]
set x0 [expr {$w * [lindex $progresscoords 0]}]
set h [winfo height $progresscanv]
$progresscanv coords $progressitem $x0 0 $x1 $h
$progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
+ $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
set now [clock clicks -milliseconds]
if {$now >= $lastprogupdate + 100} {
set progupdatepending 0
}
proc savestuff {w} {
- global canv canv2 canv3 ctext cflist mainfont textfont uifont tabstop
+ global canv canv2 canv3 mainfont textfont uifont tabstop
global stuffsaved findmergefiles maxgraphpct
global maxwidth showneartags showlocalchanges
global viewname viewfiles viewargs viewperm nextviewnum
- global cmitmode wrapcomment datetimeformat
+ global cmitmode wrapcomment datetimeformat limitdiffs
global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
if {$stuffsaved} return
puts $f [list set showneartags $showneartags]
puts $f [list set showlocalchanges $showlocalchanges]
puts $f [list set datetimeformat $datetimeformat]
+ puts $f [list set limitdiffs $limitdiffs]
puts $f [list set bgcolor $bgcolor]
puts $f [list set fgcolor $fgcolor]
puts $f [list set colors $colors]
message $w.m -text {
Gitk - a commit viewer for git
-Copyright © 2005-2006 Paul Mackerras
+Copyright © 2005-2007 Paul Mackerras
Use and redistribute under the terms of the GNU General Public License} \
-justify center -aspect 400 -border 2 -bg white -relief groove
pack $w.m -side top -fill x -padx 2 -pady 2
- $w.m configure -font $uifont
+ $w.m configure -font uifont
button $w.ok -text Close -command "destroy $w" -default active
pack $w.ok -side bottom
- $w.ok configure -font $uifont
+ $w.ok configure -font uifont
bind $w <Visibility> "focus $w.ok"
bind $w <Key-Escape> "destroy $w"
bind $w <Key-Return> "destroy $w"
<$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
+<Shift-Up> Find backwards (upwards, later commits)
+<Shift-Down> Find forwards (downwards, earlier commits)
<Delete>, b Scroll diff view up one page
<Backspace> Scroll diff view up one page
<Space> Scroll diff view down one page
" \
-justify left -bg white -border 2 -relief groove
pack $w.m -side top -fill both -padx 2 -pady 2
- $w.m configure -font $uifont
+ $w.m configure -font uifont
button $w.ok -text Close -command "destroy $w" -default active
pack $w.ok -side bottom
- $w.ok configure -font $uifont
+ $w.ok configure -font uifont
bind $w <Visibility> "focus $w.ok"
bind $w <Key-Escape> "destroy $w"
bind $w <Key-Return> "destroy $w"
-data $rectdata -maskdata $rectmask
proc init_flist {first} {
- global cflist cflist_top selectedline difffilestart
+ global cflist cflist_top difffilestart
$cflist conf -state normal
$cflist delete 0.0 end
toplevel $top
wm title $top $title
- label $top.nl -text "Name" -font $uifont
- entry $top.name -width 20 -textvariable newviewname($n) -font $uifont
+ label $top.nl -text "Name" -font uifont
+ entry $top.name -width 20 -textvariable newviewname($n) -font uifont
grid $top.nl $top.name -sticky w -pady 5
checkbutton $top.perm -text "Remember this view" -variable newviewperm($n) \
- -font $uifont
+ -font uifont
grid $top.perm - -pady 5 -sticky w
- message $top.al -aspect 1000 -font $uifont \
+ message $top.al -aspect 1000 -font uifont \
-text "Commits to include (arguments to git rev-list):"
grid $top.al - -sticky w -pady 5
entry $top.args -width 50 -textvariable newviewargs($n) \
- -background white -font $uifont
+ -background white -font uifont
grid $top.args - -sticky ew -padx 5
- message $top.l -aspect 1000 -font $uifont \
+ message $top.l -aspect 1000 -font uifont \
-text "Enter files and directories to include, one per line:"
grid $top.l - -sticky w
- text $top.t -width 40 -height 10 -background white -font $uifont
+ text $top.t -width 40 -height 10 -background white -font uifont
if {[info exists viewfiles($n)]} {
foreach f $viewfiles($n) {
$top.t insert end $f
grid $top.t - -sticky ew -padx 5
frame $top.buts
button $top.buts.ok -text "OK" -command [list newviewok $top $n] \
- -font $uifont
+ -font uifont
button $top.buts.can -text "Cancel" -command [list destroy $top] \
- -font $uifont
+ -font uifont
grid $top.buts.ok $top.buts.can
grid columnconfigure $top.buts 0 -weight 1 -uniform a
grid columnconfigure $top.buts 1 -weight 1 -uniform a
set viewfiles($n) $files
set viewargs($n) $newargs
if {$curview == $n} {
- run updatecommits
+ run reloadcommits
}
}
}
}
proc delview {} {
- global curview viewdata viewperm hlview selectedhlview
+ global curview viewperm hlview selectedhlview
if {$curview == 0} return
if {[info exists hlview] && $hlview == $curview} {
unset hlview
}
allviewmenus $curview delete
- set viewdata($curview) {}
set viewperm($curview) 0
showview 0
}
# -command [list addvhighlight $n] -variable selectedhlview
}
-proc flatten {var} {
- global $var
-
- set ret {}
- foreach i [array names $var] {
- lappend ret $i [set $var\($i\)]
- }
- return $ret
-}
-
-proc unflatten {var l} {
- global $var
-
- catch {unset $var}
- foreach {i v} $l {
- set $var\($i\) $v
- }
-}
-
proc showview {n} {
- global curview viewdata viewfiles
+ global curview viewfiles cached_commitrow
global displayorder parentlist rowidlist rowisopt rowfinal
- global colormap rowtextx commitrow nextcolor canvxmax
- global numcommits commitlisted
+ global colormap rowtextx nextcolor canvxmax
+ global numcommits viewcomplete
global selectedline currentid canv canvy0
global treediffs
- global pending_select phase
+ global pending_select
global commitidx
- global commfd
global selectedview selectfirst
- global vparentlist vdisporder vcmitlisted
global hlview selectedhlview commitinterest
if {$n == $curview} return
set selid {}
+ set ymax [lindex [$canv cget -scrollregion] 3]
+ set span [$canv yview]
+ set ytop [expr {[lindex $span 0] * $ymax}]
+ set ybot [expr {[lindex $span 1] * $ymax}]
+ set yscreen [expr {($ybot - $ytop) / 2}]
if {[info exists selectedline]} {
set selid $currentid
set y [yc $selectedline]
- set ymax [lindex [$canv cget -scrollregion] 3]
- set span [$canv yview]
- set ytop [expr {[lindex $span 0] * $ymax}]
- set ybot [expr {[lindex $span 1] * $ymax}]
if {$ytop < $y && $y < $ybot} {
set yscreen [expr {$y - $ytop}]
- } else {
- set yscreen [expr {($ybot - $ytop) / 2}]
}
} elseif {[info exists pending_select]} {
set selid $pending_select
}
unselectline
normalline
- if {$curview >= 0} {
- set vparentlist($curview) $parentlist
- set vdisporder($curview) $displayorder
- set vcmitlisted($curview) $commitlisted
- if {$phase ne {} ||
- ![info exists viewdata($curview)] ||
- [lindex $viewdata($curview) 0] ne {}} {
- set viewdata($curview) \
- [list $phase $rowidlist $rowisopt $rowfinal]
- }
- }
catch {unset treediffs}
clear_display
if {[info exists hlview] && $hlview == $n} {
set selectedhlview None
}
catch {unset commitinterest}
+ catch {unset cached_commitrow}
set curview $n
set selectedview $n
.bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
run refill_reflist
- if {![info exists viewdata($n)]} {
+ if {![info exists viewcomplete($n)]} {
if {$selid ne {}} {
set pending_select $selid
}
return
}
- set v $viewdata($n)
- set phase [lindex $v 0]
- set displayorder $vdisporder($n)
- set parentlist $vparentlist($n)
- set commitlisted $vcmitlisted($n)
- set rowidlist [lindex $v 1]
- set rowisopt [lindex $v 2]
- set rowfinal [lindex $v 3]
+ set displayorder {}
+ set parentlist {}
+ set rowidlist {}
+ set rowisopt {}
+ set rowfinal {}
set numcommits $commitidx($n)
catch {unset colormap}
set yf 0
set row {}
set selectfirst 0
- if {$selid ne {} && [info exists commitrow($n,$selid)]} {
- set row $commitrow($n,$selid)
+ if {$selid ne {} && [commitinview $selid $n]} {
+ set row [rowofcommit $selid]
# try to get the selected row in the same position on the screen
set ymax [lindex [$canv cget -scrollregion] 3]
set ytop [expr {[yc $row] - $yscreen}]
set selectfirst 1
}
}
- if {$phase ne {}} {
- if {$phase eq "getcommits"} {
+ if {!$viewcomplete($n)} {
+ if {$numcommits == 0} {
show_status "Reading commits..."
+ } else {
+ run chewcommits $n
}
- run chewcommits $n
} elseif {$numcommits == 0} {
show_status "No commits selected"
}
}
proc unbolden {} {
- global mainfont boldrows
+ global boldrows
set stillbold {}
foreach row $boldrows {
if {![ishighlighted $row]} {
- bolden $row $mainfont
+ bolden $row mainfont
} else {
lappend stillbold $row
}
}
proc addvhighlight {n} {
- global hlview curview viewdata vhl_done vhighlights commitidx
+ global hlview viewcomplete curview vhl_done vhighlights commitidx
if {[info exists hlview]} {
delvhighlight
}
set hlview $n
- if {$n != $curview && ![info exists viewdata($n)]} {
- set viewdata($n) [list getcommits {{}} 0 0 0]
- set vparentlist($n) {}
- set vdisporder($n) {}
- set vcmitlisted($n) {}
+ if {$n != $curview && ![info exists viewcomplete($n)]} {
start_rev_list $n
}
set vhl_done $commitidx($hlview)
}
proc vhighlightmore {} {
- global hlview vhl_done commitidx vhighlights
- global displayorder vdisporder curview mainfont
+ global hlview vhl_done commitidx vhighlights curview
- set font [concat $mainfont bold]
set max $commitidx($hlview)
- if {$hlview == $curview} {
- set disp $displayorder
- } else {
- set disp $vdisporder($hlview)
- }
set vr [visiblerows]
set r0 [lindex $vr 0]
set r1 [lindex $vr 1]
for {set i $vhl_done} {$i < $max} {incr i} {
- set id [lindex $disp $i]
- if {[info exists commitrow($curview,$id)]} {
- set row $commitrow($curview,$id)
+ set id [commitonrow $i $hlview]
+ if {[commitinview $id $curview]} {
+ set row [rowofcommit $id]
if {$r0 <= $row && $row <= $r1} {
if {![highlighted $row]} {
- bolden $row $font
+ bolden $row mainfontbold
}
set vhighlights($row) 1
}
}
proc askvhighlight {row id} {
- global hlview vhighlights commitrow iddrawn mainfont
+ global hlview vhighlights iddrawn
- if {[info exists commitrow($hlview,$id)]} {
+ if {[commitinview $id $hlview]} {
if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
- bolden $row [concat $mainfont bold]
+ bolden $row mainfontbold
}
set vhighlights($row) 1
} else {
proc hfiles_change {} {
global highlight_files filehighlight fhighlights fh_serial
- global mainfont highlight_paths gdttype
+ global highlight_paths gdttype
if {[info exists filehighlight]} {
# delete previous highlights
drawvisible
}
-proc findcom_change {} {
- global nhighlights mainfont boldnamerows
+proc findcom_change args {
+ global nhighlights boldnamerows
global findpattern findtype findstring gdttype
stopfinding
# delete previous highlights, if any
foreach row $boldnamerows {
- bolden_name $row $mainfont
+ bolden_name $row mainfont
}
set boldnamerows {}
catch {unset nhighlights}
}
proc readfhighlight {} {
- global filehighlight fhighlights commitrow curview mainfont iddrawn
+ global filehighlight fhighlights curview iddrawn
global fhl_list find_dirn
if {![info exists filehighlight]} {
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
+ if {[commitinview $id $curview]} {
+ set fhighlights([rowofcommit $id]) 0
}
}
set fhl_list [lrange $fhl_list [expr {$i+1}] end]
if {$line eq {}} continue
- if {![info exists commitrow($curview,$line)]} continue
- set row $commitrow($curview,$line)
+ if {![commitinview $line $curview]} continue
+ set row [rowofcommit $line]
if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
- bolden $row [concat $mainfont bold]
+ bolden $row mainfontbold
}
set fhighlights($row) 1
}
return 0
}
if {[info exists find_dirn]} {
- if {$find_dirn > 0} {
- run findmore
- } else {
- run findmorerev
- }
+ run findmore
}
return 1
}
}
proc askfindhighlight {row id} {
- global nhighlights commitinfo iddrawn mainfont
+ global nhighlights commitinfo iddrawn
global findloc
global markingmatches
}
}
if {$isbold && [info exists iddrawn($id)]} {
- set f [concat $mainfont bold]
if {![ishighlighted $row]} {
- bolden $row $f
+ bolden $row mainfontbold
if {$isbold > 1} {
- bolden_name $row $f
+ bolden_name $row mainfontbold
}
}
if {$markingmatches} {
}
proc is_descendent {a} {
- global curview children commitrow descendent desc_todo
+ global curview children descendent desc_todo
set v $curview
- set la $commitrow($v,$a)
+ set la [rowofcommit $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} {
+ if {[rowofcommit $do] < $la} {
lappend leftover $do
continue
}
}
proc is_ancestor {a} {
- global curview parentlist commitrow ancestor anc_todo
+ global curview parents ancestor anc_todo
set v $curview
- set la $commitrow($v,$a)
+ set la [rowofcommit $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} {
+ if {![commitinview $do $v] || [rowofcommit $do] > $la} {
lappend leftover $do
continue
}
- foreach np [lindex $parentlist $commitrow($v,$do)] {
+ foreach np $parents($v,$do) {
if {![info exists ancestor($np)]} {
set ancestor($np) 1
lappend todo $np
}
proc askrelhighlight {row id} {
- global descendent highlight_related iddrawn mainfont rhighlights
+ global descendent highlight_related iddrawn rhighlights
global selectedline ancestor
if {![info exists selectedline]} return
}
if {[info exists iddrawn($id)]} {
if {$isbold && ![ishighlighted $row]} {
- bolden $row [concat $mainfont bold]
+ bolden $row mainfontbold
}
}
set rhighlights($row) $isbold
}
proc initlayout {} {
- global rowidlist rowisopt rowfinal displayorder commitlisted
+ global rowidlist rowisopt rowfinal displayorder parentlist
global numcommits canvxmax canv
global nextcolor
- global parentlist
global colormap rowtextx
global selectfirst
set numcommits 0
set displayorder {}
- set commitlisted {}
set parentlist {}
set nextcolor 0
set rowidlist {}
}
proc layoutmore {} {
- global commitidx viewcomplete numcommits
- global uparrowlen downarrowlen mingaplen curview
-
- set show $commitidx($curview)
- if {$show > $numcommits} {
- showstuff $show $viewcomplete($curview)
- }
-}
-
-proc showstuff {canshow last} {
- global numcommits commitrow pending_select selectedline curview
- global mainheadid displayorder selectfirst
- global lastscrollset commitinterest
+ global commitidx viewcomplete curview
+ global numcommits pending_select selectedline curview
+ global selectfirst lastscrollset commitinterest
+ set canshow $commitidx($curview)
+ if {$canshow <= $numcommits && !$viewcomplete($curview)} return
if {$numcommits == 0} {
- global phase
- set phase "incrdraw"
allcanvs delete all
}
set r0 $numcommits
set prev $numcommits
set numcommits $canshow
set t [clock clicks -milliseconds]
- if {$prev < 100 || $last || $t - $lastscrollset > 500} {
+ if {$prev < 100 || $viewcomplete($curview) || $t - $lastscrollset > 500} {
set lastscrollset $t
setcanvscroll
}
drawcommits $r0 $r1
}
if {[info exists pending_select] &&
- [info exists commitrow($curview,$pending_select)] &&
- $commitrow($curview,$pending_select) < $numcommits} {
- selectline $commitrow($curview,$pending_select) 1
+ [commitinview $pending_select $curview]} {
+ selectline [rowofcommit $pending_select] 1
}
if {$selectfirst} {
if {[info exists selectedline] || [info exists pending_select]} {
}
proc doshowlocalchanges {} {
- global curview mainheadid phase commitrow
+ global curview mainheadid
- if {[info exists commitrow($curview,$mainheadid)] &&
- ($phase eq {} || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
+ if {[commitinview $mainheadid $curview]} {
dodiffindex
- } elseif {$phase ne {}} {
- lappend commitinterest($mainheadid) {}
+ } else {
+ lappend commitinterest($mainheadid) {dodiffindex}
}
}
proc dohidelocalchanges {} {
- global localfrow localirow lserial
+ global nullid nullid2 lserial curview
- if {$localfrow >= 0} {
- removerow $localfrow
- set localfrow -1
- if {$localirow > 0} {
- incr localirow -1
- }
+ if {[commitinview $nullid $curview]} {
+ removerow $nullid $curview
}
- if {$localirow >= 0} {
- removerow $localirow
- set localirow -1
+ if {[commitinview $nullid2 $curview]} {
+ removerow $nullid2 $curview
}
incr lserial
}
# spawn off a process to do git diff-index --cached HEAD
proc dodiffindex {} {
- global localirow localfrow lserial showlocalchanges
+ global lserial showlocalchanges
if {!$showlocalchanges} return
incr lserial
- set localfrow -1
- set localirow -1
set fd [open "|git diff-index --cached HEAD" r]
fconfigure $fd -blocking 0
filerun $fd [list readdiffindex $fd $lserial]
}
proc readdiffindex {fd serial} {
- global localirow commitrow mainheadid nullid2 curview
- global commitinfo commitdata lserial
+ global mainheadid nullid2 curview commitinfo commitdata lserial
set isdiff 1
if {[gets $fd line] < 0} {
filerun $fd [list readdifffiles $fd $serial]
}
- if {$isdiff && $serial == $lserial && $localirow == -1} {
+ if {$isdiff && $serial == $lserial && ![commitinview $nullid2 $curview]} {
# 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
+ insertrow $nullid2 $mainheadid $curview
}
return 0
}
proc readdifffiles {fd serial} {
- global localirow localfrow commitrow mainheadid nullid curview
+ global mainheadid nullid nullid2 curview
global commitinfo commitdata lserial
set isdiff 1
# we only need to see one line and we don't really care what it says...
close $fd
- if {$isdiff && $serial == $lserial && $localfrow == -1} {
+ if {$isdiff && $serial == $lserial && ![commitinview $nullid $curview]} {
# add the line for the local diff to the graph
- if {$localirow >= 0} {
- set localfrow $localirow
- incr localirow
- } else {
- set localfrow $commitrow($curview,$mainheadid)
- }
set hl "Local uncommitted changes, not checked in to index"
set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
set commitdata($nullid) "\n $hl\n"
- insertrow $localfrow $nullid
+ if {[commitinview $nullid2 $curview]} {
+ set p $nullid2
+ } else {
+ set p $mainheadid
+ }
+ insertrow $nullid $p $curview
}
return 0
}
proc nextuse {id row} {
- global commitrow curview children
+ global curview children
if {[info exists children($curview,$id)]} {
foreach kid $children($curview,$id) {
- if {![info exists commitrow($curview,$kid)]} {
+ if {![commitinview $kid $curview]} {
return -1
}
- if {$commitrow($curview,$kid) > $row} {
- return $commitrow($curview,$kid)
+ if {[rowofcommit $kid] > $row} {
+ return [rowofcommit $kid]
}
}
}
- if {[info exists commitrow($curview,$id)]} {
- return $commitrow($curview,$id)
+ if {[commitinview $id $curview]} {
+ return [rowofcommit $id]
}
return -1
}
proc prevuse {id row} {
- global commitrow curview children
+ global curview children
set ret -1
if {[info exists children($curview,$id)]} {
foreach kid $children($curview,$id) {
- if {![info exists commitrow($curview,$kid)]} break
- if {$commitrow($curview,$kid) < $row} {
- set ret $commitrow($curview,$kid)
+ if {![commitinview $kid $curview]} break
+ if {[rowofcommit $kid] < $row} {
+ set ret [rowofcommit $kid]
}
}
}
proc make_idlist {row} {
global displayorder parentlist uparrowlen downarrowlen mingaplen
- global commitidx curview ordertok children commitrow
+ global commitidx curview ordertok children
set r [expr {$row - $mingaplen - $downarrowlen - 1}]
if {$r < 0} {
if {$rb > $commitidx($curview)} {
set rb $commitidx($curview)
}
+ make_disporder $r [expr {$rb + 1}]
set ids {}
for {} {$r < $ra} {incr r} {
set nextid [lindex $displayorder [expr {$r + 1}]]
while {$r < $rb} {
foreach p [lindex $parentlist $r] {
set firstkid [lindex $children($curview,$p) 0]
- if {$commitrow($curview,$firstkid) < $row} {
+ if {[rowofcommit $firstkid] < $row} {
lappend ids [list $ordertok($curview,$p) $p]
}
}
set id [lindex $displayorder $r]
if {$id ne {}} {
set firstkid [lindex $children($curview,$id) 0]
- if {$firstkid ne {} && $commitrow($curview,$firstkid) < $row} {
+ if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
lappend ids [list $ordertok($curview,$id) $id]
}
}
global rowidlist rowisopt rowfinal displayorder
global uparrowlen downarrowlen maxwidth mingaplen
global children parentlist
- global commitidx viewcomplete curview commitrow
+ global commitidx viewcomplete curview
+ make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
set idlist {}
if {$row > 0} {
set rm1 [expr {$row - 1}]
foreach p [lindex $parentlist $r] {
if {[lsearch -exact $idlist $p] >= 0} continue
set fk [lindex $children($curview,$p) 0]
- if {$commitrow($curview,$fk) < $row} {
+ if {[rowofcommit $fk] < $row} {
set x [idcol $idlist $p $x]
set idlist [linsert $idlist $x $p]
}
set p [lindex $displayorder $r]
if {[lsearch -exact $idlist $p] < 0} {
set fk [lindex $children($curview,$p) 0]
- if {$fk ne {} && $commitrow($curview,$fk) < $row} {
+ if {$fk ne {} && [rowofcommit $fk] < $row} {
set x [idcol $idlist $p $x]
set idlist [linsert $idlist $x $p]
}
}
proc rowranges {id} {
- global commitrow curview children uparrowlen downarrowlen
+ global curview children uparrowlen downarrowlen
global rowidlist
set kids $children($curview,$id)
set ret {}
lappend kids $id
foreach child $kids {
- if {![info exists commitrow($curview,$child)]} break
- set row $commitrow($curview,$child)
+ if {![commitinview $child $curview]} break
+ set row [rowofcommit $child]
if {![info exists prev]} {
lappend ret [expr {$row + 1}]
} else {
if {$row <= $prevrow} {
- puts "oops children out of order [shortids $id] $row < [shortids $prev] $prevrow"
+ puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
}
# see if the line extends the whole way from prevrow to row
if {$row > $prevrow + $uparrowlen + $downarrowlen &&
if {$child eq $id} {
lappend ret $row
}
- set prev $id
+ set prev $child
set prevrow $row
}
return $ret
}
proc drawcmittext {id row col} {
- global linespc canv canv2 canv3 canvy0 fgcolor curview
- global commitlisted commitinfo rowidlist parentlist
+ global linespc canv canv2 canv3 fgcolor curview
+ global cmitlisted commitinfo rowidlist parentlist
global rowtextx idpos idtags idheads idotherrefs
global linehtag linentag linedtag selectedline
- global mainfont canvxmax boldrows boldnamerows fgcolor nullid nullid2
+ global canvxmax boldrows boldnamerows fgcolor nullid nullid2
# listed is 0 for boundary, 1 for normal, 2 for left, 3 for right
- set listed [lindex $commitlisted $row]
+ set listed $cmitlisted($curview,$id)
if {$id eq $nullid} {
set ofill red
} elseif {$id eq $nullid2} {
set name [lindex $commitinfo($id) 1]
set date [lindex $commitinfo($id) 2]
set date [formatdate $date]
- set font $mainfont
- set nfont $mainfont
+ set font mainfont
+ set nfont mainfont
set isbold [ishighlighted $row]
if {$isbold > 0} {
lappend boldrows $row
- lappend font bold
+ set font mainfontbold
if {$isbold > 1} {
lappend boldnamerows $row
- lappend nfont bold
+ set nfont mainfontbold
}
}
set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
-text $name -font $nfont -tags text]
set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
- -text $date -font $mainfont -tags text]
+ -text $date -font mainfont -tags text]
if {[info exists selectedline] && $selectedline == $row} {
make_secsel $row
}
- set xr [expr {$xt + [font measure $mainfont $headline]}]
+ set xr [expr {$xt + [font measure $font $headline]}]
if {$xr > $canvxmax} {
set canvxmax $xr
setcanvscroll
proc drawcmitrow {row} {
global displayorder rowidlist nrows_drawn
global iddrawn markingmatches
- global commitinfo parentlist numcommits
+ global commitinfo numcommits
global filehighlight fhighlights findpattern nhighlights
global hlview vhighlights
global highlight_related rhighlights
drawcmitrow $r
if {$r == $er} break
set nextid [lindex $displayorder [expr {$r + 1}]]
- if {$wasdrawn && [info exists iddrawn($nextid)]} {
- catch {unset prevlines}
- continue
- }
+ if {$wasdrawn && [info exists iddrawn($nextid)]} continue
drawparentlinks $id $r
- if {[info exists lineends($r)]} {
- foreach lid $lineends($r) {
- unset prevlines($lid)
- }
- }
set rowids [lindex $rowidlist $r]
foreach lid $rowids {
if {$lid eq {}} continue
+ if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
if {$lid eq $id} {
# see if this is the first child of any of its parents
foreach p [lindex $parentlist $r] {
if {[lsearch -exact $rowids $p] < 0} {
# make this line extend up to the child
- set le [drawlineseg $p $r $er 0]
- lappend lineends($le) $p
- set prevlines($p) 1
+ set lineend($p) [drawlineseg $p $r $er 0]
}
}
- } elseif {![info exists prevlines($lid)]} {
- set le [drawlineseg $lid $r $er 1]
- lappend lineends($le) $lid
- set prevlines($lid) 1
+ } else {
+ set lineend($lid) [drawlineseg $lid $r $er 1]
}
}
}
}
+proc undolayout {row} {
+ global uparrowlen mingaplen downarrowlen
+ global rowidlist rowisopt rowfinal need_redisplay
+
+ set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
+ if {$r < 0} {
+ set r 0
+ }
+ if {[llength $rowidlist] > $r} {
+ incr r -1
+ set rowidlist [lrange $rowidlist 0 $r]
+ set rowfinal [lrange $rowfinal 0 $r]
+ set rowisopt [lrange $rowisopt 0 $r]
+ set need_redisplay 1
+ run drawvisible
+ }
+}
+
proc drawfrac {f0 f1} {
global canv linespc
proc assigncolor {id} {
global colormap colors nextcolor
- global commitrow parentlist children children curview
+ global parents children children curview
if {[info exists colormap($id)]} return
set ncolors [llength $colors]
if {[llength $kids] == 1} {
set child [lindex $kids 0]
if {[info exists colormap($child)]
- && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
+ && [llength $parents($curview,$child)] == 1} {
set colormap($id) $colormap($child)
return
}
&& [lsearch -exact $badcolors $colormap($child)] < 0} {
lappend badcolors $colormap($child)
}
- foreach p [lindex $parentlist $commitrow($curview,$child)] {
+ foreach p $parents($curview,$child) {
if {[info exists colormap($p)]
&& [lsearch -exact $badcolors $colormap($p)] < 0} {
lappend badcolors $colormap($p)
proc drawtags {id x xt y1} {
global idtags idheads idotherrefs mainhead
global linespc lthickness
- global canv mainfont commitrow rowtextx curview fgcolor bgcolor
+ global canv rowtextx curview fgcolor bgcolor
set marks {}
set ntags 0
foreach tag $marks {
incr i
if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
- set wid [font measure [concat $mainfont bold] $tag]
+ set wid [font measure mainfontbold $tag]
} else {
- set wid [font measure $mainfont $tag]
+ set wid [font measure mainfont $tag]
}
lappend xvals $xt
lappend wvals $wid
foreach tag $marks x $xvals wid $wvals {
set xl [expr {$x + $delta}]
set xr [expr {$x + $delta + $wid + $lthickness}]
- set font $mainfont
+ set font mainfont
if {[incr ntags -1] >= 0} {
# draw a tag
set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
$xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
-width 1 -outline black -fill yellow -tags tag.$id]
$canv bind $t <1> [list showtag $tag 1]
- set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
+ set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
} else {
# draw a head or other ref
if {[incr nheads -1] >= 0} {
set col green
if {$tag eq $mainhead} {
- lappend font bold
+ set font mainfontbold
}
} else {
set col "#ddddff"
$canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
-width 1 -outline black -fill $col -tags tag.$id
if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
- set rwid [font measure $mainfont $remoteprefix]
+ set rwid [font measure mainfont $remoteprefix]
set xi [expr {$x + 1}]
set yti [expr {$yt + 1}]
set xri [expr {$x + $rwid}]
}
proc show_status {msg} {
- global canv mainfont fgcolor
+ global canv fgcolor
clear_display
- $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
+ $canv create text 3 3 -anchor nw -text $msg -font mainfont \
-tags text -fill $fgcolor
}
-# Insert a new commit as the child of the commit on row $row.
-# The new commit will be displayed on row $row and the commits
-# on that row and below will move down one row.
-proc insertrow {row newcmit} {
- global displayorder parentlist commitlisted children
- global commitrow curview rowidlist rowisopt rowfinal numcommits
- global numcommits
- global selectedline commitidx ordertok
-
- if {$row >= $numcommits} {
- puts "oops, inserting new row $row but only have $numcommits rows"
- return
- }
- set p [lindex $displayorder $row]
- set displayorder [linsert $displayorder $row $newcmit]
- set parentlist [linsert $parentlist $row $p]
- set kids $children($curview,$p)
- lappend kids $newcmit
- set children($curview,$p) $kids
- set children($curview,$newcmit) {}
- set commitlisted [linsert $commitlisted $row 1]
- set l [llength $displayorder]
- for {set r $row} {$r < $l} {incr r} {
- set id [lindex $displayorder $r]
- set commitrow($curview,$id) $r
- }
- incr commitidx($curview)
- set ordertok($curview,$newcmit) $ordertok($curview,$p)
-
- if {$row < [llength $rowidlist]} {
- set idlist [lindex $rowidlist $row]
- if {$idlist ne {}} {
- if {[llength $kids] == 1} {
- set col [lsearch -exact $idlist $p]
- lset idlist $col $newcmit
- } else {
- set col [llength $idlist]
- lappend idlist $newcmit
- }
- }
- set rowidlist [linsert $rowidlist $row $idlist]
- set rowisopt [linsert $rowisopt $row 0]
- set rowfinal [linsert $rowfinal $row [lindex $rowfinal $row]]
- }
-
- incr numcommits
-
- if {[info exists selectedline] && $selectedline >= $row} {
- incr selectedline
- }
- redisplay
-}
-
-# Remove a commit that was inserted with insertrow on row $row.
-proc removerow {row} {
- global displayorder parentlist commitlisted children
- global commitrow curview rowidlist rowisopt rowfinal numcommits
- global numcommits
- global linesegends selectedline commitidx
-
- if {$row >= $numcommits} {
- puts "oops, removing row $row but only have $numcommits rows"
- return
- }
- set rp1 [expr {$row + 1}]
- set id [lindex $displayorder $row]
- set p [lindex $parentlist $row]
- set displayorder [lreplace $displayorder $row $row]
- set parentlist [lreplace $parentlist $row $row]
- set commitlisted [lreplace $commitlisted $row $row]
- set kids $children($curview,$p)
- set i [lsearch -exact $kids $id]
- if {$i >= 0} {
- set kids [lreplace $kids $i $i]
- set children($curview,$p) $kids
- }
- set l [llength $displayorder]
- for {set r $row} {$r < $l} {incr r} {
- set id [lindex $displayorder $r]
- set commitrow($curview,$id) $r
- }
- incr commitidx($curview) -1
-
- if {$row < [llength $rowidlist]} {
- set rowidlist [lreplace $rowidlist $row $row]
- set rowisopt [lreplace $rowisopt $row $row]
- set rowfinal [lreplace $rowfinal $row $row]
- }
-
- incr numcommits -1
-
- if {[info exists selectedline] && $selectedline > $row} {
- incr selectedline -1
- }
- redisplay
-}
-
# Don't change the text pane cursor if it is currently the hand cursor,
# showing that we are over a sha1 ID link.
proc settextcursor {c} {
set curtextcursor $c
}
-proc nowbusy {what} {
- global isbusy
+proc nowbusy {what {name {}}} {
+ global isbusy busyname statusw
if {[array names isbusy] eq {}} {
. config -cursor watch
settextcursor watch
}
set isbusy($what) 1
+ set busyname($what) $name
+ if {$name ne {}} {
+ $statusw conf -text $name
+ }
}
proc notbusy {what} {
- global isbusy maincursor textcursor
+ global isbusy maincursor textcursor busyname statusw
- catch {unset isbusy($what)}
+ catch {
+ unset isbusy($what)
+ if {$busyname($what) ne {} &&
+ [$statusw cget -text] eq $busyname($what)} {
+ $statusw conf -text {}
+ }
+ }
if {[array names isbusy] eq {}} {
. config -cursor $maincursor
settextcursor $textcursor
return $matches
}
-proc dofind {{rev 0}} {
+proc dofind {{dirn 1} {wrap 1}} {
global findstring findstartline findcurline selectedline numcommits
- global gdttype filehighlight fh_serial find_dirn
+ global gdttype filehighlight fh_serial find_dirn findallowwrap
- unmarkmatches
+ if {[info exists find_dirn]} {
+ if {$find_dirn == $dirn} return
+ stopfinding
+ }
focus .
if {$findstring eq {} || $numcommits == 0} return
if {![info exists selectedline]} {
- set findstartline [lindex [visiblerows] $rev]
+ set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
} else {
set findstartline $selectedline
}
set findcurline $findstartline
- nowbusy finding
+ nowbusy finding "Searching"
if {$gdttype ne "containing:" && ![info exists filehighlight]} {
after cancel do_file_hl $fh_serial
do_file_hl $fh_serial
}
- if {!$rev} {
- set find_dirn 1
- run findmore
- } else {
- set find_dirn -1
- run findmorerev
- }
+ set find_dirn $dirn
+ set findallowwrap $wrap
+ run findmore
}
proc stopfinding {} {
}
}
-proc findnext {restart} {
- global findcurline find_dirn
-
- if {[info exists find_dirn]} return
- set find_dirn 1
- if {![info exists findcurline]} {
- if {$restart} {
- dofind
- } else {
- bell
- }
- } else {
- run findmore
- nowbusy finding
- }
-}
-
-proc findprev {} {
- global findcurline find_dirn
-
- if {[info exists find_dirn]} return
- set find_dirn -1
- if {![info exists findcurline]} {
- dofind 1
- } else {
- run findmorerev
- nowbusy finding
- }
-}
-
proc findmore {} {
global commitdata commitinfo numcommits findpattern findloc
- global findstartline findcurline displayorder
+ global findstartline findcurline findallowwrap
global find_dirn gdttype fhighlights fprogcoord
+ global curview varcorder vrownum varccommits
if {![info exists find_dirn]} {
return 0
}
set fldtypes {Headline Author Date Committer CDate Comments}
- set l [expr {$findcurline + 1}]
- if {$l >= $numcommits} {
- set l 0
- }
- if {$l <= $findstartline} {
- set lim [expr {$findstartline + 1}]
- } else {
- set lim $numcommits
- }
- if {$lim - $l > 500} {
- set lim [expr {$l + 500}]
- }
- set found 0
- set domore 1
- if {$gdttype eq "containing:"} {
- for {} {$l < $lim} {incr l} {
- set id [lindex $displayorder $l]
- # shouldn't happen unless git log doesn't give all the commits...
- if {![info exists commitdata($id)]} continue
- if {![doesmatch $commitdata($id)]} continue
- if {![info exists commitinfo($id)]} {
- getcommit $id
- }
- set info $commitinfo($id)
- foreach f $info ty $fldtypes {
- if {($findloc eq "All fields" || $findloc eq $ty) &&
- [doesmatch $f]} {
- set found 1
- break
- }
- }
- if {$found} break
+ set l $findcurline
+ set moretodo 0
+ if {$find_dirn > 0} {
+ incr l
+ if {$l >= $numcommits} {
+ set l 0
+ }
+ if {$l <= $findstartline} {
+ set lim [expr {$findstartline + 1}]
+ } else {
+ set lim $numcommits
+ set moretodo $findallowwrap
}
} else {
- for {} {$l < $lim} {incr l} {
- set id [lindex $displayorder $l]
- if {![info exists fhighlights($l)]} {
- askfilehighlight $l $id
- if {$domore} {
- set domore 0
- set findcurline [expr {$l - 1}]
- }
- } elseif {$fhighlights($l)} {
- set found $domore
- break
- }
+ if {$l == 0} {
+ set l $numcommits
}
- }
- if {$found || ($domore && $l == $findstartline + 1)} {
- unset findcurline
- unset find_dirn
- notbusy finding
- set fprogcoord 0
- adjustprogress
- if {$found} {
- findselectline $l
+ incr l -1
+ if {$l >= $findstartline} {
+ set lim [expr {$findstartline - 1}]
} else {
- bell
+ set lim -1
+ set moretodo $findallowwrap
}
- return 0
- }
- if {!$domore} {
- flushhighlights
- } else {
- set findcurline [expr {$l - 1}]
- }
- set n [expr {$findcurline - ($findstartline + 1)}]
- if {$n < 0} {
- incr n $numcommits
- }
- set fprogcoord [expr {$n * 1.0 / $numcommits}]
- adjustprogress
- return $domore
-}
-
-proc findmorerev {} {
- global commitdata commitinfo numcommits findpattern findloc
- global findstartline findcurline displayorder
- global find_dirn gdttype fhighlights fprogcoord
-
- if {![info exists find_dirn]} {
- return 0
- }
- set fldtypes {Headline Author Date Committer CDate Comments}
- set l $findcurline
- if {$l == 0} {
- set l $numcommits
- }
- incr l -1
- if {$l >= $findstartline} {
- set lim [expr {$findstartline - 1}]
- } else {
- set lim -1
}
- if {$l - $lim > 500} {
- set lim [expr {$l - 500}]
+ set n [expr {($lim - $l) * $find_dirn}]
+ if {$n > 500} {
+ set n 500
+ set moretodo 1
}
set found 0
set domore 1
+ set ai [bsearch $vrownum($curview) $l]
+ set a [lindex $varcorder($curview) $ai]
+ set arow [lindex $vrownum($curview) $ai]
+ set ids [lindex $varccommits($curview,$a)]
+ set arowend [expr {$arow + [llength $ids]}]
if {$gdttype eq "containing:"} {
- for {} {$l > $lim} {incr l -1} {
- set id [lindex $displayorder $l]
- if {![info exists commitdata($id)]} continue
- if {![doesmatch $commitdata($id)]} continue
+ for {} {$n > 0} {incr n -1; incr l $find_dirn} {
+ if {$l < $arow || $l >= $arowend} {
+ incr ai $find_dirn
+ set a [lindex $varcorder($curview) $ai]
+ set arow [lindex $vrownum($curview) $ai]
+ set ids [lindex $varccommits($curview,$a)]
+ set arowend [expr {$arow + [llength $ids]}]
+ }
+ set id [lindex $ids [expr {$l - $arow}]]
+ # shouldn't happen unless git log doesn't give all the commits...
+ if {![info exists commitdata($id)] ||
+ ![doesmatch $commitdata($id)]} {
+ continue
+ }
if {![info exists commitinfo($id)]} {
getcommit $id
}
if {$found} break
}
} else {
- for {} {$l > $lim} {incr l -1} {
- set id [lindex $displayorder $l]
+ for {} {$n > 0} {incr n -1; incr l $find_dirn} {
+ if {$l < $arow || $l >= $arowend} {
+ incr ai $find_dirn
+ set a [lindex $varcorder($curview) $ai]
+ set arow [lindex $vrownum($curview) $ai]
+ set ids [lindex $varccommits($curview,$a)]
+ set arowend [expr {$arow + [llength $ids]}]
+ }
+ set id [lindex $ids [expr {$l - $arow}]]
if {![info exists fhighlights($l)]} {
askfilehighlight $l $id
if {$domore} {
set domore 0
- set findcurline [expr {$l + 1}]
+ set findcurline [expr {$l - $find_dirn}]
}
} elseif {$fhighlights($l)} {
set found $domore
}
}
}
- if {$found || ($domore && $l == $findstartline - 1)} {
+ if {$found || ($domore && !$moretodo)} {
unset findcurline
unset find_dirn
notbusy finding
if {!$domore} {
flushhighlights
} else {
- set findcurline [expr {$l + 1}]
+ set findcurline [expr {$l - $find_dirn}]
}
- set n [expr {($findstartline - 1) - $findcurline}]
+ set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
if {$n < 0} {
incr n $numcommits
}
# append some text to the ctext widget, and make any SHA1 ID
# that we know about be a clickable link.
proc appendwithlinks {text tags} {
- global ctext commitrow linknum curview pendinglinks
+ global ctext linknum curview pendinglinks
set start [$ctext index "end - 1c"]
$ctext insert end $text $tags
}
proc setlink {id lk} {
- global curview commitrow ctext pendinglinks commitinterest
+ global curview ctext pendinglinks commitinterest
- if {[info exists commitrow($curview,$id)]} {
+ if {[commitinview $id $curview]} {
$ctext tag conf $lk -foreground blue -underline 1
- $ctext tag bind $lk <1> [list selectline $commitrow($curview,$id) 1]
+ $ctext tag bind $lk <1> [list selectline [rowofcommit $id] 1]
$ctext tag bind $lk <Enter> {linkcursor %W 1}
$ctext tag bind $lk <Leave> {linkcursor %W -1}
} else {
# add a list of tag or branch names at position pos
# returns the number of names inserted
proc appendrefs {pos ids var} {
- global ctext commitrow linknum curview $var maxrefs
+ global ctext linknum curview $var maxrefs
if {[catch {$ctext index $pos}]} {
return 0
proc selectline {l isnew} {
global canv ctext commitinfo selectedline
- global displayorder
- global canvy0 linespc parentlist children curview
+ global canvy0 linespc parents children curview
global currentid sha1entry
global commentend idtags linknum
global mergemax numcommits pending_select
set selectedline $l
- set id [lindex $displayorder $l]
+ set id [commitonrow $l]
set currentid $id
$sha1entry delete 0 end
$sha1entry insert 0 $id
}
set headers {}
- set olds [lindex $parentlist $l]
+ set olds $parents($curview,$id)
if {[llength $olds] > 1} {
set np 0
foreach p $olds {
} elseif {[llength $olds] <= 1} {
startdiff $id
} else {
- mergediff $id $l
+ mergediff $id
}
}
$ctext insert end "$f\n" filesep
$ctext config -state disabled
$ctext yview $commentend
+ settabs 0
}
proc getblobline {bf id} {
return [expr {$nl >= 1000? 2: 1}]
}
-proc mergediff {id l} {
- global diffmergeid diffopts mdifffd
+proc mergediff {id} {
+ global diffmergeid mdifffd
global diffids
- global parentlist
+ global parents
+ global limitdiffs viewfiles curview
set diffmergeid $id
set diffids $id
# this doesn't seem to actually affect anything...
- set env(GIT_DIFF_OPTS) $diffopts
set cmd [concat | git diff-tree --no-commit-id --cc $id]
+ if {$limitdiffs && $viewfiles($curview) ne {}} {
+ set cmd [concat $cmd -- $viewfiles($curview)]
+ }
if {[catch {set mdf [open $cmd r]} err]} {
error_popup "Error getting merge diffs: $err"
return
}
fconfigure $mdf -blocking 0
set mdifffd($id) $mdf
- set np [llength [lindex $parentlist $l]]
+ set np [llength $parents($curview,$id)]
+ settabs $np
filerun $mdf [list getmergediffline $mdf $id $np]
}
proc startdiff {ids} {
global treediffs diffids treepending diffmergeid nullid nullid2
+ settabs 1
set diffids $ids
catch {unset diffmergeid}
if {![info exists treediffs($ids)] ||
}
}
+proc path_filter {filter name} {
+ foreach p $filter {
+ set l [string length $p]
+ if {[string index $p end] eq "/"} {
+ if {[string compare -length $l $p $name] == 0} {
+ return 1
+ }
+ } else {
+ if {[string compare -length $l $p $name] == 0 &&
+ ([string length $name] == $l ||
+ [string index $name $l] eq "/")} {
+ return 1
+ }
+ }
+ }
+ return 0
+}
+
proc addtocflist {ids} {
- global treediffs cflist
+ global treediffs
+
add_flist $treediffs($ids)
getblobdiffs $ids
}
proc gettreediffline {gdtf ids} {
global treediff treediffs treepending diffids diffmergeid
- global cmitmode
+ global cmitmode viewfiles curview limitdiffs
set nr 0
while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
return [expr {$nr >= 1000? 2: 1}]
}
close $gdtf
- set treediffs($ids) $treediff
+ if {$limitdiffs && $viewfiles($curview) ne {}} {
+ set flist {}
+ foreach f $treediff {
+ if {[path_filter $viewfiles($curview) $f]} {
+ lappend flist $f
+ }
+ }
+ set treediffs($ids) $flist
+ } else {
+ set treediffs($ids) $treediff
+ }
unset treepending
if {$cmitmode eq "tree"} {
gettree $diffids
}
proc getblobdiffs {ids} {
- global diffopts blobdifffd diffids env
+ global blobdifffd diffids env
global diffinhdr treediffs
global diffcontext
+ global limitdiffs viewfiles curview
- set env(GIT_DIFF_OPTS) $diffopts
- if {[catch {set bdf [open [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"] r]} err]} {
+ set cmd [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"]
+ if {$limitdiffs && $viewfiles($curview) ne {}} {
+ set cmd [concat $cmd -- $viewfiles($curview)]
+ }
+ if {[catch {set bdf [open $cmd r]} err]} {
puts "error getting diffs: $err"
return
}
set diffinhdr 0
} elseif {$diffinhdr} {
- if {![string compare -length 12 "rename from " $line] ||
- ![string compare -length 10 "copy from " $line]} {
+ if {![string compare -length 12 "rename from " $line]} {
set fname [string range $line [expr 6 + [string first " from " $line] ] end]
if {[string index $fname 0] eq "\""} {
set fname [lindex $fname 0]
}
}
+proc settabs {{firstab {}}} {
+ global firsttabstop tabstop ctext have_tk85
+
+ if {$firstab ne {} && $have_tk85} {
+ set firsttabstop $firstab
+ }
+ set w [font measure textfont "0"]
+ if {$firsttabstop != 0} {
+ $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
+ [expr {($firsttabstop + 2 * $tabstop) * $w}]]
+ } elseif {$have_tk85 || $tabstop != 8} {
+ $ctext conf -tabs [expr {$tabstop * $w}]
+ } else {
+ $ctext conf -tabs {}
+ }
+}
+
proc incrsearch {name ix op} {
global ctext searchstring searchdirn
}
proc setcoords {} {
- global linespc charspc canvx0 canvy0 mainfont
+ global linespc charspc canvx0 canvy0
global xspc1 xspc2 lthickness
- set linespc [font metrics $mainfont -linespace]
- set charspc [font measure $mainfont "m"]
+ set linespc [font metrics mainfont -linespace]
+ set charspc [font measure mainfont "m"]
set canvy0 [expr {int(3 + 0.5 * $linespc)}]
set canvx0 [expr {int(3 + 0.5 * $linespc)}]
set lthickness [expr {int($linespc / 9) + 1}]
}
}
-proc incrfont {inc} {
- global mainfont textfont ctext canv phase cflist showrefstop
- global charspc tabstop
- global stopped entries
- unmarkmatches
- set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
- set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
- setcoords
- $ctext conf -font $textfont -tabs "[expr {$tabstop * $charspc}]"
- $cflist conf -font $textfont
- $ctext tag conf filesep -font [concat $textfont bold]
- foreach e $entries {
- $e conf -font $mainfont
+proc parsefont {f n} {
+ global fontattr
+
+ set fontattr($f,family) [lindex $n 0]
+ set s [lindex $n 1]
+ if {$s eq {} || $s == 0} {
+ set s 10
+ } elseif {$s < 0} {
+ set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
+ }
+ set fontattr($f,size) $s
+ set fontattr($f,weight) normal
+ set fontattr($f,slant) roman
+ foreach style [lrange $n 2 end] {
+ switch -- $style {
+ "normal" -
+ "bold" {set fontattr($f,weight) $style}
+ "roman" -
+ "italic" {set fontattr($f,slant) $style}
+ }
}
- if {$phase eq "getcommits"} {
- $canv itemconf textitems -font $mainfont
+}
+
+proc fontflags {f {isbold 0}} {
+ global fontattr
+
+ return [list -family $fontattr($f,family) -size $fontattr($f,size) \
+ -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
+ -slant $fontattr($f,slant)]
+}
+
+proc fontname {f} {
+ global fontattr
+
+ set n [list $fontattr($f,family) $fontattr($f,size)]
+ if {$fontattr($f,weight) eq "bold"} {
+ lappend n "bold"
}
- if {[info exists showrefstop] && [winfo exists $showrefstop]} {
- $showrefstop.list conf -font $mainfont
+ if {$fontattr($f,slant) eq "italic"} {
+ lappend n "italic"
}
+ return $n
+}
+
+proc incrfont {inc} {
+ global mainfont textfont ctext canv cflist showrefstop
+ global stopped entries fontattr
+
+ unmarkmatches
+ set s $fontattr(mainfont,size)
+ incr s $inc
+ if {$s < 1} {
+ set s 1
+ }
+ set fontattr(mainfont,size) $s
+ font config mainfont -size $s
+ font config mainfontbold -size $s
+ set mainfont [fontname mainfont]
+ set s $fontattr(textfont,size)
+ incr s $inc
+ if {$s < 1} {
+ set s 1
+ }
+ set fontattr(textfont,size) $s
+ font config textfont -size $s
+ font config textfontbold -size $s
+ set textfont [fontname textfont]
+ setcoords
+ settabs
redisplay
}
}
proc gotocommit {} {
- global sha1string currentid commitrow tagids headids
- global displayorder numcommits curview
+ global sha1string tagids headids curview varcid
if {$sha1string == {}
|| ([info exists currentid] && $sha1string == $currentid)} return
} else {
set id [string tolower $sha1string]
if {[regexp {^[0-9a-f]{4,39}$} $id]} {
- set matches {}
- foreach i $displayorder {
- if {[string match $id* $i]} {
- lappend matches $i
- }
- }
+ set matches [array names varcid "$curview,$id*"]
if {$matches ne {}} {
if {[llength $matches] > 1} {
error_popup "Short SHA1 id $id is ambiguous"
return
}
- set id [lindex $matches 0]
+ set id [lindex [split [lindex $matches 0] ","] 1]
}
}
}
- if {[info exists commitrow($curview,$id)]} {
- selectline $commitrow($curview,$id) 1
+ if {[commitinview $id $curview]} {
+ selectline [rowofcommit $id] 1
return
}
if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
proc linehover {} {
global hoverx hovery hoverid hovertimer
global canv linespc lthickness
- global commitinfo mainfont
+ global commitinfo
set text [lindex $commitinfo($hoverid) 0]
set ymax [lindex [$canv cget -scrollregion] 3]
set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
set x0 [expr {$x - 2 * $lthickness}]
set y0 [expr {$y - 2 * $lthickness}]
- set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
+ set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
set y1 [expr {$y + $linespc + 2 * $lthickness}]
set t [$canv create rectangle $x0 $y0 $x1 $y1 \
-fill \#ffff80 -outline black -width 1 -tags hover]
$canv raise $t
set t [$canv create text $x $y -anchor nw -text $text -tags hover \
- -font $mainfont]
+ -font mainfont]
$canv raise $t
}
}
proc lineclick {x y id isnew} {
- global ctext commitinfo children canv thickerline curview commitrow
+ global ctext commitinfo children canv thickerline curview
if {![info exists commitinfo($id)] && ![getcommit $id]} return
unmarkmatches
# fill the details pane with info about this line
$ctext conf -state normal
clear_ctext
+ settabs 0
$ctext insert end "Parent:\t"
$ctext insert end $id link0
setlink $id link0
}
proc selbyid {id} {
- global commitrow curview
- if {[info exists commitrow($curview,$id)]} {
- selectline $commitrow($curview,$id) 1
+ global curview
+ if {[commitinview $id $curview]} {
+ selectline [rowofcommit $id] 1
}
}
}
proc rowmenu {x y id} {
- global rowctxmenu commitrow selectedline rowmenuid curview
+ global rowctxmenu selectedline rowmenuid curview
global nullid nullid2 fakerowmenu mainhead
stopfinding
set rowmenuid $id
if {![info exists selectedline]
- || $commitrow($curview,$id) eq $selectedline} {
+ || [rowofcommit $id] eq $selectedline} {
set state disabled
} else {
set state normal
}
proc diffvssel {dirn} {
- global rowmenuid selectedline displayorder
+ global rowmenuid selectedline
if {![info exists selectedline]} return
if {$dirn} {
- set oldid [lindex $displayorder $selectedline]
+ set oldid [commitonrow $selectedline]
set newid $rowmenuid
} else {
set oldid $rowmenuid
- set newid [lindex $displayorder $selectedline]
+ set newid [commitonrow $selectedline]
}
addtohistory [list doseldiff $oldid $newid]
doseldiff $oldid $newid
}
proc redrawtags {id} {
- global canv linehtag commitrow idpos selectedline curview
- global mainfont canvxmax iddrawn
+ global canv linehtag idpos selectedline curview
+ global canvxmax iddrawn
- if {![info exists commitrow($curview,$id)]} return
+ if {![commitinview $id $curview]} return
if {![info exists iddrawn($id)]} return
- drawcommits $commitrow($curview,$id)
+ drawcommits [rowofcommit $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]}]
+ $canv coords $linehtag([rowofcommit $id]) $xt [lindex $idpos($id) 2]
+ set text [$canv itemcget $linehtag([rowofcommit $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)} {
+ && $selectedline == [rowofcommit $id]} {
selectline $selectedline 0
}
}
}
proc cherrypick {} {
- global rowmenuid curview commitrow
+ global rowmenuid curview
global mainhead
set oldhead [exec git rev-parse HEAD]
included in branch $mainhead -- really re-apply it?"]
if {!$ok} return
}
- nowbusy cherrypick
+ nowbusy cherrypick "Cherry-picking"
update
# Unfortunately git-cherry-pick writes stuff to stderr even when
# no error occurs, and exec takes that as an indication of error...
return
}
addnewchild $newhead $oldhead
- if {[info exists commitrow($curview,$oldhead)]} {
- insertrow $commitrow($curview,$oldhead) $newhead
+ if {[commitinview $oldhead $curview]} {
+ insertrow $newhead $oldhead $curview
if {$mainhead ne {}} {
movehead $newhead $mainhead
movedhead $newhead $mainhead
error_popup $err
} else {
dohidelocalchanges
- set w ".resetprogress"
- filerun $fd [list readresetstat $fd $w]
- toplevel $w
- wm transient $w
- wm title $w "Reset progress"
- message $w.m -text "Reset in progress, please wait..." \
- -justify center -aspect 1000
- pack $w.m -side top -fill x -padx 20 -pady 5
- canvas $w.c -width 150 -height 20 -bg white
- $w.c create rect 0 0 0 20 -fill green -tags rect
- pack $w.c -side top -fill x -padx 20 -pady 5 -expand 1
- nowbusy reset
+ filerun $fd [list readresetstat $fd]
+ nowbusy reset "Resetting"
}
}
-proc readresetstat {fd w} {
- global mainhead mainheadid showlocalchanges
+proc readresetstat {fd} {
+ global mainhead mainheadid showlocalchanges rprogcoord
if {[gets $fd line] >= 0} {
if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
- set x [expr {($m * 150) / $n}]
- $w.c coords rect 0 0 $x 20
+ set rprogcoord [expr {1.0 * $m / $n}]
+ adjustprogress
}
return 1
}
- destroy $w
+ set rprogcoord 0
+ adjustprogress
notbusy reset
if {[catch {close $fd} err]} {
error_popup $err
# check the tree is clean first??
set oldmainhead $mainhead
- nowbusy checkout
+ nowbusy checkout "Checking out"
update
dohidelocalchanges
if {[catch {
# Display a list of tags and heads
proc showrefs {} {
- global showrefstop bgcolor fgcolor selectbgcolor mainfont
- global bglist fglist uifont reflistfilter reflist maincursor
+ global showrefstop bgcolor fgcolor selectbgcolor
+ global bglist fglist reflistfilter reflist maincursor
set top .showrefs
set showrefstop $top
toplevel $top
wm title $top "Tags and heads: [file tail [pwd]]"
text $top.list -background $bgcolor -foreground $fgcolor \
- -selectbackground $selectbgcolor -font $mainfont \
+ -selectbackground $selectbgcolor -font mainfont \
-xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
-width 30 -height 20 -cursor $maincursor \
-spacing1 1 -spacing3 1 -state disabled
grid $top.list $top.ysb -sticky nsew
grid $top.xsb x -sticky ew
frame $top.f
- label $top.f.l -text "Filter: " -font $uifont
- entry $top.f.e -width 20 -textvariable reflistfilter -font $uifont
+ label $top.f.l -text "Filter: " -font uifont
+ entry $top.f.e -width 20 -textvariable reflistfilter -font uifont
set reflistfilter "*"
trace add variable reflistfilter write reflistfilter_change
pack $top.f.e -side right -fill x -expand 1
pack $top.f.l -side left
grid $top.f - -sticky ew -pady 2
button $top.close -command [list destroy $top] -text "Close" \
- -font $uifont
+ -font uifont
grid $top.close -
grid columnconfigure $top 0 -weight 1
grid rowconfigure $top 0 -weight 1
proc refill_reflist {} {
global reflist reflistfilter showrefstop headids tagids otherrefids
- global commitrow curview commitinterest
+ global 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))]} {
+ if {[commitinview $headids($n) $curview]} {
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))]} {
+ if {[commitinview $tagids($n) $curview]} {
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))]} {
+ if {[commitinview $otherrefids($n) $curview]} {
lappend refs [list $n o]
} else {
set commitinterest($otherrefids($n)) {run refill_reflist}
global arcnos arcids arctags arcout arcend arcstart archeads growing
global seeds allcommits
- if {![info exists allcommits]} return
+ if {![info exists allcommits] || ![info exists arcnos($p)]} return
set allparents($id) [list $p]
set allchildren($id) {}
set arcnos($id) {}
}
$ctext conf -state normal
clear_ctext
+ settabs 0
set linknum 0
if {![info exists tagcontents($tag)]} {
catch {
destroy .
}
+proc mkfontdisp {font top which} {
+ global fontattr fontpref $font
+
+ set fontpref($font) [set $font]
+ button $top.${font}but -text $which -font optionfont \
+ -command [list choosefont $font $which]
+ label $top.$font -relief flat -font $font \
+ -text $fontattr($font,family) -justify left
+ grid x $top.${font}but $top.$font -sticky w
+}
+
+proc choosefont {font which} {
+ global fontparam fontlist fonttop fontattr
+
+ set fontparam(which) $which
+ set fontparam(font) $font
+ set fontparam(family) [font actual $font -family]
+ set fontparam(size) $fontattr($font,size)
+ set fontparam(weight) $fontattr($font,weight)
+ set fontparam(slant) $fontattr($font,slant)
+ set top .gitkfont
+ set fonttop $top
+ if {![winfo exists $top]} {
+ font create sample
+ eval font config sample [font actual $font]
+ toplevel $top
+ wm title $top "Gitk font chooser"
+ label $top.l -textvariable fontparam(which) -font uifont
+ pack $top.l -side top
+ set fontlist [lsort [font families]]
+ frame $top.f
+ listbox $top.f.fam -listvariable fontlist \
+ -yscrollcommand [list $top.f.sb set]
+ bind $top.f.fam <<ListboxSelect>> selfontfam
+ scrollbar $top.f.sb -command [list $top.f.fam yview]
+ pack $top.f.sb -side right -fill y
+ pack $top.f.fam -side left -fill both -expand 1
+ pack $top.f -side top -fill both -expand 1
+ frame $top.g
+ spinbox $top.g.size -from 4 -to 40 -width 4 \
+ -textvariable fontparam(size) \
+ -validatecommand {string is integer -strict %s}
+ checkbutton $top.g.bold -padx 5 \
+ -font {{Times New Roman} 12 bold} -text "B" -indicatoron 0 \
+ -variable fontparam(weight) -onvalue bold -offvalue normal
+ checkbutton $top.g.ital -padx 5 \
+ -font {{Times New Roman} 12 italic} -text "I" -indicatoron 0 \
+ -variable fontparam(slant) -onvalue italic -offvalue roman
+ pack $top.g.size $top.g.bold $top.g.ital -side left
+ pack $top.g -side top
+ canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
+ -background white
+ $top.c create text 100 25 -anchor center -text $which -font sample \
+ -fill black -tags text
+ bind $top.c <Configure> [list centertext $top.c]
+ pack $top.c -side top -fill x
+ frame $top.buts
+ button $top.buts.ok -text "OK" -command fontok -default active \
+ -font uifont
+ button $top.buts.can -text "Cancel" -command fontcan -default normal \
+ -font uifont
+ grid $top.buts.ok $top.buts.can
+ grid columnconfigure $top.buts 0 -weight 1 -uniform a
+ grid columnconfigure $top.buts 1 -weight 1 -uniform a
+ pack $top.buts -side bottom -fill x
+ trace add variable fontparam write chg_fontparam
+ } else {
+ raise $top
+ $top.c itemconf text -text $which
+ }
+ set i [lsearch -exact $fontlist $fontparam(family)]
+ if {$i >= 0} {
+ $top.f.fam selection set $i
+ $top.f.fam see $i
+ }
+}
+
+proc centertext {w} {
+ $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
+}
+
+proc fontok {} {
+ global fontparam fontpref prefstop
+
+ set f $fontparam(font)
+ set fontpref($f) [list $fontparam(family) $fontparam(size)]
+ if {$fontparam(weight) eq "bold"} {
+ lappend fontpref($f) "bold"
+ }
+ if {$fontparam(slant) eq "italic"} {
+ lappend fontpref($f) "italic"
+ }
+ set w $prefstop.$f
+ $w conf -text $fontparam(family) -font $fontpref($f)
+
+ fontcan
+}
+
+proc fontcan {} {
+ global fonttop fontparam
+
+ if {[info exists fonttop]} {
+ catch {destroy $fonttop}
+ catch {font delete sample}
+ unset fonttop
+ unset fontparam
+ }
+}
+
+proc selfontfam {} {
+ global fonttop fontparam
+
+ set i [$fonttop.f.fam curselection]
+ if {$i ne {}} {
+ set fontparam(family) [$fonttop.f.fam get $i]
+ }
+}
+
+proc chg_fontparam {v sub op} {
+ global fontparam
+
+ font config sample -$sub $fontparam($sub)
+}
+
proc doprefs {} {
- global maxwidth maxgraphpct diffopts
+ global maxwidth maxgraphpct
global oldprefs prefstop showneartags showlocalchanges
global bgcolor fgcolor ctext diffcolors selectbgcolor
- global uifont tabstop
+ global uifont tabstop limitdiffs
set top .gitkprefs
set prefstop $top
raise $top
return
}
- foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
+ foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
+ limitdiffs tabstop} {
set oldprefs($v) [set $v]
}
toplevel $top
wm title $top "Gitk preferences"
label $top.ldisp -text "Commit list display options"
- $top.ldisp configure -font $uifont
+ $top.ldisp configure -font uifont
grid $top.ldisp - -sticky w -pady 10
label $top.spacer -text " "
label $top.maxwidthl -text "Maximum graph width (lines)" \
grid x $top.showlocal -sticky w
label $top.ddisp -text "Diff display options"
- $top.ddisp configure -font $uifont
+ $top.ddisp configure -font uifont
grid $top.ddisp - -sticky w -pady 10
- label $top.diffoptl -text "Options for diff program" \
- -font optionfont
- entry $top.diffopt -width 20 -textvariable diffopts
- grid x $top.diffoptl $top.diffopt -sticky w
+ label $top.tabstopl -text "Tab spacing" -font optionfont
+ spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
+ grid x $top.tabstopl $top.tabstop -sticky w
frame $top.ntag
label $top.ntag.l -text "Display nearby tags" -font optionfont
checkbutton $top.ntag.b -variable showneartags
pack $top.ntag.b $top.ntag.l -side left
grid x $top.ntag -sticky w
- label $top.tabstopl -text "tabstop" -font optionfont
- spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
- grid x $top.tabstopl $top.tabstop -sticky w
+ frame $top.ldiff
+ label $top.ldiff.l -text "Limit diffs to listed paths" -font optionfont
+ checkbutton $top.ldiff.b -variable limitdiffs
+ pack $top.ldiff.b $top.ldiff.l -side left
+ grid x $top.ldiff -sticky w
label $top.cdisp -text "Colors: press to choose"
- $top.cdisp configure -font $uifont
+ $top.cdisp configure -font uifont
grid $top.cdisp - -sticky w -pady 10
label $top.bg -padx 40 -relief sunk -background $bgcolor
button $top.bgbut -text "Background" -font optionfont \
-command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
grid x $top.selbgbut $top.selbgsep -sticky w
+ label $top.cfont -text "Fonts: press to choose"
+ $top.cfont configure -font uifont
+ grid $top.cfont - -sticky w -pady 10
+ mkfontdisp mainfont $top "Main font"
+ mkfontdisp textfont $top "Diff display font"
+ mkfontdisp uifont $top "User interface font"
+
frame $top.buts
button $top.buts.ok -text "OK" -command prefsok -default active
- $top.buts.ok configure -font $uifont
+ $top.buts.ok configure -font uifont
button $top.buts.can -text "Cancel" -command prefscan -default normal
- $top.buts.can configure -font $uifont
+ $top.buts.can configure -font uifont
grid $top.buts.ok $top.buts.can
grid columnconfigure $top.buts 0 -weight 1 -uniform a
grid columnconfigure $top.buts 1 -weight 1 -uniform a
}
proc prefscan {} {
- global maxwidth maxgraphpct diffopts
- global oldprefs prefstop showneartags showlocalchanges
+ global oldprefs prefstop
- foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
+ foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
+ limitdiffs tabstop} {
+ global $v
set $v $oldprefs($v)
}
catch {destroy $prefstop}
unset prefstop
+ fontcan
}
proc prefsok {} {
global maxwidth maxgraphpct
global oldprefs prefstop showneartags showlocalchanges
- global charspc ctext tabstop
+ global fontpref mainfont textfont uifont
+ global limitdiffs treediffs
catch {destroy $prefstop}
unset prefstop
- $ctext configure -tabs "[expr {$tabstop * $charspc}]"
+ fontcan
+ set fontchanged 0
+ if {$mainfont ne $fontpref(mainfont)} {
+ set mainfont $fontpref(mainfont)
+ parsefont mainfont $mainfont
+ eval font configure mainfont [fontflags mainfont]
+ eval font configure mainfontbold [fontflags mainfont 1]
+ setcoords
+ set fontchanged 1
+ }
+ if {$textfont ne $fontpref(textfont)} {
+ set textfont $fontpref(textfont)
+ parsefont textfont $textfont
+ eval font configure textfont [fontflags textfont]
+ eval font configure textfontbold [fontflags textfont 1]
+ }
+ if {$uifont ne $fontpref(uifont)} {
+ set uifont $fontpref(uifont)
+ parsefont uifont $uifont
+ eval font configure uifont [fontflags uifont]
+ }
+ settabs
if {$showlocalchanges != $oldprefs(showlocalchanges)} {
if {$showlocalchanges} {
doshowlocalchanges
dohidelocalchanges
}
}
- if {$maxwidth != $oldprefs(maxwidth)
+ if {$limitdiffs != $oldprefs(limitdiffs)} {
+ # treediffs elements are limited by path
+ catch {unset treediffs}
+ }
+ if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
|| $maxgraphpct != $oldprefs(maxgraphpct)} {
redisplay
- } elseif {$showneartags != $oldprefs(showneartags)} {
+ } elseif {$showneartags != $oldprefs(showneartags) ||
+ $limitdiffs != $oldprefs(limitdiffs)} {
reselectline
}
}
return {}
}
+# First check that Tcl/Tk is recent enough
+if {[catch {package require Tk 8.4} err]} {
+ show_error {} . "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
+ Gitk requires at least Tcl/Tk 8.4."
+ exit 1
+}
+
# defaults...
set datemode 0
-set diffopts "-U 5 -p"
set wrcomcmd "git diff-tree --stdin -p --pretty"
set gitencoding {}
set maxrefs 20
set maxlinelen 200
set showlocalchanges 1
+set limitdiffs 1
set datetimeformat "%Y-%m-%d %H:%M:%S"
set colors {green red blue magenta darkgrey brown orange}
font create optionfont -family sans-serif -size -12
+parsefont mainfont $mainfont
+eval font create mainfont [fontflags mainfont]
+eval font create mainfontbold [fontflags mainfont 1]
+
+parsefont textfont $textfont
+eval font create textfont [fontflags textfont]
+eval font create textfontbold [fontflags textfont 1]
+
+parsefont uifont $uifont
+eval font create uifont [fontflags uifont]
+
# check that we can find a .git directory somewhere...
if {[catch {set gitdir [gitdir]}]} {
show_error {} . "Cannot find a git repository here."
exit 1
}
+set mergeonly 0
set revtreeargs {}
set cmdline_files {}
set i 0
switch -- $arg {
"" { }
"-d" { set datemode 1 }
+ "--merge" {
+ set mergeonly 1
+ lappend revtreeargs $arg
+ }
"--" {
set cmdline_files [lrange $argv [expr {$i + 1}] end]
break
}
}
+if {$mergeonly} {
+ # find the list of unmerged files
+ set mlist {}
+ set nr_unmerged 0
+ if {[catch {
+ set fd [open "| git ls-files -u" r]
+ } err]} {
+ show_error {} . "Couldn't get list of unmerged files: $err"
+ exit 1
+ }
+ while {[gets $fd line] >= 0} {
+ set i [string first "\t" $line]
+ if {$i < 0} continue
+ set fname [string range $line [expr {$i+1}] end]
+ if {[lsearch -exact $mlist $fname] >= 0} continue
+ incr nr_unmerged
+ if {$cmdline_files eq {} || [path_filter $cmdline_files $fname]} {
+ lappend mlist $fname
+ }
+ }
+ catch {close $fd}
+ if {$mlist eq {}} {
+ if {$nr_unmerged == 0} {
+ show_error {} . "No files selected: --merge specified but\
+ no files are unmerged."
+ } else {
+ show_error {} . "No files selected: --merge specified but\
+ no unmerged files are within file limit."
+ }
+ exit 1
+ }
+ set cmdline_files $mlist
+}
+
set nullid "0000000000000000000000000000000000000000"
set nullid2 "0000000000000000000000000000000000000001"
+set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
set runq {}
set history {}
set linkentercount 0
set need_redisplay 0
set nrows_drawn 0
+set firsttabstop 0
set nextviewnum 1
set curview 0
set viewperm(0) 0
set viewargs(0) {}
+set loginstance 0
+set getdbg 0
set cmdlineok 0
set stopped 0
set stuffsaved 0
set patchnum 0
-set localirow -1
-set localfrow -1
set lserial 0
setcoords
makewindow