}
proc parse_args {rargs} {
- global parsed_args
+ global parsed_args cmdline_files
+ set parsed_args {}
+ set cmdline_files {}
if {[catch {
- set parse_args [concat --default HEAD $rargs]
- set parsed_args [split [eval exec git-rev-parse $parse_args] "\n"]
+ set args [concat --default HEAD $rargs]
+ set args [split [eval exec git-rev-parse $args] "\n"]
+ set i 0
+ foreach arg $args {
+ if {![regexp {^[0-9a-f]{40}$} $arg]} {
+ if {$arg eq "--"} {
+ incr i
+ }
+ set cmdline_files [lrange $args $i end]
+ break
+ }
+ lappend parsed_args $arg
+ incr i
+ }
}]} {
# if git-rev-parse failed for some reason...
+ set i [lsearch -exact $rargs "--"]
+ if {$i >= 0} {
+ set cmdline_files [lrange $rargs [expr {$i+1}] end]
+ set rargs [lrange $rargs 0 [expr {$i-1}]]
+ }
if {$rargs == {}} {
- set rargs HEAD
+ set parsed_args HEAD
+ } else {
+ set parsed_args $rargs
}
- set parsed_args $rargs
}
- return $parsed_args
}
proc start_rev_list {rlargs} {
set startmsecs [clock clicks -milliseconds]
set nextupdate [expr {$startmsecs + 100}]
set ncmupdate 1
+ initlayout
set order "--topo-order"
if {$datemode} {
set order "--date-order"
}
if {[catch {
set commfd [open [concat | git-rev-list --header $order \
- --parents $rlargs] r]
+ --parents --boundary $rlargs] r]
} err]} {
puts stderr "Error executing git-rev-list: $err"
exit 1
global phase canv mainfont
set phase getcommits
- start_rev_list [parse_args $rargs]
+ start_rev_list $rargs
$canv delete all
$canv create text 3 3 -anchor nw -text "Reading commits..." \
-font $mainfont -tags textitems
}
proc getcommitlines {commfd} {
- global parents cdate children nchildren
global commitlisted nextupdate
- global stopped leftover
- global canv
+ global leftover
+ global displayorder commitidx commitrow commitdata
+ global parentlist childlist children
set stuff [read $commfd]
if {$stuff == {}} {
exit 1
}
set start 0
+ set gotsome 0
while 1 {
set i [string first "\0" $stuff $start]
if {$i < 0} {
append leftover [string range $stuff $start end]
break
}
- set cmit [string range $stuff $start [expr {$i - 1}]]
if {$start == 0} {
- set cmit "$leftover$cmit"
+ set cmit $leftover
+ append cmit [string range $stuff 0 [expr {$i - 1}]]
set leftover {}
+ } else {
+ set cmit [string range $stuff $start [expr {$i - 1}]]
}
set start [expr {$i + 1}]
set j [string first "\n" $cmit]
set ok 0
+ set listed 1
if {$j >= 0} {
set ids [string range $cmit 0 [expr {$j - 1}]]
+ if {[string range $ids 0 0] == "-"} {
+ set listed 0
+ set ids [string range $ids 1 end]
+ }
set ok 1
foreach id $ids {
- if {![regexp {^[0-9a-f]{40}$} $id]} {
+ if {[string length $id] != 40} {
set ok 0
break
}
exit 1
}
set id [lindex $ids 0]
- set olds [lrange $ids 1 end]
- set cmit [string range $cmit [expr {$j + 1}] end]
- set commitlisted($id) 1
- parsecommit $id $cmit 1 [lrange $ids 1 end]
- drawcommit $id 1
+ if {$listed} {
+ set olds [lrange $ids 1 end]
+ set i 0
+ foreach p $olds {
+ if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
+ lappend children($p) $id
+ }
+ incr i
+ }
+ } else {
+ set olds {}
+ }
+ lappend parentlist $olds
+ if {[info exists children($id)]} {
+ lappend childlist $children($id)
+ } else {
+ lappend childlist {}
+ }
+ set commitdata($id) [string range $cmit [expr {$j + 1}] end]
+ set commitrow($id) $commitidx
+ incr commitidx
+ lappend displayorder $id
+ lappend commitlisted $listed
+ set gotsome 1
+ }
+ if {$gotsome} {
+ layoutmore
}
- layoutmore
if {[clock clicks -milliseconds] >= $nextupdate} {
doupdate 1
}
proc readcommit {id} {
if {[catch {set contents [exec git-cat-file commit $id]}]} return
- parsecommit $id $contents 0 {}
+ parsecommit $id $contents 0
}
-proc updatecommits {rargs} {
- stopfindproc
- foreach v {children nchildren parents nparents commitlisted
- commitinfo colormap selectedline matchinglines treediffs
- mergefilelist currentid rowtextx commitrow lineid
- rowidlist rowoffsets idrowranges idrangedrawn iddrawn
- linesegends crossings cornercrossings} {
- global $v
- catch {unset $v}
- }
- allcanvs delete all
- readrefs
- getcommits $rargs
-}
-
-proc updatechildren {id olds} {
- global children nchildren parents nparents
+proc updatecommits {} {
+ global viewdata curview revtreeargs
- if {![info exists nchildren($id)]} {
- set children($id) {}
- set nchildren($id) 0
- }
- set parents($id) $olds
- set nparents($id) [llength $olds]
- foreach p $olds {
- if {![info exists nchildren($p)]} {
- set children($p) [list $id]
- set nchildren($p) 1
- } elseif {[lsearch -exact $children($p) $id] < 0} {
- lappend children($p) $id
- incr nchildren($p)
- }
- }
+ set n $curview
+ set curview -1
+ catch {unset viewdata($n)}
+ parse_args $revtreeargs
+ showview $n
}
-proc parsecommit {id contents listed olds} {
+proc parsecommit {id contents listed} {
global commitinfo cdate
set inhdr 1
set audate {}
set comname {}
set comdate {}
- updatechildren $id $olds
set hdrend [string first "\n\n" $contents]
if {$hdrend < 0} {
# should never happen...
$comname $comdate $comment]
}
+proc getcommit {id} {
+ global commitdata commitinfo
+
+ if {[info exists commitdata($id)]} {
+ parsecommit $id $commitdata($id) 1
+ } else {
+ readcommit $id
+ if {![info exists commitinfo($id)]} {
+ set commitinfo($id) {"No commit information available"}
+ }
+ }
+ return 1
+}
+
proc readrefs {} {
global tagids idtags headids idheads tagcontents
global otherrefids idotherrefs
foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
catch {unset $v}
}
- set refd [open [list | git-ls-remote [gitdir]] r]
+ set refd [open [list | git ls-remote [gitdir]] r]
while {0 <= [set n [gets $refd line]]} {
if {![regexp {^([0-9a-f]{40}) refs/([^^]*)$} $line \
match id path]} {
button $w.ok -text OK -command "destroy $w"
pack $w.ok -side bottom -fill x
bind $w <Visibility> "grab $w; focus $w"
+ bind $w <Key-Return> "destroy $w"
tkwait window $w
}
-proc makewindow {rargs} {
- global canv canv2 canv3 linespc charspc ctext cflist textfont
+proc makewindow {} {
+ global canv canv2 canv3 linespc charspc ctext cflist textfont mainfont uifont
global findtype findtypemenu findloc findstring fstring geometry
global entries sha1entry sha1string sha1but
global maincursor textcursor curtextcursor
menu .bar
.bar add cascade -label "File" -menu .bar.file
+ .bar configure -font $uifont
menu .bar.file
- .bar.file add command -label "Update" -command [list updatecommits $rargs]
+ .bar.file add command -label "Update" -command updatecommits
.bar.file add command -label "Reread references" -command rereadrefs
.bar.file add command -label "Quit" -command doquit
+ .bar.file configure -font $uifont
menu .bar.edit
.bar add cascade -label "Edit" -menu .bar.edit
.bar.edit add command -label "Preferences" -command doprefs
+ .bar.edit configure -font $uifont
+ menu .bar.view
+ .bar add cascade -label "View" -menu .bar.view
+ .bar.view add command -label "New view..." -command newview
+ .bar.view add command -label "Delete view" -command delview -state disabled
+ .bar.view add separator
+ .bar.view add command -label "All files" -command {showview 0}
menu .bar.help
.bar add cascade -label "Help" -menu .bar.help
.bar.help add command -label "About gitk" -command about
+ .bar.help add command -label "Key bindings" -command keys
+ .bar.help configure -font $uifont
. configure -menu .bar
if {![info exists geometry(canv1)]} {
set entries $sha1entry
set sha1but .ctop.top.bar.sha1label
button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
- -command gotocommit -width 8
+ -command gotocommit -width 8 -font $uifont
$sha1but conf -disabledforeground [$sha1but cget -foreground]
pack .ctop.top.bar.sha1label -side left
entry $sha1entry -width 40 -font $textfont -textvariable sha1string
-state disabled -width 26
pack .ctop.top.bar.rightbut -side left -fill y
- button .ctop.top.bar.findbut -text "Find" -command dofind
+ button .ctop.top.bar.findbut -text "Find" -command dofind -font $uifont
pack .ctop.top.bar.findbut -side left
set findstring {}
set fstring .ctop.top.bar.findstring
lappend entries $fstring
- entry $fstring -width 30 -font $textfont -textvariable findstring
+ entry $fstring -width 30 -font $textfont -textvariable findstring -font $textfont
pack $fstring -side left -expand 1 -fill x
set findtype Exact
set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
findtype Exact IgnCase Regexp]
+ .ctop.top.bar.findtype configure -font $uifont
+ .ctop.top.bar.findtype.menu configure -font $uifont
set findloc "All fields"
tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
Comments Author Committer Files Pickaxe
+ .ctop.top.bar.findloc configure -font $uifont
+ .ctop.top.bar.findloc.menu configure -font $uifont
+
pack .ctop.top.bar.findloc -side right
pack .ctop.top.bar.findtype -side right
# for making sure type==Exact whenever loc==Pickaxe
frame .ctop.cdet.right
set cflist .ctop.cdet.right.cfiles
listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
- -yscrollcommand ".ctop.cdet.right.sb set"
+ -yscrollcommand ".ctop.cdet.right.sb set" -font $mainfont
scrollbar .ctop.cdet.right.sb -command "$cflist yview"
pack .ctop.cdet.right.sb -side right -fill y
pack $cflist -side left -fill both -expand 1
#bindall <B1-Motion> {selcanvline %W %x %y}
bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
- bindall <2> "allcanvs scan mark 0 %y"
- bindall <B2-Motion> "allcanvs scan dragto 0 %y"
+ bindall <2> "canvscan mark %W %x %y"
+ bindall <B2-Motion> "canvscan dragto %W %x %y"
+ bindkey <Home> selfirstline
+ bindkey <End> sellastline
bind . <Key-Up> "selnextline -1"
bind . <Key-Down> "selnextline 1"
- bind . <Key-Right> "goforw"
- bind . <Key-Left> "goback"
- bind . <Key-Prior> "allcanvs yview scroll -1 pages"
- bind . <Key-Next> "allcanvs yview scroll 1 pages"
+ bindkey <Key-Right> "goforw"
+ bindkey <Key-Left> "goback"
+ bind . <Key-Prior> "selnextpage -1"
+ bind . <Key-Next> "selnextpage 1"
+ bind . <Control-Home> "allcanvs yview moveto 0.0"
+ bind . <Control-End> "allcanvs yview moveto 1.0"
+ bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
+ bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
+ bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
+ bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
bindkey <Key-Delete> "$ctext yview scroll -1 pages"
bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
bindkey <Key-space> "$ctext yview scroll 1 pages"
$rowctxmenu add command -label "Write commit to file" -command writecommit
}
+# mouse-2 makes all windows scan vertically, but only the one
+# the cursor is in scans horizontally
+proc canvscan {op w x y} {
+ global canv canv2 canv3
+ foreach c [list $canv $canv2 $canv3] {
+ if {$c == $w} {
+ $c scan $op $x $y
+ } else {
+ $c scan $op 0 $y
+ }
+ }
+}
+
proc scrollcanv {cscroll f0 f1} {
$cscroll set $f0 $f1
drawfrac $f0 $f1
}
proc savestuff {w} {
- global canv canv2 canv3 ctext cflist mainfont textfont
+ global canv canv2 canv3 ctext cflist mainfont textfont uifont
global stuffsaved findmergefiles maxgraphpct
global maxwidth
set f [open "~/.gitk-new" w]
puts $f [list set mainfont $mainfont]
puts $f [list set textfont $textfont]
+ puts $f [list set uifont $uifont]
puts $f [list set findmergefiles $findmergefiles]
puts $f [list set maxgraphpct $maxgraphpct]
puts $f [list set maxwidth $maxwidth]
pack $w.ok -side bottom
}
+proc keys {} {
+ set w .keys
+ if {[winfo exists $w]} {
+ raise $w
+ return
+ }
+ toplevel $w
+ wm title $w "Gitk key bindings"
+ message $w.m -text {
+Gitk key bindings:
+
+<Ctrl-Q> Quit
+<Home> Move to first commit
+<End> Move to last commit
+<Up>, p, i Move up one commit
+<Down>, n, k Move down one commit
+<Left>, z, j Go back in history list
+<Right>, x, l Go forward in history list
+<PageUp> Move up one page in commit list
+<PageDown> Move down one page in commit list
+<Ctrl-Home> Scroll to top of commit list
+<Ctrl-End> Scroll to bottom of commit list
+<Ctrl-Up> Scroll commit list up one line
+<Ctrl-Down> Scroll commit list down one line
+<Ctrl-PageUp> Scroll commit list up one page
+<Ctrl-PageDown> Scroll commit list down one page
+<Delete>, b Scroll diff view up one page
+<Backspace> Scroll diff view up one page
+<Space> Scroll diff view down one page
+u Scroll diff view up 18 lines
+d Scroll diff view down 18 lines
+<Ctrl-F> Find
+<Ctrl-G> Move to next find hit
+<Ctrl-R> Move to previous find hit
+<Return> Move to next find hit
+/ Move to next find hit, or redo find
+? Move to previous find hit
+f Scroll diff view to next file
+<Ctrl-KP+> Increase font size
+<Ctrl-plus> Increase font size
+<Ctrl-KP-> Decrease font size
+<Ctrl-minus> Decrease font size
+} \
+ -justify left -bg white -border 2 -relief sunken
+ pack $w.m -side top -fill both
+ button $w.ok -text Close -command "destroy $w"
+ pack $w.ok -side bottom
+}
+
+proc newview {} {
+ global newviewname nextviewnum newviewtop
+
+ set top .gitkview
+ if {[winfo exists $top]} {
+ raise $top
+ return
+ }
+ set newviewtop $top
+ toplevel $top
+ wm title $top "Gitk view definition"
+ label $top.nl -text "Name"
+ entry $top.name -width 20 -textvariable newviewname
+ set newviewname "View $nextviewnum"
+ grid $top.nl $top.name -sticky w
+ label $top.l -text "Files and directories to include:"
+ grid $top.l - -sticky w -pady 10
+ text $top.t -width 30 -height 10
+ grid $top.t - -sticky w
+ frame $top.buts
+ button $top.buts.ok -text "OK" -command newviewok
+ button $top.buts.can -text "Cancel" -command newviewcan
+ grid $top.buts.ok $top.buts.can
+ grid columnconfigure $top.buts 0 -weight 1 -uniform a
+ grid columnconfigure $top.buts 1 -weight 1 -uniform a
+ grid $top.buts - -pady 10 -sticky ew
+ focus $top.t
+}
+
+proc newviewok {} {
+ global newviewtop nextviewnum
+ global viewname viewfiles
+
+ set n $nextviewnum
+ incr nextviewnum
+ set viewname($n) [$newviewtop.name get]
+ set files {}
+ foreach f [split [$newviewtop.t get 0.0 end] "\n"] {
+ set ft [string trim $f]
+ if {$ft ne {}} {
+ lappend files $ft
+ }
+ }
+ set viewfiles($n) $files
+ catch {destroy $newviewtop}
+ unset newviewtop
+ .bar.view add command -label $viewname($n) -command [list showview $n]
+ after idle showview $n
+}
+
+proc newviewcan {} {
+ global newviewtop
+
+ catch {destroy $newviewtop}
+ unset newviewtop
+}
+
+proc delview {} {
+ global curview viewdata
+
+ if {$curview == 0} return
+ set nmenu [.bar.view index end]
+ set targetcmd [list showview $curview]
+ for {set i 5} {$i <= $nmenu} {incr i} {
+ if {[.bar.view entrycget $i -command] eq $targetcmd} {
+ .bar.view delete $i
+ break
+ }
+ }
+ set viewdata($curview) {}
+ showview 0
+}
+
+proc showview {n} {
+ global curview viewdata viewfiles
+ global displayorder parentlist childlist rowidlist rowoffsets
+ global colormap rowtextx commitrow
+ global numcommits rowrangelist commitlisted idrowranges
+ global selectedline currentid canv canvy0
+ global matchinglines treediffs
+ global parsed_args
+ global pending_select phase
+
+ if {$n == $curview} return
+ set selid {}
+ if {[info exists selectedline]} {
+ set selid $currentid
+ set y [yc $selectedline]
+ set ymax [lindex [$canv cget -scrollregion] 3]
+ set span [$canv yview]
+ set ytop [expr {[lindex $span 0] * $ymax}]
+ set ybot [expr {[lindex $span 1] * $ymax}]
+ if {$ytop < $y && $y < $ybot} {
+ set yscreen [expr {$y - $ytop}]
+ } else {
+ set yscreen [expr {($ybot - $ytop) / 2}]
+ }
+ }
+ unselectline
+ stopfindproc
+ if {$curview >= 0 && $phase eq {} && ![info exists viewdata($curview)]} {
+ set viewdata($curview) \
+ [list $displayorder $parentlist $childlist $rowidlist \
+ $rowoffsets $rowrangelist $commitlisted]
+ }
+ catch {unset matchinglines}
+ catch {unset treediffs}
+ clear_display
+ readrefs
+
+ set curview $n
+ .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
+
+ if {![info exists viewdata($n)]} {
+ set args $parsed_args
+ if {$viewfiles($n) ne {}} {
+ set args [concat $args "--" $viewfiles($n)]
+ }
+ set pending_select $selid
+ getcommits $args
+ return
+ }
+
+ set displayorder [lindex $viewdata($n) 0]
+ set parentlist [lindex $viewdata($n) 1]
+ set childlist [lindex $viewdata($n) 2]
+ set rowidlist [lindex $viewdata($n) 3]
+ set rowoffsets [lindex $viewdata($n) 4]
+ set rowrangelist [lindex $viewdata($n) 5]
+ set commitlisted [lindex $viewdata($n) 6]
+ set numcommits [llength $displayorder]
+ catch {unset colormap}
+ catch {unset rowtextx}
+ catch {unset commitrow}
+ catch {unset idrowranges}
+ set curview $n
+ set row 0
+ foreach id $displayorder {
+ set commitrow($id) $row
+ incr row
+ }
+ setcanvscroll
+ set yf 0
+ set row 0
+ if {$selid ne {} && [info exists commitrow($selid)]} {
+ set row $commitrow($selid)
+ # try to get the selected row in the same position on the screen
+ set ymax [lindex [$canv cget -scrollregion] 3]
+ set ytop [expr {[yc $row] - $yscreen}]
+ if {$ytop < 0} {
+ set ytop 0
+ }
+ set yf [expr {$ytop * 1.0 / $ymax}]
+ }
+ allcanvs yview moveto $yf
+ drawvisible
+ selectline $row 0
+}
+
proc shortids {ids} {
set res {}
foreach id $ids {
global rowidlist rowoffsets
set col -1
- set ids $rowidlist($row)
+ set ids [lindex $rowidlist $row]
foreach id $ids {
incr col
if {$id eq {}} continue
if {$col < [llength $ids] - 1 &&
[lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
- puts "oops: [shortids $id] repeated in row $row col $col: {[shortids $rowidlist($row)]}"
+ puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
}
- set o [lindex $rowoffsets($row) $col]
+ set o [lindex $rowoffsets $row $col]
set y $row
set x $col
while {$o ne {}} {
incr y -1
incr x $o
- if {[lindex $rowidlist($y) $x] != $id} {
+ if {[lindex $rowidlist $y $x] != $id} {
puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
puts " id=[shortids $id] check started at row $row"
for {set i $row} {$i >= $y} {incr i -1} {
- puts " row $i ids={[shortids $rowidlist($i)]} offs={$rowoffsets($i)}"
+ puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
}
break
}
if {!$full} break
- set o [lindex $rowoffsets($y) $x]
+ set o [lindex $rowoffsets $y $x]
}
}
}
for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
incr y -1
incr x $z
- set off0 $rowoffsets($y)
+ set off0 [lindex $rowoffsets $y]
for {set x0 $x} {1} {incr x0} {
if {$x0 >= [llength $off0]} {
- set x0 [llength $rowoffsets([expr {$y-1}])]
+ set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
break
}
set z [lindex $off0 $x0]
}
}
set z [expr {$x0 - $x}]
- set rowidlist($y) [linsert $rowidlist($y) $x $oid]
- set rowoffsets($y) [linsert $rowoffsets($y) $x $z]
+ lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
+ lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
}
- set tmp [lreplace $rowoffsets($y) $x $x {}]
- set rowoffsets($y) [incrange $tmp [expr {$x+1}] -1]
+ set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
+ lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
lappend idrowranges($oid) $y
}
proc initlayout {} {
- global rowidlist rowoffsets displayorder
+ global rowidlist rowoffsets displayorder commitlisted
global rowlaidout rowoptim
- global idinlist rowchk
-
- set rowidlist(0) {}
- set rowoffsets(0) {}
+ global idinlist rowchk rowrangelist idrowranges
+ global commitidx numcommits canvxmax canv
+ global nextcolor
+ global parentlist childlist children
+ global colormap rowtextx commitrow
+ global linesegends
+
+ set commitidx 0
+ set numcommits 0
+ set displayorder {}
+ set commitlisted {}
+ set parentlist {}
+ set childlist {}
+ set rowrangelist {}
+ catch {unset children}
+ set nextcolor 0
+ set rowidlist {{}}
+ set rowoffsets {{}}
catch {unset idinlist}
catch {unset rowchk}
set rowlaidout 0
set rowoptim 0
+ set canvxmax [$canv cget -width]
+ catch {unset colormap}
+ catch {unset rowtextx}
+ catch {unset commitrow}
+ catch {unset idrowranges}
+ catch {unset linesegends}
+}
+
+proc setcanvscroll {} {
+ global canv canv2 canv3 numcommits linespc canvxmax canvy0
+
+ set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
+ $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
+ $canv2 conf -scrollregion [list 0 0 0 $ymax]
+ $canv3 conf -scrollregion [list 0 0 0 $ymax]
}
proc visiblerows {} {
set rowlaidout [layoutrows $row $commitidx 0]
set orow [expr {$rowlaidout - $uparrowlen - 1}]
if {$orow > $rowoptim} {
- checkcrossings $rowoptim $orow
optimize_rows $rowoptim 0 $orow
set rowoptim $orow
}
}
proc showstuff {canshow} {
- global numcommits
- global canvy0 linespc
+ global numcommits commitrow pending_select
global linesegends idrowranges idrangedrawn
+ if {$numcommits == 0} {
+ global phase
+ set phase "incrdraw"
+ allcanvs delete all
+ }
set row $numcommits
set numcommits $canshow
- allcanvs conf -scrollregion \
- [list 0 0 0 [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]]
+ setcanvscroll
set rows [visiblerows]
set r0 [lindex $rows 0]
set r1 [lindex $rows 1]
+ set selrow -1
for {set r $row} {$r < $canshow} {incr r} {
if {[info exists linesegends($r)]} {
foreach id $linesegends($r) {
incr i
if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
&& ![info exists idrangedrawn($id,$i)]} {
- drawlineseg $id $i 1
+ drawlineseg $id $i
set idrangedrawn($id,$i) 1
}
}
drawcmitrow $row
incr row
}
+ if {[info exists pending_select] &&
+ [info exists commitrow($pending_select)] &&
+ $commitrow($pending_select) < $numcommits} {
+ selectline $commitrow($pending_select) 1
+ }
}
proc layoutrows {row endrow last} {
global rowidlist rowoffsets displayorder
global uparrowlen downarrowlen maxwidth mingaplen
- global nchildren parents nparents
+ global childlist parentlist
global idrowranges linesegends
global commitidx
- global idinlist rowchk
+ global idinlist rowchk rowrangelist
- set idlist $rowidlist($row)
- set offs $rowoffsets($row)
+ set idlist [lindex $rowidlist $row]
+ set offs [lindex $rowoffsets $row]
while {$row < $endrow} {
set id [lindex $displayorder $row]
set oldolds {}
set newolds {}
- foreach p $parents($id) {
+ foreach p [lindex $parentlist $row] {
if {![info exists idinlist($p)]} {
lappend newolds $p
} elseif {!$idinlist($p)} {
set offs [lreplace $offs $x $x]
set offs [incrange $offs $x 1]
set idinlist($i) 0
- lappend linesegends($row) $i
- lappend idrowranges($i) [expr {$row-1}]
+ set rm1 [expr {$row - 1}]
+ lappend linesegends($rm1) $i
+ lappend idrowranges($i) $rm1
if {[incr nev -1] <= 0} break
continue
}
set rowchk($id) [expr {$row + $r}]
}
}
- set rowidlist($row) $idlist
- set rowoffsets($row) $offs
+ lset rowidlist $row $idlist
+ lset rowoffsets $row $offs
}
set col [lsearch -exact $idlist $id]
if {$col < 0} {
set col [llength $idlist]
lappend idlist $id
- set rowidlist($row) $idlist
+ lset rowidlist $row $idlist
set z {}
- if {$nchildren($id) > 0} {
- set z [expr {[llength $rowidlist([expr {$row-1}])] - $col}]
+ if {[lindex $childlist $row] ne {}} {
+ set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
unset idinlist($id)
}
lappend offs $z
- set rowoffsets($row) $offs
+ lset rowoffsets $row $offs
if {$z ne {}} {
makeuparrow $id $col $row $z
}
} else {
unset idinlist($id)
}
+ set ranges {}
if {[info exists idrowranges($id)]} {
- lappend linesegends($row) $id
lappend idrowranges($id) $row
+ set ranges $idrowranges($id)
}
+ lappend rowrangelist $ranges
incr row
set offs [ntimes [llength $idlist] 0]
set l [llength $newolds]
makeuparrow $oid $col $row $o
incr col
}
- set rowidlist($row) $idlist
- set rowoffsets($row) $offs
+ lappend rowidlist $idlist
+ lappend rowoffsets $offs
}
return $row
}
proc addextraid {id row} {
- global displayorder commitrow lineid commitinfo nparents
+ global displayorder commitrow commitinfo
global commitidx
+ global parentlist childlist children
incr commitidx
lappend displayorder $id
+ lappend parentlist {}
set commitrow($id) $row
- set lineid($row) $id
readcommit $id
if {![info exists commitinfo($id)]} {
set commitinfo($id) {"No commit information available"}
- set nparents($id) 0
+ }
+ if {[info exists children($id)]} {
+ lappend childlist $children($id)
+ } else {
+ lappend childlist {}
}
}
proc layouttail {} {
global rowidlist rowoffsets idinlist commitidx
- global idrowranges linesegends
+ global idrowranges rowrangelist
set row $commitidx
- set idlist $rowidlist($row)
+ set idlist [lindex $rowidlist $row]
while {$idlist ne {}} {
set col [expr {[llength $idlist] - 1}]
set id [lindex $idlist $col]
addextraid $id $row
unset idinlist($id)
- lappend linesegends($row) $id
lappend idrowranges($id) $row
+ lappend rowrangelist $idrowranges($id)
incr row
set offs [ntimes $col 0]
set idlist [lreplace $idlist $col $col]
- set rowidlist($row) $idlist
- set rowoffsets($row) $offs
+ lappend rowidlist $idlist
+ lappend rowoffsets $offs
}
foreach id [array names idinlist] {
addextraid $id $row
- set rowidlist($row) [list $id]
- set rowoffsets($row) 0
+ lset rowidlist $row [list $id]
+ lset rowoffsets $row 0
makeuparrow $id 0 $row 0
- lappend linesegends($row) $id
lappend idrowranges($id) $row
+ lappend rowrangelist $idrowranges($id)
incr row
+ lappend rowidlist {}
+ lappend rowoffsets {}
}
}
global rowidlist rowoffsets
set pad [ntimes $npad {}]
- set rowidlist($row) [eval linsert \$rowidlist($row) $col $pad]
- set tmp [eval linsert \$rowoffsets($row) $col $pad]
- set rowoffsets($row) [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
+ lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
+ set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
+ lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
}
proc optimize_rows {row col endrow} {
- global rowidlist rowoffsets idrowranges
+ global rowidlist rowoffsets idrowranges displayorder
for {} {$row < $endrow} {incr row} {
- set idlist $rowidlist($row)
- set offs $rowoffsets($row)
+ set idlist [lindex $rowidlist $row]
+ set offs [lindex $rowoffsets $row]
set haspad 0
for {} {$col < [llength $offs]} {incr col} {
if {[lindex $idlist $col] eq {}} {
set isarrow 0
set x0 [expr {$col + $z}]
set y0 [expr {$row - 1}]
- set z0 [lindex $rowoffsets($y0) $x0]
+ set z0 [lindex $rowoffsets $y0 $x0]
if {$z0 eq {}} {
set id [lindex $idlist $col]
if {[info exists idrowranges($id)] &&
}
set z [lindex $offs $col]
set x0 [expr {$col + $z}]
- set z0 [lindex $rowoffsets($y0) $x0]
+ set z0 [lindex $rowoffsets $y0 $x0]
} elseif {$z > 1 || ($z > 0 && $isarrow)} {
set npad [expr {$z - 1 + $isarrow}]
set y1 [expr {$row + 1}]
- set offs2 $rowoffsets($y1)
+ set offs2 [lindex $rowoffsets $y1]
set x1 -1
foreach z $offs2 {
incr x1
if {$x1 + $z > $col} {
incr npad
}
- set rowoffsets($y1) [incrange $offs2 $x1 $npad]
+ lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
break
}
set pad [ntimes $npad {}]
set z [lindex $offs $col]
set haspad 1
}
+ if {$z0 eq {} && !$isarrow} {
+ # this line links to its first child on row $row-2
+ set rm2 [expr {$row - 2}]
+ set id [lindex $displayorder $rm2]
+ set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
+ if {$xc >= 0} {
+ set z0 [expr {$xc - $x0}]
+ }
+ }
if {$z0 ne {} && $z < 0 && $z0 > 0} {
insert_pad $y0 $x0 1
set offs [incrange $offs $col 1]
}
}
if {!$haspad} {
+ set o {}
for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
set o [lindex $offs $col]
+ if {$o eq {}} {
+ # check if this is the link to the first child
+ set id [lindex $idlist $col]
+ if {[info exists idrowranges($id)] &&
+ $row == [lindex $idrowranges($id) 0]} {
+ # it is, work out offset to child
+ set y0 [expr {$row - 1}]
+ set id [lindex $displayorder $y0]
+ set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
+ if {$x0 >= 0} {
+ set o [expr {$x0 - $col}]
+ }
+ }
+ }
if {$o eq {} || $o <= 0} break
}
- if {[incr col] < [llength $idlist]} {
+ if {$o ne {} && [incr col] < [llength $idlist]} {
set y1 [expr {$row + 1}]
- set offs2 $rowoffsets($y1)
+ set offs2 [lindex $rowoffsets $y1]
set x1 -1
foreach z $offs2 {
incr x1
if {$z eq {} || $x1 + $z < $col} continue
- set rowoffsets($y1) [incrange $offs2 $x1 1]
+ lset rowoffsets $y1 [incrange $offs2 $x1 1]
break
}
set idlist [linsert $idlist $col {}]
set offs [incrange $tmp $col -1]
}
}
- set rowidlist($row) $idlist
- set rowoffsets($row) $offs
+ lset rowidlist $row $idlist
+ lset rowoffsets $row $offs
set col 0
}
}
return [expr {$canvy0 + $row * $linespc}]
}
-proc drawlineseg {id i wid} {
- global rowoffsets rowidlist idrowranges
- global canv colormap lthickness
+proc linewidth {id} {
+ global thickerline lthickness
+
+ set wid $lthickness
+ if {[info exists thickerline] && $id eq $thickerline} {
+ set wid [expr {2 * $lthickness}]
+ }
+ return $wid
+}
+
+proc rowranges {id} {
+ global idrowranges commitrow numcommits rowrangelist
+
+ set ranges {}
+ if {[info exists commitrow($id)] && $commitrow($id) < $numcommits} {
+ set ranges [lindex $rowrangelist $commitrow($id)]
+ } elseif {[info exists idrowranges($id)]} {
+ set ranges $idrowranges($id)
+ }
+ return $ranges
+}
+
+proc drawlineseg {id i} {
+ global rowoffsets rowidlist
+ global displayorder
+ global canv colormap linespc
+ global numcommits commitrow
- set startrow [lindex $idrowranges($id) [expr {2 * $i}]]
- set row [lindex $idrowranges($id) [expr {2 * $i + 1}]]
+ set ranges [rowranges $id]
+ set downarrow 1
+ if {[info exists commitrow($id)] && $commitrow($id) < $numcommits} {
+ set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
+ } else {
+ set downarrow 1
+ }
+ set startrow [lindex $ranges [expr {2 * $i}]]
+ set row [lindex $ranges [expr {2 * $i + 1}]]
if {$startrow == $row} return
assigncolor $id
set coords {}
- set col [lsearch -exact $rowidlist($row) $id]
+ set col [lsearch -exact [lindex $rowidlist $row] $id]
if {$col < 0} {
puts "oops: drawline: id $id not on row $row"
return
set lasto {}
set ns 0
while {1} {
- set o [lindex $rowoffsets($row) $col]
+ set o [lindex $rowoffsets $row $col]
if {$o eq {}} break
if {$o ne $lasto} {
# changing direction
incr col $o
incr row -1
}
- if {$coords eq {}} return
- set last [expr {[llength $idrowranges($id)] / 2 - 1}]
- set arrow [expr {2 * ($i > 0) + ($i < $last)}]
- set arrow [lindex {none first last both} $arrow]
- set wid [expr {$wid * $lthickness}]
set x [xc $row $col]
set y [yc $row]
lappend coords $x $y
- set t [$canv create line $coords -width $wid \
+ if {$i == 0} {
+ # draw the link to the first child as part of this line
+ incr row -1
+ set child [lindex $displayorder $row]
+ set ccol [lsearch -exact [lindex $rowidlist $row] $child]
+ if {$ccol >= 0} {
+ set x [xc $row $ccol]
+ set y [yc $row]
+ if {$ccol < $col - 1} {
+ lappend coords [xc $row [expr {$col - 1}]] [yc $row]
+ } elseif {$ccol > $col + 1} {
+ lappend coords [xc $row [expr {$col + 1}]] [yc $row]
+ }
+ lappend coords $x $y
+ }
+ }
+ if {[llength $coords] < 4} return
+ if {$downarrow} {
+ # This line has an arrow at the lower end: check if the arrow is
+ # on a diagonal segment, and if so, work around the Tk 8.4
+ # refusal to draw arrows on diagonal lines.
+ set x0 [lindex $coords 0]
+ set x1 [lindex $coords 2]
+ if {$x0 != $x1} {
+ set y0 [lindex $coords 1]
+ set y1 [lindex $coords 3]
+ if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
+ # we have a nearby vertical segment, just trim off the diag bit
+ set coords [lrange $coords 2 end]
+ } else {
+ set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
+ set xi [expr {$x0 - $slope * $linespc / 2}]
+ set yi [expr {$y0 - $linespc / 2}]
+ set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
+ }
+ }
+ }
+ set arrow [expr {2 * ($i > 0) + $downarrow}]
+ set arrow [lindex {none first last both} $arrow]
+ set t [$canv create line $coords -width [linewidth $id] \
-fill $colormap($id) -tags lines.$id -arrow $arrow]
$canv lower $t
bindline $t $id
}
-proc drawparentlinks {id row col olds wid} {
- global rowoffsets rowidlist canv colormap lthickness
+proc drawparentlinks {id row col olds} {
+ global rowidlist canv colormap
set row2 [expr {$row + 1}]
set x [xc $row $col]
set y [yc $row]
set y2 [yc $row2]
- set ids $rowidlist($row2)
- set offs $rowidlist($row2)
+ set ids [lindex $rowidlist $row2]
# rmx = right-most X coord used
set rmx 0
- set wid [expr {$wid * $lthickness}]
foreach p $olds {
set i [lsearch -exact $ids $p]
if {$i < 0} {
puts "oops, parent $p of $id not in list"
continue
}
+ set x2 [xc $row2 $i]
+ if {$x2 > $rmx} {
+ set rmx $x2
+ }
+ set ranges [rowranges $p]
+ if {$ranges ne {} && $row2 == [lindex $ranges 0]
+ && $row2 < [lindex $ranges 1]} {
+ # drawlineseg will do this one for us
+ continue
+ }
assigncolor $p
# should handle duplicated parents here...
set coords [list $x $y]
} elseif {$i > $col + 1} {
lappend coords [xc $row [expr {$i - 1}]] $y
}
- set x2 [xc $row2 $i]
- if {$x2 > $rmx} {
- set rmx $x2
- }
lappend coords $x2 $y2
- set t [$canv create line $coords -width $wid \
+ set t [$canv create line $coords -width [linewidth $p] \
-fill $colormap($p) -tags lines.$p]
$canv lower $t
bindline $t $p
return $rmx
}
-proc drawlines {id xtra} {
+proc drawlines {id} {
global colormap canv
- global idrowranges idrangedrawn
- global children iddrawn commitrow rowidlist
+ global idrangedrawn
+ global childlist iddrawn commitrow rowidlist
$canv delete lines.$id
- set wid [expr {$xtra + 1}]
- set nr [expr {[llength $idrowranges($id)] / 2}]
+ set nr [expr {[llength [rowranges $id]] / 2}]
for {set i 0} {$i < $nr} {incr i} {
if {[info exists idrangedrawn($id,$i)]} {
- drawlineseg $id $i $wid
+ drawlineseg $id $i
}
}
- if {[info exists children($id)]} {
- foreach child $children($id) {
- if {[info exists iddrawn($child)]} {
- set row $commitrow($child)
- set col [lsearch -exact $rowidlist($row) $child]
- if {$col >= 0} {
- drawparentlinks $child $row $col [list $id] $wid
- }
+ foreach child [lindex $childlist $commitrow($id)] {
+ if {[info exists iddrawn($child)]} {
+ set row $commitrow($child)
+ set col [lsearch -exact [lindex $rowidlist $row] $child]
+ if {$col >= 0} {
+ drawparentlinks $child $row $col [list $id]
}
}
}
global commitlisted commitinfo rowidlist
global rowtextx idpos idtags idheads idotherrefs
global linehtag linentag linedtag
- global mainfont namefont
+ global mainfont namefont canvxmax
- set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}]
+ set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
set x [xc $row $col]
set y [yc $row]
set orad [expr {$linespc / 3}]
-fill $ofill -outline black -width 1]
$canv raise $t
$canv bind $t <1> {selcanvline {} %x %y}
- set xt [xc $row [llength $rowidlist($row)]]
+ set xt [xc $row [llength [lindex $rowidlist $row]]]
if {$xt < $rmx} {
set xt $rmx
}
-text $name -font $namefont]
set linedtag($row) [$canv3 create text 3 $y -anchor w \
-text $date -font $mainfont]
+ set xr [expr {$xt + [font measure $mainfont $headline]}]
+ if {$xr > $canvxmax} {
+ set canvxmax $xr
+ setcanvscroll
+ }
}
proc drawcmitrow {row} {
- global displayorder rowidlist rowoffsets
- global idrowranges idrangedrawn iddrawn
- global commitinfo commitlisted parents numcommits
+ global displayorder rowidlist
+ global idrangedrawn iddrawn
+ global commitinfo commitlisted parentlist numcommits
- if {![info exists rowidlist($row)]} return
- foreach id $rowidlist($row) {
- if {![info exists idrowranges($id)]} continue
+ if {$row >= $numcommits} return
+ foreach id [lindex $rowidlist $row] {
set i -1
- foreach {s e} $idrowranges($id) {
+ foreach {s e} [rowranges $id] {
incr i
if {$row < $s} continue
if {$e eq {}} break
if {$row <= $e} {
if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
- drawlineseg $id $i 1
+ drawlineseg $id $i
set idrangedrawn($id,$i) 1
}
break
set id [lindex $displayorder $row]
if {[info exists iddrawn($id)]} return
- set col [lsearch -exact $rowidlist($row) $id]
+ set col [lsearch -exact [lindex $rowidlist $row] $id]
if {$col < 0} {
puts "oops, row $row id $id not in list"
return
}
if {![info exists commitinfo($id)]} {
- readcommit $id
- if {![info exists commitinfo($id)]} {
- set commitinfo($id) {"No commit information available"}
- set nparents($id) 0
- }
+ getcommit $id
}
assigncolor $id
- if {[info exists commitlisted($id)] && [info exists parents($id)]
- && $parents($id) ne {}} {
- set rmx [drawparentlinks $id $row $col $parents($id) 1]
+ set olds [lindex $parentlist $row]
+ if {$olds ne {}} {
+ set rmx [drawparentlinks $id $row $col $olds]
} else {
set rmx 0
}
catch {unset idrangedrawn}
}
+proc findcrossings {id} {
+ global rowidlist parentlist numcommits rowoffsets displayorder
+
+ set cross {}
+ set ccross {}
+ foreach {s e} [rowranges $id] {
+ if {$e >= $numcommits} {
+ set e [expr {$numcommits - 1}]
+ }
+ if {$e <= $s} continue
+ set x [lsearch -exact [lindex $rowidlist $e] $id]
+ if {$x < 0} {
+ puts "findcrossings: oops, no [shortids $id] in row $e"
+ continue
+ }
+ for {set row $e} {[incr row -1] >= $s} {} {
+ set olds [lindex $parentlist $row]
+ set kid [lindex $displayorder $row]
+ set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
+ if {$kidx < 0} continue
+ set nextrow [lindex $rowidlist [expr {$row + 1}]]
+ foreach p $olds {
+ set px [lsearch -exact $nextrow $p]
+ if {$px < 0} continue
+ if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
+ if {[lsearch -exact $ccross $p] >= 0} continue
+ if {$x == $px + ($kidx < $px? -1: 1)} {
+ lappend ccross $p
+ } elseif {[lsearch -exact $cross $p] < 0} {
+ lappend cross $p
+ }
+ }
+ }
+ set inc [lindex $rowoffsets $row $x]
+ if {$inc eq {}} break
+ incr x $inc
+ }
+ }
+ return [concat $ccross {{}} $cross]
+}
+
proc assigncolor {id} {
global colormap colors nextcolor
- global parents nparents children nchildren
- global cornercrossings crossings
+ global commitrow parentlist children childlist
if {[info exists colormap($id)]} return
set ncolors [llength $colors]
- if {$nchildren($id) == 1} {
- set child [lindex $children($id) 0]
+ if {[info exists commitrow($id)]} {
+ set kids [lindex $childlist $commitrow($id)]
+ } elseif {[info exists children($id)]} {
+ set kids $children($id)
+ } else {
+ set kids {}
+ }
+ if {[llength $kids] == 1} {
+ set child [lindex $kids 0]
if {[info exists colormap($child)]
- && $nparents($child) == 1} {
+ && [llength [lindex $parentlist $commitrow($child)]] == 1} {
set colormap($id) $colormap($child)
return
}
}
set badcolors {}
- if {[info exists cornercrossings($id)]} {
- foreach x $cornercrossings($id) {
- if {[info exists colormap($x)]
- && [lsearch -exact $badcolors $colormap($x)] < 0} {
- lappend badcolors $colormap($x)
- }
+ set origbad {}
+ foreach x [findcrossings $id] {
+ if {$x eq {}} {
+ # delimiter between corner crossings and other crossings
+ if {[llength $badcolors] >= $ncolors - 1} break
+ set origbad $badcolors
}
- if {[llength $badcolors] >= $ncolors} {
- set badcolors {}
+ if {[info exists colormap($x)]
+ && [lsearch -exact $badcolors $colormap($x)] < 0} {
+ lappend badcolors $colormap($x)
}
}
- set origbad $badcolors
- if {[llength $badcolors] < $ncolors - 1} {
- if {[info exists crossings($id)]} {
- foreach x $crossings($id) {
- if {[info exists colormap($x)]
- && [lsearch -exact $badcolors $colormap($x)] < 0} {
- lappend badcolors $colormap($x)
- }
- }
- if {[llength $badcolors] >= $ncolors} {
- set badcolors $origbad
- }
- }
- set origbad $badcolors
+ if {[llength $badcolors] >= $ncolors} {
+ set badcolors $origbad
}
+ set origbad $badcolors
if {[llength $badcolors] < $ncolors - 1} {
- foreach child $children($id) {
+ foreach child $kids {
if {[info exists colormap($child)]
&& [lsearch -exact $badcolors $colormap($child)] < 0} {
lappend badcolors $colormap($child)
}
- if {[info exists parents($child)]} {
- foreach p $parents($child) {
- if {[info exists colormap($p)]
- && [lsearch -exact $badcolors $colormap($p)] < 0} {
- lappend badcolors $colormap($p)
- }
+ foreach p [lindex $parentlist $commitrow($child)] {
+ if {[info exists colormap($p)]
+ && [lsearch -exact $badcolors $colormap($p)] < 0} {
+ lappend badcolors $colormap($p)
}
}
}
set colormap($id) $c
}
-proc initgraph {} {
- global numcommits nextcolor linespc
- global nchildren
-
- allcanvs delete all
- set nextcolor 0
- set numcommits 0
-}
-
proc bindline {t id} {
global canv
return $xt
}
-proc checkcrossings {row endrow} {
- global displayorder parents rowidlist
-
- for {} {$row < $endrow} {incr row} {
- set id [lindex $displayorder $row]
- set i [lsearch -exact $rowidlist($row) $id]
- if {$i < 0} continue
- set idlist $rowidlist([expr {$row+1}])
- foreach p $parents($id) {
- set j [lsearch -exact $idlist $p]
- if {$j > 0} {
- if {$j < $i - 1} {
- notecrossings $row $p $j $i [expr {$j+1}]
- } elseif {$j > $i + 1} {
- notecrossings $row $p $i $j [expr {$j-1}]
- }
- }
- }
- }
-}
-
-proc notecrossings {row id lo hi corner} {
- global rowidlist crossings cornercrossings
-
- for {set i $lo} {[incr i] < $hi} {} {
- set p [lindex $rowidlist($row) $i]
- if {$p == {}} continue
- if {$i == $corner} {
- if {![info exists cornercrossings($id)]
- || [lsearch -exact $cornercrossings($id) $p] < 0} {
- lappend cornercrossings($id) $p
- }
- if {![info exists cornercrossings($p)]
- || [lsearch -exact $cornercrossings($p) $id] < 0} {
- lappend cornercrossings($p) $id
- }
- } else {
- if {![info exists crossings($id)]
- || [lsearch -exact $crossings($id) $p] < 0} {
- lappend crossings($id) $p
- }
- if {![info exists crossings($p)]
- || [lsearch -exact $crossings($p) $id] < 0} {
- lappend crossings($p) $id
- }
- }
- }
-}
-
proc xcoord {i level ln} {
global canvx0 xspc1 xspc2
return $x
}
-proc drawcommit {id reading} {
- global phase todo nchildren nextupdate
- global displayorder parents
- global commitrow commitidx lineid
-
- if {$phase != "incrdraw"} {
- set phase incrdraw
- set displayorder {}
- set todo {}
- set commitidx 0
- initlayout
- initgraph
- }
- set commitrow($id) $commitidx
- set lineid($commitidx) $id
- incr commitidx
- lappend displayorder $id
-}
-
proc finishcommits {} {
- global phase
+ global commitidx phase
global canv mainfont ctext maincursor textcursor
+ global findinprogress
- if {$phase == "incrdraw"} {
+ if {$commitidx > 0} {
drawrest
} else {
$canv delete all
$canv create text 3 3 -anchor nw -text "No commits selected" \
-font $mainfont -tags textitems
- set phase {}
}
- . config -cursor $maincursor
- settextcursor $textcursor
+ if {![info exists findinprogress]} {
+ . config -cursor $maincursor
+ settextcursor $textcursor
+ }
+ set phase {}
}
# Don't change the text pane cursor if it is currently the hand cursor,
}
proc drawrest {} {
- global phase
global numcommits
global startmsecs
global canvy0 numcommits linespc
optimize_rows $row 0 $commitidx
showstuff $commitidx
- set phase {}
set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
#puts "overall $drawmsecs ms for $numcommits commits"
}
proc dofind {} {
global findtype findloc findstring markedmatches commitinfo
- global numcommits lineid linehtag linentag linedtag
+ global numcommits displayorder linehtag linentag linedtag
global mainfont namefont canv canv2 canv3 selectedline
- global matchinglines foundstring foundstrlen
+ global matchinglines foundstring foundstrlen matchstring
+ global commitdata
stopfindproc
unmarkmatches
}
set foundstrlen [string length $findstring]
if {$foundstrlen == 0} return
+ regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
+ set matchstring "*$matchstring*"
if {$findloc == "Files"} {
findfiles
return
}
set didsel 0
set fldtypes {Headline Author Date Committer CDate Comment}
- for {set l 0} {$l < $numcommits} {incr l} {
- set id $lineid($l)
+ set l -1
+ foreach id $displayorder {
+ set d $commitdata($id)
+ incr l
+ if {$findtype == "Regexp"} {
+ set doesmatch [regexp $foundstring $d]
+ } elseif {$findtype == "IgnCase"} {
+ set doesmatch [string match -nocase $matchstring $d]
+ } else {
+ set doesmatch [string match $matchstring $d]
+ }
+ if {!$doesmatch} continue
+ if {![info exists commitinfo($id)]} {
+ getcommit $id
+ }
set info $commitinfo($id)
set doesmatch 0
foreach f $info ty $fldtypes {
proc findpatches {} {
global findstring selectedline numcommits
global findprocpid findprocfile
- global finddidsel ctext lineid findinprogress
+ global finddidsel ctext displayorder findinprogress
global findinsertpos
if {$numcommits == 0} return
if {[incr l] >= $numcommits} {
set l 0
}
- append inputids $lineid($l) "\n"
+ append inputids [lindex $displayorder $l] "\n"
}
if {[catch {
}
proc findfiles {} {
- global selectedline numcommits lineid ctext
- global ffileline finddidsel parents nparents
+ global selectedline numcommits displayorder ctext
+ global ffileline finddidsel parentlist
global findinprogress findstartline findinsertpos
global treediffs fdiffid fdiffsneeded fdiffpos
global findmergefiles
set diffsneeded {}
set fdiffsneeded {}
while 1 {
- set id $lineid($l)
- if {$findmergefiles || $nparents($id) == 1} {
+ set id [lindex $displayorder $l]
+ if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
if {![info exists treediffs($id)]} {
append diffsneeded "$id\n"
lappend fdiffsneeded $id
set finddidsel 0
set findinsertpos end
- set id $lineid($l)
+ set id [lindex $displayorder $l]
. config -cursor watch
settextcursor watch
set findinprogress 1
- findcont $id
+ findcont
update
}
set treediffs($nullid) {}
if {[info exists findid] && $nullid eq $findid} {
unset findid
- findcont $nullid
+ findcont
}
incr fdiffpos
}
}
if {[info exists findid] && $fdiffid eq $findid} {
unset findid
- findcont $fdiffid
+ findcont
}
}
}
-proc findcont {id} {
- global findid treediffs parents nparents
+proc findcont {} {
+ global findid treediffs parentlist
global ffileline findstartline finddidsel
- global lineid numcommits matchinglines findinprogress
+ global displayorder numcommits matchinglines findinprogress
global findmergefiles
set l $ffileline
- while 1 {
- if {$findmergefiles || $nparents($id) == 1} {
+ while {1} {
+ set id [lindex $displayorder $l]
+ if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
if {![info exists treediffs($id)]} {
set findid $id
set ffileline $l
set l 0
}
if {$l == $findstartline} break
- set id $lineid($l)
}
stopfindproc
if {!$finddidsel} {
# mark a commit as matching by putting a yellow background
# behind the headline
proc markheadline {l id} {
- global canv mainfont linehtag commitinfo
+ global canv mainfont linehtag
drawcmitrow $l
set bbox [$canv bbox $linehtag($l)]
$ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
}
+proc viewnextline {dir} {
+ global canv linespc
+
+ $canv delete hover
+ set ymax [lindex [$canv cget -scrollregion] 3]
+ set wnow [$canv yview]
+ set wtop [expr {[lindex $wnow 0] * $ymax}]
+ set newtop [expr {$wtop + $dir * $linespc}]
+ if {$newtop < 0} {
+ set newtop 0
+ } elseif {$newtop > $ymax} {
+ set newtop $ymax
+ }
+ allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
+}
+
proc selectline {l isnew} {
global canv canv2 canv3 ctext commitinfo selectedline
- global lineid linehtag linentag linedtag
- global canvy0 linespc parents nparents children
+ global displayorder linehtag linentag linedtag
+ global canvy0 linespc parentlist childlist
global cflist currentid sha1entry
global commentend idtags linknum
- global mergemax
+ global mergemax numcommits pending_select
+ catch {unset pending_select}
$canv delete hover
normalline
- if {![info exists lineid($l)]} return
+ if {$l < 0 || $l >= $numcommits} return
set y [expr {$canvy0 + $l * $linespc}]
set ymax [lindex [$canv cget -scrollregion] 3]
set ytop [expr {$y - $linespc - 1}]
set selectedline $l
- set id $lineid($l)
+ set id [lindex $displayorder $l]
set currentid $id
$sha1entry delete 0 end
$sha1entry insert 0 $id
}
set comment {}
- if {$nparents($id) > 1} {
+ set olds [lindex $parentlist $l]
+ if {[llength $olds] > 1} {
set np 0
- foreach p $parents($id) {
+ foreach p $olds {
if {$np >= $mergemax} {
set tag mmax
} else {
incr np
}
} else {
- if {[info exists parents($id)]} {
- foreach p $parents($id) {
- append comment "Parent: [commit_descriptor $p]\n"
- }
+ foreach p $olds {
+ append comment "Parent: [commit_descriptor $p]\n"
}
}
- if {[info exists children($id)]} {
- foreach c $children($id) {
- append comment "Child: [commit_descriptor $c]\n"
- }
+ foreach c [lindex $childlist $l] {
+ append comment "Child: [commit_descriptor $c]\n"
}
append comment "\n"
append comment [lindex $info 5]
$cflist delete 0 end
$cflist insert end "Comments"
- if {$nparents($id) == 1} {
+ if {[llength $olds] <= 1} {
startdiff $id
- } elseif {$nparents($id) > 1} {
- mergediff $id
+ } else {
+ mergediff $id $l
}
}
+proc selfirstline {} {
+ unmarkmatches
+ selectline 0 1
+}
+
+proc sellastline {} {
+ global numcommits
+ unmarkmatches
+ set l [expr {$numcommits - 1}]
+ selectline $l 1
+}
+
proc selnextline {dir} {
global selectedline
if {![info exists selectedline]} return
selectline $l 1
}
+proc selnextpage {dir} {
+ global canv linespc selectedline numcommits
+
+ set lpp [expr {([winfo height $canv] - 2) / $linespc}]
+ if {$lpp < 1} {
+ set lpp 1
+ }
+ allcanvs yview scroll [expr {$dir * $lpp}] units
+ if {![info exists selectedline]} return
+ set l [expr {$selectedline + $dir * $lpp}]
+ if {$l < 0} {
+ set l 0
+ } elseif {$l >= $numcommits} {
+ set l [expr $numcommits - 1]
+ }
+ unmarkmatches
+ selectline $l 1
+}
+
proc unselectline {} {
- global selectedline
+ global selectedline currentid
catch {unset selectedline}
+ catch {unset currentid}
allcanvs delete secsel
}
}
}
-proc mergediff {id} {
- global parents diffmergeid diffopts mdifffd
- global difffilestart
+proc mergediff {id l} {
+ global diffmergeid diffopts mdifffd
+ global difffilestart diffids
+ global parentlist
set diffmergeid $id
+ set diffids $id
catch {unset difffilestart}
# this doesn't seem to actually affect anything...
set env(GIT_DIFF_OPTS) $diffopts
}
fconfigure $mdf -blocking 0
set mdifffd($id) $mdf
- fileevent $mdf readable [list getmergediffline $mdf $id]
+ set np [llength [lindex $parentlist $l]]
+ fileevent $mdf readable [list getmergediffline $mdf $id $np]
set nextupdate [expr {[clock clicks -milliseconds] + 100}]
}
-proc getmergediffline {mdf id} {
- global diffmergeid ctext cflist nextupdate nparents mergemax
- global difffilestart
+proc getmergediffline {mdf id np} {
+ global diffmergeid ctext cflist nextupdate mergemax
+ global difffilestart mdifffd
set n [gets $mdf line]
if {$n < 0} {
}
return
}
- if {![info exists diffmergeid] || $id != $diffmergeid} {
+ if {![info exists diffmergeid] || $id != $diffmergeid
+ || $mdf != $mdifffd($id)} {
return
}
$ctext conf -state normal
# do nothing
} else {
# parse the prefix - one ' ', '-' or '+' for each parent
- set np $nparents($id)
set spaces {}
set minuses {}
set pluses {}
incr nextupdate 100
fileevent $mdf readable {}
update
- fileevent $mdf readable [list getmergediffline $mdf $id]
+ fileevent $mdf readable [list getmergediffline $mdf $id $np]
}
}
}
proc gettreediffs {ids} {
- global treediff parents treepending
+ global treediff treepending
set treepending $ids
set treediff {}
if {[catch \
set treediffs($ids) $treediff
unset treepending
if {$ids != $diffids} {
- gettreediffs $diffids
- } else {
- if {[info exists diffmergeid]} {
- contmergediff $ids
- } else {
- addtocflist $ids
+ if {![info exists diffmergeid]} {
+ gettreediffs $diffids
}
+ } else {
+ addtocflist $ids
}
return
}
set pad [string range "----------------------------------------" 1 $l]
$ctext insert end "$pad $header $pad\n" filesep
set diffinhdr 1
- } elseif {[regexp {^(---|\+\+\+)} $line]} {
+ } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
+ # do nothing
+ } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
set diffinhdr 0
} elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
$line match f1l f1c f2l f2c rest]} {
}
proc redisplay {} {
- global canv canvy0 linespc numcommits
+ global canv
global selectedline
set ymax [lindex [$canv cget -scrollregion] 3]
if {$ymax eq {} || $ymax == 0} return
set span [$canv yview]
clear_display
- allcanvs conf -scrollregion \
- [list 0 0 0 [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]]
+ setcanvscroll
allcanvs yview moveto [lindex $span 0]
drawvisible
if {[info exists selectedline]} {
}
proc gotocommit {} {
- global sha1string currentid commitrow tagids
- global lineid numcommits
+ global sha1string currentid commitrow tagids headids
+ global displayorder numcommits
if {$sha1string == {}
|| ([info exists currentid] && $sha1string == $currentid)} return
if {[info exists tagids($sha1string)]} {
set id $tagids($sha1string)
+ } elseif {[info exists headids($sha1string)]} {
+ set id $headids($sha1string)
} else {
set id [string tolower $sha1string]
if {[regexp {^[0-9a-f]{4,39}$} $id]} {
set matches {}
- for {set l 0} {$l < $numcommits} {incr l} {
- if {[string match $id* $lineid($l)]} {
- lappend matches $lineid($l)
+ foreach i $displayorder {
+ if {[string match $id* $i]} {
+ lappend matches $i
}
}
if {$matches ne {}} {
if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
set type "SHA1 id"
} else {
- set type "Tag"
+ set type "Tag/Head"
}
error_popup "$type $sha1string is not known"
}
global hoverx hovery hoverid hovertimer
global commitinfo canv
- if {![info exists commitinfo($id)]} return
+ if {![info exists commitinfo($id)] && ![getcommit $id]} return
set hoverx $x
set hovery $y
set hoverid $id
}
proc clickisonarrow {id y} {
- global lthickness idrowranges
+ global lthickness
+ set ranges [rowranges $id]
set thresh [expr {2 * $lthickness + 6}]
- set n [expr {[llength $idrowranges($id)] - 1}]
+ set n [expr {[llength $ranges] - 1}]
for {set i 1} {$i < $n} {incr i} {
- set row [lindex $idrowranges($id) $i]
+ set row [lindex $ranges $i]
if {abs([yc $row] - $y) < $thresh} {
return $i
}
}
proc arrowjump {id n y} {
- global idrowranges canv
+ global canv
# 1 <-> 2, 3 <-> 4, etc...
set n [expr {(($n - 1) ^ 1) + 1}]
- set row [lindex $idrowranges($id) $n]
+ set row [lindex [rowranges $id] $n]
set yt [yc $row]
set ymax [lindex [$canv cget -scrollregion] 3]
if {$ymax eq {} || $ymax <= 0} return
}
proc lineclick {x y id isnew} {
- global ctext commitinfo children cflist canv thickerline
+ global ctext commitinfo childlist commitrow cflist canv thickerline
+ if {![info exists commitinfo($id)] && ![getcommit $id]} return
unmarkmatches
unselectline
normalline
$canv delete hover
# draw this line thicker than normal
- drawlines $id 1
set thickerline $id
+ drawlines $id
if {$isnew} {
set ymax [lindex [$canv cget -scrollregion] 3]
if {$ymax eq {}} return
$ctext insert end "\tAuthor:\t[lindex $info 1]\n"
set date [formatdate [lindex $info 2]]
$ctext insert end "\tDate:\t$date\n"
- if {[info exists children($id)]} {
+ set kids [lindex $childlist $commitrow($id)]
+ if {$kids ne {}} {
$ctext insert end "\nChildren:"
set i 0
- foreach child $children($id) {
+ foreach child $kids {
incr i
+ if {![info exists commitinfo($child)] && ![getcommit $child]} continue
set info $commitinfo($child)
$ctext insert end "\n\t"
$ctext insert end $child [list link link$i]
proc normalline {} {
global thickerline
if {[info exists thickerline]} {
- drawlines $thickerline 0
+ set id $thickerline
unset thickerline
+ drawlines $id
}
}
}
proc diffvssel {dirn} {
- global rowmenuid selectedline lineid
+ global rowmenuid selectedline displayorder
if {![info exists selectedline]} return
if {$dirn} {
- set oldid $lineid($selectedline)
+ set oldid [lindex $displayorder $selectedline]
set newid $rowmenuid
} else {
set oldid $rowmenuid
- set newid $lineid($selectedline)
+ set newid [lindex $displayorder $selectedline]
}
addtohistory [list doseldiff $oldid $newid]
doseldiff $oldid $newid
proc rereadrefs {} {
global idtags idheads idotherrefs
- global tagids headids otherrefids
set refids [concat [array names idtags] \
[array names idheads] [array names idotherrefs]]
set mainfont {Helvetica 9}
set textfont {Courier 9}
+set uifont {Helvetica 9 bold}
set findmergefiles 0
set maxgraphpct 50
set maxwidth 16
set optim_delay 16
+set nextviewnum 1
+set curview 0
+set viewfiles(0) {}
+
set stopped 0
set stuffsaved 0
set patchnum 0
setcoords
-makewindow $revtreeargs
+makewindow
readrefs
-getcommits $revtreeargs
+parse_args $revtreeargs
+set args $parsed_args
+if {$cmdline_files ne {}} {
+ # create a view for the files/dirs specified on the command line
+ set curview 1
+ set nextviewnum 2
+ set viewname(1) "Command line"
+ set viewfiles(1) $cmdline_files
+ .bar.view add command -label $viewname(1) -command {showview 1}
+ .bar.view entryconf 2 -state normal
+ set args [concat $args "--" $cmdline_files]
+}
+getcommits $args