blob: ba4644f450215682d7465ada26878d626f72fa00 [file] [log] [blame]
#!/bin/sh
# Tcl ignores the next line -*- tcl -*- \
exec wish "$0" -- "$@"
# Copyright (C) 2005 Paul Mackerras. All rights reserved.
# This program is free software; it may be used, copied, modified
# and distributed under the terms of the GNU General Public Licence,
# either version 2, or (at your option) any later version.
proc gitdir {} {
global env
if {[info exists env(GIT_DIR)]} {
return $env(GIT_DIR)
} else {
return ".git"
}
}
proc start_rev_list {view} {
global startmsecs nextupdate ncmupdate
global commfd leftover tclencoding datemode
global viewargs viewfiles commitidx
set startmsecs [clock clicks -milliseconds]
set nextupdate [expr {$startmsecs + 100}]
set ncmupdate 1
set commitidx($view) 0
set args $viewargs($view)
if {$viewfiles($view) ne {}} {
set args [concat $args "--" $viewfiles($view)]
}
set order "--topo-order"
if {$datemode} {
set order "--date-order"
}
if {[catch {
set fd [open [concat | git rev-list --header $order \
--parents --boundary --default HEAD $args] r]
} err]} {
puts stderr "Error executing git rev-list: $err"
exit 1
}
set commfd($view) $fd
set leftover($view) {}
fconfigure $fd -blocking 0 -translation lf
if {$tclencoding != {}} {
fconfigure $fd -encoding $tclencoding
}
fileevent $fd readable [list getcommitlines $fd $view]
nowbusy $view
}
proc stop_rev_list {} {
global commfd curview
if {![info exists commfd($curview)]} return
set fd $commfd($curview)
catch {
set pid [pid $fd]
exec kill $pid
}
catch {close $fd}
unset commfd($curview)
}
proc getcommits {} {
global phase canv mainfont curview
set phase getcommits
initlayout
start_rev_list $curview
show_status "Reading commits..."
}
proc getcommitlines {fd view} {
global commitlisted nextupdate
global leftover commfd
global displayorder commitidx commitrow commitdata
global parentlist childlist children curview hlview
global vparentlist vchildlist vdisporder vcmitlisted
set stuff [read $fd]
if {$stuff == {}} {
if {![eof $fd]} return
global viewname
unset commfd($view)
notbusy $view
# set it blocking so we wait for the process to terminate
fconfigure $fd -blocking 1
if {[catch {close $fd} err]} {
set fv {}
if {$view != $curview} {
set fv " for the \"$viewname($view)\" view"
}
if {[string range $err 0 4] == "usage"} {
set err "Gitk: error reading commits$fv:\
bad arguments to git rev-list."
if {$viewname($view) eq "Command line"} {
append err \
" (Note: arguments to gitk are passed to git rev-list\
to allow selection of commits to be displayed.)"
}
} else {
set err "Error reading commits$fv: $err"
}
error_popup $err
}
if {$view == $curview} {
after idle finishcommits
}
return
}
set start 0
set gotsome 0
while 1 {
set i [string first "\0" $stuff $start]
if {$i < 0} {
append leftover($view) [string range $stuff $start end]
break
}
if {$start == 0} {
set cmit $leftover($view)
append cmit [string range $stuff 0 [expr {$i - 1}]]
set leftover($view) {}
} else {
set cmit [string range $stuff $start [expr {$i - 1}]]
}
set start [expr {$i + 1}]
set j [string first "\n" $cmit]
set ok 0
set listed 1
if {$j >= 0} {
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 {[string length $id] != 40} {
set ok 0
break
}
}
}
if {!$ok} {
set shortcmit $cmit
if {[string length $shortcmit] > 80} {
set shortcmit "[string range $shortcmit 0 80]..."
}
error_popup "Can't parse git rev-list output: {$shortcmit}"
exit 1
}
set id [lindex $ids 0]
if {$listed} {
set olds [lrange $ids 1 end]
set i 0
foreach p $olds {
if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
lappend children($view,$p) $id
}
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 childlist $children($view,$id)
lappend displayorder $id
lappend commitlisted $listed
} else {
lappend vparentlist($view) $olds
lappend vchildlist($view) $children($view,$id)
lappend vdisporder($view) $id
lappend vcmitlisted($view) $listed
}
set gotsome 1
}
if {$gotsome} {
if {$view == $curview} {
layoutmore
} elseif {[info exists hlview] && $view == $hlview} {
vhighlightmore
}
}
if {[clock clicks -milliseconds] >= $nextupdate} {
doupdate
}
}
proc doupdate {} {
global commfd nextupdate numcommits ncmupdate
foreach v [array names commfd] {
fileevent $commfd($v) readable {}
}
update
set nextupdate [expr {[clock clicks -milliseconds] + 100}]
if {$numcommits < 100} {
set ncmupdate [expr {$numcommits + 1}]
} elseif {$numcommits < 10000} {
set ncmupdate [expr {$numcommits + 10}]
} else {
set ncmupdate [expr {$numcommits + 100}]
}
foreach v [array names commfd] {
set fd $commfd($v)
fileevent $fd readable [list getcommitlines $fd $v]
}
}
proc readcommit {id} {
if {[catch {set contents [exec git cat-file commit $id]}]} return
parsecommit $id $contents 0
}
proc updatecommits {} {
global viewdata curview phase displayorder
global children commitrow selectedline thickerline
if {$phase ne {}} {
stop_rev_list
set phase {}
}
set n $curview
foreach id $displayorder {
catch {unset children($n,$id)}
catch {unset commitrow($n,$id)}
}
set curview -1
catch {unset selectedline}
catch {unset thickerline}
catch {unset viewdata($n)}
discardallcommits
readrefs
showview $n
}
proc parsecommit {id contents listed} {
global commitinfo cdate
set inhdr 1
set comment {}
set headline {}
set auname {}
set audate {}
set comname {}
set comdate {}
set hdrend [string first "\n\n" $contents]
if {$hdrend < 0} {
# should never happen...
set hdrend [string length $contents]
}
set header [string range $contents 0 [expr {$hdrend - 1}]]
set comment [string range $contents [expr {$hdrend + 2}] end]
foreach line [split $header "\n"] {
set tag [lindex $line 0]
if {$tag == "author"} {
set audate [lindex $line end-1]
set auname [lrange $line 1 end-2]
} elseif {$tag == "committer"} {
set comdate [lindex $line end-1]
set comname [lrange $line 1 end-2]
}
}
set headline {}
# take the first line of the comment as the headline
set i [string first "\n" $comment]
if {$i >= 0} {
set headline [string trim [string range $comment 0 $i]]
} else {
set headline $comment
}
if {!$listed} {
# git rev-list indents the comment by 4 spaces;
# if we got this via git cat-file, add the indentation
set newcomment {}
foreach line [split $comment "\n"] {
append newcomment " "
append newcomment $line
append newcomment "\n"
}
set comment $newcomment
}
if {$comdate != {}} {
set cdate($id) $comdate
}
set commitinfo($id) [list $headline $auname $audate \
$comname $comdate $comment]
}
proc getcommit {id} {
global commitdata commitinfo
if {[info exists commitdata($id)]} {
parsecommit $id $commitdata($id) 1
} else {
readcommit $id
if {![info exists commitinfo($id)]} {
set commitinfo($id) {"No commit information available"}
}
}
return 1
}
proc readrefs {} {
global tagids idtags headids idheads tagcontents
global otherrefids idotherrefs
foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
catch {unset $v}
}
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]} {
continue
}
if {[regexp {^remotes/.*/HEAD$} $path match]} {
continue
}
if {![regexp {^(tags|heads)/(.*)$} $path match type name]} {
set type others
set name $path
}
if {[regexp {^remotes/} $path match]} {
set type heads
}
if {$type == "tags"} {
set tagids($name) $id
lappend idtags($id) $name
set obj {}
set type {}
set tag {}
catch {
set commit [exec git rev-parse "$id^0"]
if {"$commit" != "$id"} {
set tagids($name) $commit
lappend idtags($commit) $name
}
}
catch {
set tagcontents($name) [exec git cat-file tag "$id"]
}
} elseif { $type == "heads" } {
set headids($name) $id
lappend idheads($id) $name
} else {
set otherrefids($name) $id
lappend idotherrefs($id) $name
}
}
close $refd
}
proc show_error {w top msg} {
message $w.m -text $msg -justify center -aspect 400
pack $w.m -side top -fill x -padx 20 -pady 20
button $w.ok -text OK -command "destroy $top"
pack $w.ok -side bottom -fill x
bind $top <Visibility> "grab $top; focus $top"
bind $top <Key-Return> "destroy $top"
tkwait window $top
}
proc error_popup msg {
set w .error
toplevel $w
wm transient $w .
show_error $w $w $msg
}
proc makewindow {} {
global canv canv2 canv3 linespc charspc ctext cflist
global textfont mainfont uifont
global findtype findtypemenu findloc findstring fstring geometry
global entries sha1entry sha1string sha1but
global maincursor textcursor curtextcursor
global rowctxmenu mergemax wrapcomment
global highlight_files gdttype
global searchstring sstring
menu .bar
.bar add cascade -label "File" -menu .bar.file
.bar configure -font $uifont
menu .bar.file
.bar.file add command -label "Update" -command updatecommits
.bar.file add command -label "Reread references" -command rereadrefs
.bar.file add command -label "Quit" -command doquit
.bar.file configure -font $uifont
menu .bar.edit
.bar add cascade -label "Edit" -menu .bar.edit
.bar.edit add command -label "Preferences" -command doprefs
.bar.edit configure -font $uifont
menu .bar.view -font $uifont
.bar add cascade -label "View" -menu .bar.view
.bar.view add command -label "New view..." -command {newview 0}
.bar.view add command -label "Edit view..." -command editview \
-state disabled
.bar.view add command -label "Delete view" -command delview -state disabled
.bar.view add separator
.bar.view add radiobutton -label "All files" -command {showview 0} \
-variable selectedview -value 0
menu .bar.help
.bar add cascade -label "Help" -menu .bar.help
.bar.help add command -label "About gitk" -command about
.bar.help add command -label "Key bindings" -command keys
.bar.help configure -font $uifont
. configure -menu .bar
if {![info exists geometry(canv1)]} {
set geometry(canv1) [expr {45 * $charspc}]
set geometry(canv2) [expr {30 * $charspc}]
set geometry(canv3) [expr {15 * $charspc}]
set geometry(canvh) [expr {25 * $linespc + 4}]
set geometry(ctextw) 80
set geometry(ctexth) 30
set geometry(cflistw) 30
}
panedwindow .ctop -orient vertical
if {[info exists geometry(width)]} {
.ctop conf -width $geometry(width) -height $geometry(height)
set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
set geometry(ctexth) [expr {($texth - 8) /
[font metrics $textfont -linespace]}]
}
frame .ctop.top
frame .ctop.top.bar
frame .ctop.top.lbar
pack .ctop.top.lbar -side bottom -fill x
pack .ctop.top.bar -side bottom -fill x
set cscroll .ctop.top.csb
scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
pack $cscroll -side right -fill y
panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
pack .ctop.top.clist -side top -fill both -expand 1
.ctop add .ctop.top
set canv .ctop.top.clist.canv
canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
-bg white -bd 0 \
-yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
.ctop.top.clist add $canv
set canv2 .ctop.top.clist.canv2
canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
-bg white -bd 0 -yscrollincr $linespc
.ctop.top.clist add $canv2
set canv3 .ctop.top.clist.canv3
canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
-bg white -bd 0 -yscrollincr $linespc
.ctop.top.clist add $canv3
bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
set sha1entry .ctop.top.bar.sha1
set entries $sha1entry
set sha1but .ctop.top.bar.sha1label
button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
-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
trace add variable sha1string write sha1change
pack $sha1entry -side left -pady 2
image create bitmap bm-left -data {
#define left_width 16
#define left_height 16
static unsigned char left_bits[] = {
0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
}
image create bitmap bm-right -data {
#define right_width 16
#define right_height 16
static unsigned char right_bits[] = {
0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
}
button .ctop.top.bar.leftbut -image bm-left -command goback \
-state disabled -width 26
pack .ctop.top.bar.leftbut -side left -fill y
button .ctop.top.bar.rightbut -image bm-right -command goforw \
-state disabled -width 26
pack .ctop.top.bar.rightbut -side left -fill y
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
trace add variable findstring write find_change
pack $fstring -side left -expand 1 -fill x
set findtype Exact
set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
findtype Exact IgnCase Regexp]
trace add variable findtype write find_change
.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
trace add variable findloc write find_change
.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
label .ctop.top.lbar.flabel -text "Highlight: Commits " \
-font $uifont
pack .ctop.top.lbar.flabel -side left -fill y
set gdttype "touching paths:"
set gm [tk_optionMenu .ctop.top.lbar.gdttype gdttype "touching paths:" \
"adding/removing string:"]
trace add variable gdttype write hfiles_change
$gm conf -font $uifont
.ctop.top.lbar.gdttype conf -font $uifont
pack .ctop.top.lbar.gdttype -side left -fill y
entry .ctop.top.lbar.fent -width 25 -font $textfont \
-textvariable highlight_files
trace add variable highlight_files write hfiles_change
lappend entries .ctop.top.lbar.fent
pack .ctop.top.lbar.fent -side left -fill x -expand 1
label .ctop.top.lbar.vlabel -text " OR in view" -font $uifont
pack .ctop.top.lbar.vlabel -side left -fill y
global viewhlmenu selectedhlview
set viewhlmenu [tk_optionMenu .ctop.top.lbar.vhl selectedhlview None]
$viewhlmenu entryconf 0 -command delvhighlight
$viewhlmenu conf -font $uifont
.ctop.top.lbar.vhl conf -font $uifont
pack .ctop.top.lbar.vhl -side left -fill y
label .ctop.top.lbar.rlabel -text " OR " -font $uifont
pack .ctop.top.lbar.rlabel -side left -fill y
global highlight_related
set m [tk_optionMenu .ctop.top.lbar.relm highlight_related None \
"Descendent" "Not descendent" "Ancestor" "Not ancestor"]
$m conf -font $uifont
.ctop.top.lbar.relm conf -font $uifont
trace add variable highlight_related write vrel_change
pack .ctop.top.lbar.relm -side left -fill y
panedwindow .ctop.cdet -orient horizontal
.ctop add .ctop.cdet
frame .ctop.cdet.left
frame .ctop.cdet.left.bot
pack .ctop.cdet.left.bot -side bottom -fill x
button .ctop.cdet.left.bot.search -text "Search" -command dosearch \
-font $uifont
pack .ctop.cdet.left.bot.search -side left -padx 5
set sstring .ctop.cdet.left.bot.sstring
entry $sstring -width 20 -font $textfont -textvariable searchstring
lappend entries $sstring
trace add variable searchstring write incrsearch
pack $sstring -side left -expand 1 -fill x
set ctext .ctop.cdet.left.ctext
text $ctext -bg white -state disabled -font $textfont \
-width $geometry(ctextw) -height $geometry(ctexth) \
-yscrollcommand scrolltext -wrap none
scrollbar .ctop.cdet.left.sb -command "$ctext yview"
pack .ctop.cdet.left.sb -side right -fill y
pack $ctext -side left -fill both -expand 1
.ctop.cdet add .ctop.cdet.left
$ctext tag conf comment -wrap $wrapcomment
$ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
$ctext tag conf hunksep -fore blue
$ctext tag conf d0 -fore red
$ctext tag conf d1 -fore "#00a000"
$ctext tag conf m0 -fore red
$ctext tag conf m1 -fore blue
$ctext tag conf m2 -fore green
$ctext tag conf m3 -fore purple
$ctext tag conf m4 -fore brown
$ctext tag conf m5 -fore "#009090"
$ctext tag conf m6 -fore magenta
$ctext tag conf m7 -fore "#808000"
$ctext tag conf m8 -fore "#009000"
$ctext tag conf m9 -fore "#ff0080"
$ctext tag conf m10 -fore cyan
$ctext tag conf m11 -fore "#b07070"
$ctext tag conf m12 -fore "#70b0f0"
$ctext tag conf m13 -fore "#70f0b0"
$ctext tag conf m14 -fore "#f0b070"
$ctext tag conf m15 -fore "#ff70b0"
$ctext tag conf mmax -fore darkgrey
set mergemax 16
$ctext tag conf mresult -font [concat $textfont bold]
$ctext tag conf msep -font [concat $textfont bold]
$ctext tag conf found -back yellow
frame .ctop.cdet.right
frame .ctop.cdet.right.mode
radiobutton .ctop.cdet.right.mode.patch -text "Patch" \
-command reselectline -variable cmitmode -value "patch"
radiobutton .ctop.cdet.right.mode.tree -text "Tree" \
-command reselectline -variable cmitmode -value "tree"
grid .ctop.cdet.right.mode.patch .ctop.cdet.right.mode.tree -sticky ew
pack .ctop.cdet.right.mode -side top -fill x
set cflist .ctop.cdet.right.cfiles
set indent [font measure $mainfont "nn"]
text $cflist -width $geometry(cflistw) -background white -font $mainfont \
-tabs [list $indent [expr {2 * $indent}]] \
-yscrollcommand ".ctop.cdet.right.sb set" \
-cursor [. cget -cursor] \
-spacing1 1 -spacing3 1
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
$cflist tag configure highlight \
-background [$cflist cget -selectbackground]
$cflist tag configure bold -font [concat $mainfont bold]
.ctop.cdet add .ctop.cdet.right
bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
pack .ctop -side top -fill both -expand 1
bindall <1> {selcanvline %W %x %y}
#bindall <B1-Motion> {selcanvline %W %x %y}
bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
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 . <Shift-Key-Up> "next_highlight -1"
bind . <Shift-Key-Down> "next_highlight 1"
bindkey <Key-Right> "goforw"
bindkey <Key-Left> "goback"
bind . <Key-Prior> "selnextpage -1"
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"
bindkey p "selnextline -1"
bindkey n "selnextline 1"
bindkey z "goback"
bindkey x "goforw"
bindkey i "selnextline -1"
bindkey k "selnextline 1"
bindkey j "goback"
bindkey l "goforw"
bindkey b "$ctext yview scroll -1 pages"
bindkey d "$ctext yview scroll 18 units"
bindkey u "$ctext yview scroll -18 units"
bindkey / {findnext 1}
bindkey <Key-Return> {findnext 0}
bindkey ? findprev
bindkey f nextfile
bind . <Control-q> doquit
bind . <Control-f> dofind
bind . <Control-g> {findnext 0}
bind . <Control-r> dosearchback
bind . <Control-s> dosearch
bind . <Control-equal> {incrfont 1}
bind . <Control-KP_Add> {incrfont 1}
bind . <Control-minus> {incrfont -1}
bind . <Control-KP_Subtract> {incrfont -1}
bind . <Destroy> {savestuff %W}
bind . <Button-1> "click %W"
bind $fstring <Key-Return> dofind
bind $sha1entry <Key-Return> gotocommit
bind $sha1entry <<PasteSelection>> clearsha1
bind $cflist <1> {sel_flist %W %x %y; break}
bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
set maincursor [. cget -cursor]
set textcursor [$ctext cget -cursor]
set curtextcursor $textcursor
set rowctxmenu .rowctxmenu
menu $rowctxmenu -tearoff 0
$rowctxmenu add command -label "Diff this -> selected" \
-command {diffvssel 0}
$rowctxmenu add command -label "Diff selected -> this" \
-command {diffvssel 1}
$rowctxmenu add command -label "Make patch" -command mkpatch
$rowctxmenu add command -label "Create tag" -command mktag
$rowctxmenu add command -label "Write commit to file" -command writecommit
}
# mouse-2 makes all windows scan vertically, but only the one
# the cursor is in scans horizontally
proc canvscan {op w x y} {
global canv canv2 canv3
foreach c [list $canv $canv2 $canv3] {
if {$c == $w} {
$c scan $op $x $y
} else {
$c scan $op 0 $y
}
}
}
proc scrollcanv {cscroll f0 f1} {
$cscroll set $f0 $f1
drawfrac $f0 $f1
flushhighlights
}
# when we make a key binding for the toplevel, make sure
# it doesn't get triggered when that key is pressed in the
# find string entry widget.
proc bindkey {ev script} {
global entries
bind . $ev $script
set escript [bind Entry $ev]
if {$escript == {}} {
set escript [bind Entry <Key>]
}
foreach e $entries {
bind $e $ev "$escript; break"
}
}
# set the focus back to the toplevel for any click outside
# the entry widgets
proc click {w} {
global entries
foreach e $entries {
if {$w == $e} return
}
focus .
}
proc savestuff {w} {
global canv canv2 canv3 ctext cflist mainfont textfont uifont
global stuffsaved findmergefiles maxgraphpct
global maxwidth showneartags
global viewname viewfiles viewargs viewperm nextviewnum
global cmitmode wrapcomment
if {$stuffsaved} return
if {![winfo viewable .]} return
catch {
set f [open "~/.gitk-new" w]
puts $f [list set mainfont $mainfont]
puts $f [list set textfont $textfont]
puts $f [list set uifont $uifont]
puts $f [list set findmergefiles $findmergefiles]
puts $f [list set maxgraphpct $maxgraphpct]
puts $f [list set maxwidth $maxwidth]
puts $f [list set cmitmode $cmitmode]
puts $f [list set wrapcomment $wrapcomment]
puts $f [list set showneartags $showneartags]
puts $f "set geometry(width) [winfo width .ctop]"
puts $f "set geometry(height) [winfo height .ctop]"
puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
set wid [expr {([winfo width $ctext] - 8) \
/ [font measure $textfont "0"]}]
puts $f "set geometry(ctextw) $wid"
set wid [expr {([winfo width $cflist] - 11) \
/ [font measure [$cflist cget -font] "0"]}]
puts $f "set geometry(cflistw) $wid"
puts -nonewline $f "set permviews {"
for {set v 0} {$v < $nextviewnum} {incr v} {
if {$viewperm($v)} {
puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
}
}
puts $f "}"
close $f
file rename -force "~/.gitk-new" "~/.gitk"
}
set stuffsaved 1
}
proc resizeclistpanes {win w} {
global oldwidth
if {[info exists oldwidth($win)]} {
set s0 [$win sash coord 0]
set s1 [$win sash coord 1]
if {$w < 60} {
set sash0 [expr {int($w/2 - 2)}]
set sash1 [expr {int($w*5/6 - 2)}]
} else {
set factor [expr {1.0 * $w / $oldwidth($win)}]
set sash0 [expr {int($factor * [lindex $s0 0])}]
set sash1 [expr {int($factor * [lindex $s1 0])}]
if {$sash0 < 30} {
set sash0 30
}
if {$sash1 < $sash0 + 20} {
set sash1 [expr {$sash0 + 20}]
}
if {$sash1 > $w - 10} {
set sash1 [expr {$w - 10}]
if {$sash0 > $sash1 - 20} {
set sash0 [expr {$sash1 - 20}]
}
}
}
$win sash place 0 $sash0 [lindex $s0 1]
$win sash place 1 $sash1 [lindex $s1 1]
}
set oldwidth($win) $w
}
proc resizecdetpanes {win w} {
global oldwidth
if {[info exists oldwidth($win)]} {
set s0 [$win sash coord 0]
if {$w < 60} {
set sash0 [expr {int($w*3/4 - 2)}]
} else {
set factor [expr {1.0 * $w / $oldwidth($win)}]
set sash0 [expr {int($factor * [lindex $s0 0])}]
if {$sash0 < 45} {
set sash0 45
}
if {$sash0 > $w - 15} {
set sash0 [expr {$w - 15}]
}
}
$win sash place 0 $sash0 [lindex $s0 1]
}
set oldwidth($win) $w
}
proc allcanvs args {
global canv canv2 canv3
eval $canv $args
eval $canv2 $args
eval $canv3 $args
}
proc bindall {event action} {
global canv canv2 canv3
bind $canv $event $action
bind $canv2 $event $action
bind $canv3 $event $action
}
proc about {} {
set w .about
if {[winfo exists $w]} {
raise $w
return
}
toplevel $w
wm title $w "About gitk"
message $w.m -text {
Gitk - a commit viewer for git
Copyright © 2005-2006 Paul Mackerras
Use and redistribute under the terms of the GNU General Public License} \
-justify center -aspect 400
pack $w.m -side top -fill x -padx 20 -pady 20
button $w.ok -text Close -command "destroy $w"
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
<Shift-Up> Move to previous highlighted line
<Shift-Down> Move to next highlighted line
<Delete>, b Scroll diff view up one page
<Backspace> Scroll diff view up one page
<Space> Scroll diff view down one page
u Scroll diff view up 18 lines
d Scroll diff view down 18 lines
<Ctrl-F> Find
<Ctrl-G> Move to next find hit
<Return> Move to next find hit
/ Move to next find hit, or redo find
? Move to previous find hit
f Scroll diff view to next file
<Ctrl-S> Search for next hit in diff view
<Ctrl-R> Search for previous hit in diff view
<Ctrl-KP+> Increase font size
<Ctrl-plus> Increase font size
<Ctrl-KP-> Decrease font size
<Ctrl-minus> Decrease font size
} \
-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
}
# Procedures for manipulating the file list window at the
# bottom right of the overall window.
proc treeview {w l openlevs} {
global treecontents treediropen treeheight treeparent treeindex
set ix 0
set treeindex() 0
set lev 0
set prefix {}
set prefixend -1
set prefendstack {}
set htstack {}
set ht 0
set treecontents() {}
$w conf -state normal
foreach f $l {
while {[string range $f 0 $prefixend] ne $prefix} {
if {$lev <= $openlevs} {
$w mark set e:$treeindex($prefix) "end -1c"
$w mark gravity e:$treeindex($prefix) left
}
set treeheight($prefix) $ht
incr ht [lindex $htstack end]
set htstack [lreplace $htstack end end]
set prefixend [lindex $prefendstack end]
set prefendstack [lreplace $prefendstack end end]
set prefix [string range $prefix 0 $prefixend]
incr lev -1
}
set tail [string range $f [expr {$prefixend+1}] end]
while {[set slash [string first "/" $tail]] >= 0} {
lappend htstack $ht
set ht 0
lappend prefendstack $prefixend
incr prefixend [expr {$slash + 1}]
set d [string range $tail 0 $slash]
lappend treecontents($prefix) $d
set oldprefix $prefix
append prefix $d
set treecontents($prefix) {}
set treeindex($prefix) [incr ix]
set treeparent($prefix) $oldprefix
set tail [string range $tail [expr {$slash+1}] end]
if {$lev <= $openlevs} {
set ht 1
set treediropen($prefix) [expr {$lev < $openlevs}]
set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
$w mark set d:$ix "end -1c"
$w mark gravity d:$ix left
set str "\n"
for {set i 0} {$i < $lev} {incr i} {append str "\t"}
$w insert end $str
$w image create end -align center -image $bm -padx 1 \
-name a:$ix
$w insert end $d [highlight_tag $prefix]
$w mark set s:$ix "end -1c"
$w mark gravity s:$ix left
}
incr lev
}
if {$tail ne {}} {
if {$lev <= $openlevs} {
incr ht
set str "\n"
for {set i 0} {$i < $lev} {incr i} {append str "\t"}
$w insert end $str
$w insert end $tail [highlight_tag $f]
}
lappend treecontents($prefix) $tail
}
}
while {$htstack ne {}} {
set treeheight($prefix) $ht
incr ht [lindex $htstack end]
set htstack [lreplace $htstack end end]
}
$w conf -state disabled
}
proc linetoelt {l} {
global treeheight treecontents
set y 2
set prefix {}
while {1} {
foreach e $treecontents($prefix) {
if {$y == $l} {
return "$prefix$e"
}
set n 1
if {[string index $e end] eq "/"} {
set n $treeheight($prefix$e)
if {$y + $n > $l} {
append prefix $e
incr y
break
}
}
incr y $n
}
}
}
proc highlight_tree {y prefix} {
global treeheight treecontents cflist
foreach e $treecontents($prefix) {
set path $prefix$e
if {[highlight_tag $path] ne {}} {
$cflist tag add bold $y.0 "$y.0 lineend"
}
incr y
if {[string index $e end] eq "/" && $treeheight($path) > 1} {
set y [highlight_tree $y $path]
}
}
return $y
}
proc treeclosedir {w dir} {
global treediropen treeheight treeparent treeindex
set ix $treeindex($dir)
$w conf -state normal
$w delete s:$ix e:$ix
set treediropen($dir) 0
$w image configure a:$ix -image tri-rt
$w conf -state disabled
set n [expr {1 - $treeheight($dir)}]
while {$dir ne {}} {
incr treeheight($dir) $n
set dir $treeparent($dir)
}
}
proc treeopendir {w dir} {
global treediropen treeheight treeparent treecontents treeindex
set ix $treeindex($dir)
$w conf -state normal
$w image configure a:$ix -image tri-dn
$w mark set e:$ix s:$ix
$w mark gravity e:$ix right
set lev 0
set str "\n"
set n [llength $treecontents($dir)]
for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
incr lev
append str "\t"
incr treeheight($x) $n
}
foreach e $treecontents($dir) {
set de $dir$e
if {[string index $e end] eq "/"} {
set iy $treeindex($de)
$w mark set d:$iy e:$ix
$w mark gravity d:$iy left
$w insert e:$ix $str
set treediropen($de) 0
$w image create e:$ix -align center -image tri-rt -padx 1 \
-name a:$iy
$w insert e:$ix $e [highlight_tag $de]
$w mark set s:$iy e:$ix
$w mark gravity s:$iy left
set treeheight($de) 1
} else {
$w insert e:$ix $str
$w insert e:$ix $e [highlight_tag $de]
}
}
$w mark gravity e:$ix left
$w conf -state disabled
set treediropen($dir) 1
set top [lindex [split [$w index @0,0] .] 0]
set ht [$w cget -height]
set l [lindex [split [$w index s:$ix] .] 0]
if {$l < $top} {
$w yview $l.0
} elseif {$l + $n + 1 > $top + $ht} {
set top [expr {$l + $n + 2 - $ht}]
if {$l < $top} {
set top $l
}
$w yview $top.0
}
}
proc treeclick {w x y} {
global treediropen cmitmode ctext cflist cflist_top
if {$cmitmode ne "tree"} return
if {![info exists cflist_top]} return
set l [lindex [split [$w index "@$x,$y"] "."] 0]
$cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
$cflist tag add highlight $l.0 "$l.0 lineend"
set cflist_top $l
if {$l == 1} {
$ctext yview 1.0
return
}
set e [linetoelt $l]
if {[string index $e end] ne "/"} {
showfile $e
} elseif {$treediropen($e)} {
treeclosedir $w $e
} else {
treeopendir $w $e
}
}
proc setfilelist {id} {
global treefilelist cflist
treeview $cflist $treefilelist($id) 0
}
image create bitmap tri-rt -background black -foreground blue -data {
#define tri-rt_width 13
#define tri-rt_height 13
static unsigned char tri-rt_bits[] = {
0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
0x00, 0x00};
} -maskdata {
#define tri-rt-mask_width 13
#define tri-rt-mask_height 13
static unsigned char tri-rt-mask_bits[] = {
0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
0x08, 0x00};
}
image create bitmap tri-dn -background black -foreground blue -data {
#define tri-dn_width 13
#define tri-dn_height 13
static unsigned char tri-dn_bits[] = {
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00};
} -maskdata {
#define tri-dn-mask_width 13
#define tri-dn-mask_height 13
static unsigned char tri-dn-mask_bits[] = {
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00};
}
proc init_flist {first} {
global cflist cflist_top selectedline difffilestart
$cflist conf -state normal
$cflist delete 0.0 end
if {$first ne {}} {
$cflist insert end $first
set cflist_top 1
$cflist tag add highlight 1.0 "1.0 lineend"
} else {
catch {unset cflist_top}
}
$cflist conf -state disabled
set difffilestart {}
}
proc highlight_tag {f} {
global highlight_paths
foreach p $highlight_paths {
if {[string match $p $f]} {
return "bold"
}
}
return {}
}
proc highlight_filelist {} {
global cmitmode cflist
$cflist conf -state normal
if {$cmitmode ne "tree"} {
set end [lindex [split [$cflist index end] .] 0]
for {set l 2} {$l < $end} {incr l} {
set line [$cflist get $l.0 "$l.0 lineend"]
if {[highlight_tag $line] ne {}} {
$cflist tag add bold $l.0 "$l.0 lineend"
}
}
} else {
highlight_tree 2 {}
}
$cflist conf -state disabled
}
proc unhighlight_filelist {} {
global cflist
$cflist conf -state normal
$cflist tag remove bold 1.0 end
$cflist conf -state disabled
}
proc add_flist {fl} {
global cflist
$cflist conf -state normal
foreach f $fl {
$cflist insert end "\n"
$cflist insert end $f [highlight_tag $f]
}
$cflist conf -state disabled
}
proc sel_flist {w x y} {
global ctext difffilestart cflist cflist_top cmitmode
if {$cmitmode eq "tree"} return
if {![info exists cflist_top]} return
set l [lindex [split [$w index "@$x,$y"] "."] 0]
$cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
$cflist tag add highlight $l.0 "$l.0 lineend"
set cflist_top $l
if {$l == 1} {
$ctext yview 1.0
} else {
catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
}
}
# Functions for adding and removing shell-type quoting
proc shellquote {str} {
if {![string match "*\['\"\\ \t]*" $str]} {
return $str
}
if {![string match "*\['\"\\]*" $str]} {
return "\"$str\""
}
if {![string match "*'*" $str]} {
return "'$str'"
}
return "\"[string map {\" \\\" \\ \\\\} $str]\""
}
proc shellarglist {l} {
set str {}
foreach a $l {
if {$str ne {}} {
append str " "
}
append str [shellquote $a]
}
return $str
}
proc shelldequote {str} {
set ret {}
set used -1
while {1} {
incr used
if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
append ret [string range $str $used end]
set used [string length $str]
break
}
set first [lindex $first 0]
set ch [string index $str $first]
if {$first > $used} {
append ret [string range $str $used [expr {$first - 1}]]
set used $first
}
if {$ch eq " " || $ch eq "\t"} break
incr used
if {$ch eq "'"} {
set first [string first "'" $str $used]
if {$first < 0} {
error "unmatched single-quote"
}
append ret [string range $str $used [expr {$first - 1}]]
set used $first
continue
}
if {$ch eq "\\"} {
if {$used >= [string length $str]} {
error "trailing backslash"
}
append ret [string index $str $used]
continue
}
# here ch == "\""
while {1} {
if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
error "unmatched double-quote"
}
set first [lindex $first 0]
set ch [string index $str $first]
if {$first > $used} {
append ret [string range $str $used [expr {$first - 1}]]
set used $first
}
if {$ch eq "\""} break
incr used
append ret [string index $str $used]
incr used
}
}
return [list $used $ret]
}
proc shellsplit {str} {
set l {}
while {1} {
set str [string trimleft $str]
if {$str eq {}} break
set dq [shelldequote $str]
set n [lindex $dq 0]
set word [lindex $dq 1]
set str [string range $str $n end]
lappend l $word
}
return $l
}
# Code to implement multiple views
proc newview {ishighlight} {
global nextviewnum newviewname newviewperm uifont newishighlight
global newviewargs revtreeargs
set newishighlight $ishighlight
set top .gitkview
if {[winfo exists $top]} {
raise $top
return
}
set newviewname($nextviewnum) "View $nextviewnum"
set newviewperm($nextviewnum) 0
set newviewargs($nextviewnum) [shellarglist $revtreeargs]
vieweditor $top $nextviewnum "Gitk view definition"
}
proc editview {} {
global curview
global viewname viewperm newviewname newviewperm
global viewargs newviewargs
set top .gitkvedit-$curview
if {[winfo exists $top]} {
raise $top
return
}
set newviewname($curview) $viewname($curview)
set newviewperm($curview) $viewperm($curview)
set newviewargs($curview) [shellarglist $viewargs($curview)]
vieweditor $top $curview "Gitk: edit view $viewname($curview)"
}
proc vieweditor {top n title} {
global newviewname newviewperm viewfiles
global uifont
toplevel $top
wm title $top $title
label $top.nl -text "Name" -font $uifont
entry $top.name -width 20 -textvariable newviewname($n)
grid $top.nl $top.name -sticky w -pady 5
checkbutton $top.perm -text "Remember this view" -variable newviewperm($n)
grid $top.perm - -pady 5 -sticky w
message $top.al -aspect 1000 -font $uifont \
-text "Commits to include (arguments to git rev-list):"
grid $top.al - -sticky w -pady 5
entry $top.args -width 50 -textvariable newviewargs($n) \
-background white
grid $top.args - -sticky ew -padx 5
message $top.l -aspect 1000 -font $uifont \
-text "Enter files and directories to include, one per line:"
grid $top.l - -sticky w
text $top.t -width 40 -height 10 -background white
if {[info exists viewfiles($n)]} {
foreach f $viewfiles($n) {
$top.t insert end $f
$top.t insert end "\n"
}
$top.t delete {end - 1c} end
$top.t mark set insert 0.0
}
grid $top.t - -sticky ew -padx 5
frame $top.buts
button $top.buts.ok -text "OK" -command [list newviewok $top $n]
button $top.buts.can -text "Cancel" -command [list destroy $top]
grid $top.buts.ok $top.buts.can
grid columnconfigure $top.buts 0 -weight 1 -uniform a
grid columnconfigure $top.buts 1 -weight 1 -uniform a
grid $top.buts - -pady 10 -sticky ew
focus $top.t
}
proc doviewmenu {m first cmd op argv} {
set nmenu [$m index end]
for {set i $first} {$i <= $nmenu} {incr i} {
if {[$m entrycget $i -command] eq $cmd} {
eval $m $op $i $argv
break
}
}
}
proc allviewmenus {n op args} {
global viewhlmenu
doviewmenu .bar.view 7 [list showview $n] $op $args
doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
}
proc newviewok {top n} {
global nextviewnum newviewperm newviewname newishighlight
global viewname viewfiles viewperm selectedview curview
global viewargs newviewargs viewhlmenu
if {[catch {
set newargs [shellsplit $newviewargs($n)]
} err]} {
error_popup "Error in commit selection arguments: $err"
wm raise $top
focus $top
return
}
set files {}
foreach f [split [$top.t get 0.0 end] "\n"] {
set ft [string trim $f]
if {$ft ne {}} {
lappend files $ft
}
}
if {![info exists viewfiles($n)]} {
# creating a new view
incr nextviewnum
set viewname($n) $newviewname($n)
set viewperm($n) $newviewperm($n)
set viewfiles($n) $files
set viewargs($n) $newargs
addviewmenu $n
if {!$newishighlight} {
after idle showview $n
} else {
after idle addvhighlight $n
}
} else {
# editing an existing view
set viewperm($n) $newviewperm($n)
if {$newviewname($n) ne $viewname($n)} {
set viewname($n) $newviewname($n)
doviewmenu .bar.view 7 [list showview $n] \
entryconf [list -label $viewname($n)]
doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
entryconf [list -label $viewname($n) -value $viewname($n)]
}
if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
set viewfiles($n) $files
set viewargs($n) $newargs
if {$curview == $n} {
after idle updatecommits
}
}
}
catch {destroy $top}
}
proc delview {} {
global curview viewdata viewperm hlview selectedhlview
if {$curview == 0} return
if {[info exists hlview] && $hlview == $curview} {
set selectedhlview None
unset hlview
}
allviewmenus $curview delete
set viewdata($curview) {}
set viewperm($curview) 0
showview 0
}
proc addviewmenu {n} {
global viewname viewhlmenu
.bar.view add radiobutton -label $viewname($n) \
-command [list showview $n] -variable selectedview -value $n
$viewhlmenu add radiobutton -label $viewname($n) \
-command [list addvhighlight $n] -variable selectedhlview
}
proc flatten {var} {
global $var
set ret {}
foreach i [array names $var] {
lappend ret $i [set $var\($i\)]
}
return $ret
}
proc unflatten {var l} {
global $var
catch {unset $var}
foreach {i v} $l {
set $var\($i\) $v
}
}
proc showview {n} {
global curview viewdata viewfiles
global displayorder parentlist childlist rowidlist rowoffsets
global colormap rowtextx commitrow nextcolor canvxmax
global numcommits rowrangelist commitlisted idrowranges
global selectedline currentid canv canvy0
global matchinglines treediffs
global pending_select phase
global commitidx rowlaidout rowoptim linesegends
global commfd nextupdate
global selectedview
global vparentlist vchildlist vdisporder vcmitlisted
global hlview selectedhlview
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
normalline
stopfindproc
if {$curview >= 0} {
set vparentlist($curview) $parentlist
set vchildlist($curview) $childlist
set vdisporder($curview) $displayorder
set vcmitlisted($curview) $commitlisted
if {$phase ne {}} {
set viewdata($curview) \
[list $phase $rowidlist $rowoffsets $rowrangelist \
[flatten idrowranges] [flatten idinlist] \
$rowlaidout $rowoptim $numcommits $linesegends]
} elseif {![info exists viewdata($curview)]
|| [lindex $viewdata($curview) 0] ne {}} {
set viewdata($curview) \
[list {} $rowidlist $rowoffsets $rowrangelist]
}
}
catch {unset matchinglines}
catch {unset treediffs}
clear_display
if {[info exists hlview] && $hlview == $n} {
unset hlview
set selectedhlview None
}
set curview $n
set selectedview $n
.bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
.bar.view entryconf 3 -state [expr {$n == 0? "disabled": "normal"}]
if {![info exists viewdata($n)]} {
set pending_select $selid
getcommits
return
}
set v $viewdata($n)
set phase [lindex $v 0]
set displayorder $vdisporder($n)
set parentlist $vparentlist($n)
set childlist $vchildlist($n)
set commitlisted $vcmitlisted($n)
set rowidlist [lindex $v 1]
set rowoffsets [lindex $v 2]
set rowrangelist [lindex $v 3]
if {$phase eq {}} {
set numcommits [llength $displayorder]
catch {unset idrowranges}
} else {
unflatten idrowranges [lindex $v 4]
unflatten idinlist [lindex $v 5]
set rowlaidout [lindex $v 6]
set rowoptim [lindex $v 7]
set numcommits [lindex $v 8]
set linesegends [lindex $v 9]
}
catch {unset colormap}
catch {unset rowtextx}
set nextcolor 0
set canvxmax [$canv cget -width]
set curview $n
set row 0
setcanvscroll
set yf 0
set row 0
if {$selid ne {} && [info exists commitrow($n,$selid)]} {
set row $commitrow($n,$selid)
# try to get the selected row in the same position on the screen
set ymax [lindex [$canv cget -scrollregion] 3]
set ytop [expr {[yc $row] - $yscreen}]
if {$ytop < 0} {
set ytop 0
}
set yf [expr {$ytop * 1.0 / $ymax}]
}
allcanvs yview moveto $yf
drawvisible
selectline $row 0
if {$phase ne {}} {
if {$phase eq "getcommits"} {
show_status "Reading commits..."
}
if {[info exists commfd($n)]} {
layoutmore
} else {
finishcommits
}
} elseif {$numcommits == 0} {
show_status "No commits selected"
}
}
# Stuff relating to the highlighting facility
proc ishighlighted {row} {
global vhighlights fhighlights nhighlights rhighlights
if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
return $nhighlights($row)
}
if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
return $vhighlights($row)
}
if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
return $fhighlights($row)
}
if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
return $rhighlights($row)
}
return 0
}
proc bolden {row font} {
global canv linehtag selectedline boldrows
lappend boldrows $row
$canv itemconf $linehtag($row) -font $font
if {[info exists selectedline] && $row == $selectedline} {
$canv delete secsel
set t [eval $canv create rect [$canv bbox $linehtag($row)] \
-outline {{}} -tags secsel \
-fill [$canv cget -selectbackground]]
$canv lower $t
}
}
proc bolden_name {row font} {
global canv2 linentag selectedline boldnamerows
lappend boldnamerows $row
$canv2 itemconf $linentag($row) -font $font
if {[info exists selectedline] && $row == $selectedline} {
$canv2 delete secsel
set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
-outline {{}} -tags secsel \
-fill [$canv2 cget -selectbackground]]
$canv2 lower $t
}
}
proc unbolden {} {
global mainfont boldrows
set stillbold {}
foreach row $boldrows {
if {![ishighlighted $row]} {
bolden $row $mainfont
} else {
lappend stillbold $row
}
}
set boldrows $stillbold
}
proc addvhighlight {n} {
global hlview curview viewdata vhl_done vhighlights commitidx
if {[info exists hlview]} {
delvhighlight
}
set hlview $n
if {$n != $curview && ![info exists viewdata($n)]} {
set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
set vparentlist($n) {}
set vchildlist($n) {}
set vdisporder($n) {}
set vcmitlisted($n) {}
start_rev_list $n
}
set vhl_done $commitidx($hlview)
if {$vhl_done > 0} {
drawvisible
}
}
proc delvhighlight {} {
global hlview vhighlights
if {![info exists hlview]} return
unset hlview
catch {unset vhighlights}
unbolden
}
proc vhighlightmore {} {
global hlview vhl_done commitidx vhighlights
global displayorder vdisporder curview mainfont
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)
if {$r0 <= $row && $row <= $r1} {
if {![highlighted $row]} {
bolden $row $font
}
set vhighlights($row) 1
}
}
}
set vhl_done $max
}
proc askvhighlight {row id} {
global hlview vhighlights commitrow iddrawn mainfont
if {[info exists commitrow($hlview,$id)]} {
if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
bolden $row [concat $mainfont bold]
}
set vhighlights($row) 1
} else {
set vhighlights($row) 0
}
}
proc hfiles_change {name ix op} {
global highlight_files filehighlight fhighlights fh_serial
global mainfont highlight_paths
if {[info exists filehighlight]} {
# delete previous highlights
catch {close $filehighlight}
unset filehighlight
catch {unset fhighlights}
unbolden
unhighlight_filelist
}
set highlight_paths {}
after cancel do_file_hl $fh_serial
incr fh_serial
if {$highlight_files ne {}} {
after 300 do_file_hl $fh_serial
}
}
proc makepatterns {l} {
set ret {}
foreach e $l {
set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
if {[string index $ee end] eq "/"} {
lappend ret "$ee*"
} else {
lappend ret $ee
lappend ret "$ee/*"
}
}
return $ret
}
proc do_file_hl {serial} {
global highlight_files filehighlight highlight_paths gdttype fhl_list
if {$gdttype eq "touching paths:"} {
if {[catch {set paths [shellsplit $highlight_files]}]} return
set highlight_paths [makepatterns $paths]
highlight_filelist
set gdtargs [concat -- $paths]
} else {
set gdtargs [list "-S$highlight_files"]
}
set cmd [concat | git-diff-tree -r -s --stdin $gdtargs]
set filehighlight [open $cmd r+]
fconfigure $filehighlight -blocking 0
fileevent $filehighlight readable readfhighlight
set fhl_list {}
drawvisible
flushhighlights
}
proc flushhighlights {} {
global filehighlight fhl_list
if {[info exists filehighlight]} {
lappend fhl_list {}
puts $filehighlight ""
flush $filehighlight
}
}
proc askfilehighlight {row id} {
global filehighlight fhighlights fhl_list
lappend fhl_list $id
set fhighlights($row) -1
puts $filehighlight $id
}
proc readfhighlight {} {
global filehighlight fhighlights commitrow curview mainfont iddrawn
global fhl_list
while {[gets $filehighlight line] >= 0} {
set line [string trim $line]
set i [lsearch -exact $fhl_list $line]
if {$i < 0} continue
for {set j 0} {$j < $i} {incr j} {
set id [lindex $fhl_list $j]
if {[info exists commitrow($curview,$id)]} {
set fhighlights($commitrow($curview,$id)) 0
}
}
set fhl_list [lrange $fhl_list [expr {$i+1}] end]
if {$line eq {}} continue
if {![info exists commitrow($curview,$line)]} continue
set row $commitrow($curview,$line)
if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
bolden $row [concat $mainfont bold]
}
set fhighlights($row) 1
}
if {[eof $filehighlight]} {
# strange...
puts "oops, git-diff-tree died"
catch {close $filehighlight}
unset filehighlight
}
next_hlcont
}
proc find_change {name ix op} {
global nhighlights mainfont boldnamerows
global findstring findpattern findtype
# delete previous highlights, if any
foreach row $boldnamerows {
bolden_name $row $mainfont
}
set boldnamerows {}
catch {unset nhighlights}
unbolden
if {$findtype ne "Regexp"} {
set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
$findstring]
set findpattern "*$e*"
}
drawvisible
}
proc askfindhighlight {row id} {
global nhighlights commitinfo iddrawn mainfont
global findstring findtype findloc findpattern
if {![info exists commitinfo($id)]} {
getcommit $id
}
set info $commitinfo($id)
set isbold 0
set fldtypes {Headline Author Date Committer CDate Comments}
foreach f $info ty $fldtypes {
if {$findloc ne "All fields" && $findloc ne $ty} {
continue
}
if {$findtype eq "Regexp"} {
set doesmatch [regexp $findstring $f]
} elseif {$findtype eq "IgnCase"} {
set doesmatch [string match -nocase $findpattern $f]
} else {
set doesmatch [string match $findpattern $f]
}
if {$doesmatch} {
if {$ty eq "Author"} {
set isbold 2
} else {
set isbold 1
}
}
}
if {[info exists iddrawn($id)]} {
if {$isbold && ![ishighlighted $row]} {
bolden $row [concat $mainfont bold]
}
if {$isbold >= 2} {
bolden_name $row [concat $mainfont bold]
}
}
set nhighlights($row) $isbold
}
proc vrel_change {name ix op} {
global highlight_related
rhighlight_none
if {$highlight_related ne "None"} {
after idle drawvisible
}
}
# prepare for testing whether commits are descendents or ancestors of a
proc rhighlight_sel {a} {
global descendent desc_todo ancestor anc_todo
global highlight_related rhighlights
catch {unset descendent}
set desc_todo [list $a]
catch {unset ancestor}
set anc_todo [list $a]
if {$highlight_related ne "None"} {
rhighlight_none
after idle drawvisible
}
}
proc rhighlight_none {} {
global rhighlights
catch {unset rhighlights}
unbolden
}
proc is_descendent {a} {
global curview children commitrow descendent desc_todo
set v $curview
set la $commitrow($v,$a)
set todo $desc_todo
set leftover {}
set done 0
for {set i 0} {$i < [llength $todo]} {incr i} {
set do [lindex $todo $i]
if {$commitrow($v,$do) < $la} {
lappend leftover $do
continue
}
foreach nk $children($v,$do) {
if {![info exists descendent($nk)]} {
set descendent($nk) 1
lappend todo $nk
if {$nk eq $a} {
set done 1
}
}
}
if {$done} {
set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
return
}
}
set descendent($a) 0
set desc_todo $leftover
}
proc is_ancestor {a} {
global curview parentlist commitrow ancestor anc_todo
set v $curview
set la $commitrow($v,$a)
set todo $anc_todo
set leftover {}
set done 0
for {set i 0} {$i < [llength $todo]} {incr i} {
set do [lindex $todo $i]
if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
lappend leftover $do
continue
}
foreach np [lindex $parentlist $commitrow($v,$do)] {
if {![info exists ancestor($np)]} {
set ancestor($np) 1
lappend todo $np
if {$np eq $a} {
set done 1
}
}
}
if {$done} {
set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
return
}
}
set ancestor($a) 0
set anc_todo $leftover
}
proc askrelhighlight {row id} {
global descendent highlight_related iddrawn mainfont rhighlights
global selectedline ancestor
if {![info exists selectedline]} return
set isbold 0
if {$highlight_related eq "Descendent" ||
$highlight_related eq "Not descendent"} {
if {![info exists descendent($id)]} {
is_descendent $id
}
if {$descendent($id) == ($highlight_related eq "Descendent")} {
set isbold 1
}
} elseif {$highlight_related eq "Ancestor" ||
$highlight_related eq "Not ancestor"} {
if {![info exists ancestor($id)]} {
is_ancestor $id
}
if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
set isbold 1
}
}
if {[info exists iddrawn($id)]} {
if {$isbold && ![ishighlighted $row]} {
bolden $row [concat $mainfont bold]
}
}
set rhighlights($row) $isbold
}
proc next_hlcont {} {
global fhl_row fhl_dirn displayorder numcommits
global vhighlights fhighlights nhighlights rhighlights
global hlview filehighlight findstring highlight_related
if {![info exists fhl_dirn] || $fhl_dirn == 0} return
set row $fhl_row
while {1} {
if {$row < 0 || $row >= $numcommits} {
bell
set fhl_dirn 0
return
}
set id [lindex $displayorder $row]
if {[info exists hlview]} {
if {![info exists vhighlights($row)]} {
askvhighlight $row $id
}
if {$vhighlights($row) > 0} break
}
if {$findstring ne {}} {
if {![info exists nhighlights($row)]} {
askfindhighlight $row $id
}
if {$nhighlights($row) > 0} break
}
if {$highlight_related ne "None"} {
if {![info exists rhighlights($row)]} {
askrelhighlight $row $id
}
if {$rhighlights($row) > 0} break
}
if {[info exists filehighlight]} {
if {![info exists fhighlights($row)]} {
# ask for a few more while we're at it...
set r $row
for {set n 0} {$n < 100} {incr n} {
if {![info exists fhighlights($r)]} {
askfilehighlight $r [lindex $displayorder $r]
}
incr r $fhl_dirn
if {$r < 0 || $r >= $numcommits} break
}
flushhighlights
}
if {$fhighlights($row) < 0} {
set fhl_row $row
return
}
if {$fhighlights($row) > 0} break
}
incr row $fhl_dirn
}
set fhl_dirn 0
selectline $row 1
}
proc next_highlight {dirn} {
global selectedline fhl_row fhl_dirn
global hlview filehighlight findstring highlight_related
if {![info exists selectedline]} return
if {!([info exists hlview] || $findstring ne {} ||
$highlight_related ne "None" || [info exists filehighlight])} return
set fhl_row [expr {$selectedline + $dirn}]
set fhl_dirn $dirn
next_hlcont
}
proc cancel_next_highlight {} {
global fhl_dirn
set fhl_dirn 0
}
# Graph layout functions
proc shortids {ids} {
set res {}
foreach id $ids {
if {[llength $id] > 1} {
lappend res [shortids $id]
} elseif {[regexp {^[0-9a-f]{40}$} $id]} {
lappend res [string range $id 0 7]
} else {
lappend res $id
}
}
return $res
}
proc incrange {l x o} {
set n [llength $l]
while {$x < $n} {
set e [lindex $l $x]
if {$e ne {}} {
lset l $x [expr {$e + $o}]
}
incr x
}
return $l
}
proc ntimes {n o} {
set ret {}
for {} {$n > 0} {incr n -1} {
lappend ret $o
}
return $ret
}
proc usedinrange {id l1 l2} {
global children commitrow childlist curview
if {[info exists commitrow($curview,$id)]} {
set r $commitrow($curview,$id)
if {$l1 <= $r && $r <= $l2} {
return [expr {$r - $l1 + 1}]
}
set kids [lindex $childlist $r]
} else {
set kids $children($curview,$id)
}
foreach c $kids {
set r $commitrow($curview,$c)
if {$l1 <= $r && $r <= $l2} {
return [expr {$r - $l1 + 1}]
}
}
return 0
}
proc sanity {row {full 0}} {
global rowidlist rowoffsets
set col -1
set ids [lindex $rowidlist $row]
foreach id $ids {
incr col
if {$id eq {}} continue
if {$col < [llength $ids] - 1 &&
[lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
}
set o [lindex $rowoffsets $row $col]
set y $row
set x $col
while {$o ne {}} {
incr y -1
incr x $o
if {[lindex $rowidlist $y $x] != $id} {
puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
puts " id=[shortids $id] check started at row $row"
for {set i $row} {$i >= $y} {incr i -1} {
puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
}
break
}
if {!$full} break
set o [lindex $rowoffsets $y $x]
}
}
}
proc makeuparrow {oid x y z} {
global rowidlist rowoffsets uparrowlen idrowranges
for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
incr y -1
incr x $z
set off0 [lindex $rowoffsets $y]
for {set x0 $x} {1} {incr x0} {
if {$x0 >= [llength $off0]} {
set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
break
}
set z [lindex $off0 $x0]
if {$z ne {}} {
incr x0 $z
break
}
}
set z [expr {$x0 - $x}]
lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
}
set 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 commitlisted
global rowlaidout rowoptim
global idinlist rowchk rowrangelist idrowranges
global numcommits canvxmax canv
global nextcolor
global parentlist childlist children
global colormap rowtextx
global linesegends
set numcommits 0
set displayorder {}
set commitlisted {}
set parentlist {}
set childlist {}
set rowrangelist {}
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 idrowranges}
set 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 {} {
global canv numcommits linespc
set ymax [lindex [$canv cget -scrollregion] 3]
if {$ymax eq {} || $ymax == 0} return
set f [$canv yview]
set y0 [expr {int([lindex $f 0] * $ymax)}]
set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
if {$r0 < 0} {
set r0 0
}
set y1 [expr {int([lindex $f 1] * $ymax)}]
set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
if {$r1 >= $numcommits} {
set r1 [expr {$numcommits - 1}]
}
return [list $r0 $r1]
}
proc layoutmore {} {
global rowlaidout rowoptim commitidx numcommits optim_delay
global uparrowlen curview
set row $rowlaidout
set rowlaidout [layoutrows $row $commitidx($curview) 0]
set orow [expr {$rowlaidout - $uparrowlen - 1}]
if {$orow > $rowoptim} {
optimize_rows $rowoptim 0 $orow
set rowoptim $orow
}
set canshow [expr {$rowoptim - $optim_delay}]
if {$canshow > $numcommits} {
showstuff $canshow
}
}
proc showstuff {canshow} {
global numcommits commitrow pending_select selectedline
global linesegends idrowranges idrangedrawn curview
if {$numcommits == 0} {
global phase
set phase "incrdraw"
allcanvs delete all
}
set row $numcommits
set numcommits $canshow
setcanvscroll
set rows [visiblerows]
set r0 [lindex $rows 0]
set r1 [lindex $rows 1]
set selrow -1
for {set r $row} {$r < $canshow} {incr r} {
foreach id [lindex $linesegends [expr {$r+1}]] {
set i -1
foreach {s e} [rowranges $id] {
incr i
if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
&& ![info exists idrangedrawn($id,$i)]} {
drawlineseg $id $i
set idrangedrawn($id,$i) 1
}
}
}
}
if {$canshow > $r1} {
set canshow $r1
}
while {$row < $canshow} {
drawcmitrow $row
incr row
}
if {[info exists pending_select] &&
[info exists commitrow($curview,$pending_select)] &&
$commitrow($curview,$pending_select) < $numcommits} {
selectline $commitrow($curview,$pending_select) 1
}
if {![info exists selectedline] && ![info exists pending_select]} {
selectline 0 1
}
}
proc layoutrows {row endrow last} {
global rowidlist rowoffsets displayorder
global uparrowlen downarrowlen maxwidth mingaplen
global childlist parentlist
global idrowranges linesegends
global commitidx curview
global idinlist rowchk rowrangelist
set idlist [lindex $rowidlist $row]
set offs [lindex $rowoffsets $row]
while {$row < $endrow} {
set id [lindex $displayorder $row]
set oldolds {}
set newolds {}
foreach p [lindex $parentlist $row] {
if {![info exists idinlist($p)]} {
lappend newolds $p
} elseif {!$idinlist($p)} {
lappend oldolds $p
}
}
set lse {}
set nev [expr {[llength $idlist] + [llength $newolds]
+ [llength $oldolds] - $maxwidth + 1}]
if {$nev > 0} {
if {!$last &&
$row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
set i [lindex $idlist $x]
if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
set r [usedinrange $i [expr {$row - $downarrowlen}] \
[expr {$row + $uparrowlen + $mingaplen}]]
if {$r == 0} {
set idlist [lreplace $idlist $x $x]
set offs [lreplace $offs $x $x]
set offs [incrange $offs $x 1]
set idinlist($i) 0
set rm1 [expr {$row - 1}]
lappend lse $i
lappend idrowranges($i) $rm1
if {[incr nev -1] <= 0} break
continue
}
set rowchk($id) [expr {$row + $r}]
}
}
lset rowidlist $row $idlist
lset rowoffsets $row $offs
}
lappend linesegends $lse
set col [lsearch -exact $idlist $id]
if {$col < 0} {
set col [llength $idlist]
lappend idlist $id
lset rowidlist $row $idlist
set z {}
if {[lindex $childlist $row] ne {}} {
set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
unset idinlist($id)
}
lappend offs $z
lset rowoffsets $row $offs
if {$z ne {}} {
makeuparrow $id $col $row $z
}
} else {
unset idinlist($id)
}
set ranges {}
if {[info exists idrowranges($id)]} {
set ranges $idrowranges($id)
lappend ranges $row
unset idrowranges($id)
}
lappend rowrangelist $ranges
incr row
set offs [ntimes [llength $idlist] 0]
set l [llength $newolds]
set idlist [eval lreplace \$idlist $col $col $newolds]
set o 0
if {$l != 1} {
set offs [lrange $offs 0 [expr {$col - 1}]]
foreach x $newolds {
lappend offs {}
incr o -1
}
incr o
set tmp [expr {[llength $idlist] - [llength $offs]}]
if {$tmp > 0} {
set offs [concat $offs [ntimes $tmp $o]]
}
} else {
lset offs $col {}
}
foreach i $newolds {
set idinlist($i) 1
set idrowranges($i) $row
}
incr col $l
foreach oid $oldolds {
set idinlist($oid) 1
set idlist [linsert $idlist $col $oid]
set offs [linsert $offs $col $o]
makeuparrow $oid $col $row $o
incr col
}
lappend rowidlist $idlist
lappend rowoffsets $offs
}
return $row
}
proc addextraid {id row} {
global displayorder commitrow commitinfo
global commitidx commitlisted
global parentlist childlist children curview
incr commitidx($curview)
lappend displayorder $id
lappend commitlisted 0
lappend parentlist {}
set commitrow($curview,$id) $row
readcommit $id
if {![info exists commitinfo($id)]} {
set commitinfo($id) {"No commit information available"}
}
if {![info exists children($curview,$id)]} {
set children($curview,$id) {}
}
lappend childlist $children($curview,$id)
}
proc layouttail {} {
global rowidlist rowoffsets idinlist commitidx curview
global idrowranges rowrangelist
set row $commitidx($curview)
set idlist [lindex $rowidlist $row]
while {$idlist ne {}} {
set col [expr {[llength $idlist] - 1}]
set id [lindex $idlist $col]
addextraid $id $row
unset idinlist($id)
lappend idrowranges($id) $row
lappend rowrangelist $idrowranges($id)
unset idrowranges($id)
incr row
set offs [ntimes $col 0]
set idlist [lreplace $idlist $col $col]
lappend rowidlist $idlist
lappend rowoffsets $offs
}
foreach id [array names idinlist] {
addextraid $id $row
lset rowidlist $row [list $id]
lset rowoffsets $row 0
makeuparrow $id 0 $row 0
lappend idrowranges($id) $row
lappend rowrangelist $idrowranges($id)
unset idrowranges($id)
incr row
lappend rowidlist {}
lappend rowoffsets {}
}
}
proc insert_pad {row col npad} {
global rowidlist rowoffsets
set pad [ntimes $npad {}]
lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
}
proc optimize_rows {row col endrow} {
global rowidlist rowoffsets idrowranges displayorder
for {} {$row < $endrow} {incr 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 haspad 1
continue
}
set z [lindex $offs $col]
if {$z eq {}} continue
set isarrow 0
set x0 [expr {$col + $z}]
set y0 [expr {$row - 1}]
set z0 [lindex $rowoffsets $y0 $x0]
if {$z0 eq {}} {
set id [lindex $idlist $col]
set ranges [rowranges $id]
if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
set isarrow 1
}
}
if {$z < -1 || ($z < 0 && $isarrow)} {
set npad [expr {-1 - $z + $isarrow}]
set offs [incrange $offs $col $npad]
insert_pad $y0 $x0 $npad
if {$y0 > 0} {
optimize_rows $y0 $x0 $row
}
set z [lindex $offs $col]
set x0 [expr {$col + $z}]
set z0 [lindex $rowoffsets $y0 $x0]
} elseif {$z > 1 || ($z > 0 && $isarrow)} {
set npad [expr {$z - 1 + $isarrow}]
set y1 [expr {$row + 1}]
set offs2 [lindex $rowoffsets $y1]
set x1 -1
foreach z $offs2 {
incr x1
if {$z eq {} || $x1 + $z < $col} continue
if {$x1 + $z > $col} {
incr npad
}
lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
break
}
set pad [ntimes $npad {}]
set idlist [eval linsert \$idlist $col $pad]
set tmp [eval linsert \$offs $col $pad]
incr col $npad
set offs [incrange $tmp $col [expr {-$npad}]]
set z [lindex $offs $col]
set 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]
optimize_rows $y0 [expr {$x0 + 1}] $row
}
}
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]
set ranges [rowranges $id]
if {$ranges ne {} && $row == [lindex $ranges 0]} {
# it is, work out offset to child
set y0 [expr {$row - 1}]
set id [lindex $displayorder $y0]
set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
if {$x0 >= 0} {
set o [expr {$x0 - $col}]
}
}
}
if {$o eq {} || $o <= 0} break
}
if {$o ne {} && [incr col] < [llength $idlist]} {
set y1 [expr {$row + 1}]
set offs2 [lindex $rowoffsets $y1]
set x1 -1
foreach z $offs2 {
incr x1
if {$z eq {} || $x1 + $z < $col} continue
lset rowoffsets $y1 [incrange $offs2 $x1 1]
break
}
set idlist [linsert $idlist $col {}]
set tmp [linsert $offs $col {}]
incr col
set offs [incrange $tmp $col -1]
}