}
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} {
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
set id [lindex $ids 0]
if {$listed} {
set olds [lrange $ids 1 end]
- if {[llength $olds] > 1} {
- set olds [lsort -unique $olds]
- }
+ set i 0
foreach p $olds {
- lappend children($p) $id
+ if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
+ lappend children($p) $id
+ }
+ incr i
}
} else {
set olds {}
parsecommit $id $contents 0
}
-proc updatecommits {rargs} {
- stopfindproc
- foreach v {colormap selectedline matchinglines treediffs
- mergefilelist currentid rowtextx commitrow
- rowidlist rowoffsets idrowranges idrangedrawn iddrawn
- linesegends crossings cornercrossings} {
- global $v
- catch {unset $v}
- }
- allcanvs delete all
- readrefs
- getcommits $rargs
+proc updatecommits {} {
+ global viewdata curview revtreeargs
+
+ set n $curview
+ set curview -1
+ catch {unset viewdata($n)}
+ parse_args $revtreeargs
+ showview $n
}
proc parsecommit {id contents listed} {
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]} {
tkwait window $w
}
-proc makewindow {rargs} {
+proc makewindow {} {
- global canv canv2 canv3 linespc charspc ctext cflist textfont
+ 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 <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 . <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"
}
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 {
proc initlayout {} {
global rowidlist rowoffsets displayorder commitlisted
global rowlaidout rowoptim
- global idinlist rowchk
+ 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 commitlisted {}
set parentlist {}
set childlist {}
+ set rowrangelist {}
catch {unset children}
set nextcolor 0
set rowidlist {{}}
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 {} {
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 numcommits commitrow pending_select
global linesegends idrowranges idrangedrawn
if {$numcommits == 0} {
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) {
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 childlist parentlist
global idrowranges linesegends
global commitidx
- global idinlist rowchk
+ global idinlist rowchk rowrangelist
set idlist [lindex $rowidlist $row]
set offs [lindex $rowoffsets $row]
} else {
unset idinlist($id)
}
+ set ranges {}
if {[info exists idrowranges($id)]} {
lappend idrowranges($id) $row
+ set ranges $idrowranges($id)
}
+ lappend rowrangelist $ranges
incr row
set offs [ntimes [llength $idlist] 0]
set l [llength $newolds]
proc layouttail {} {
global rowidlist rowoffsets idinlist commitidx
- global idrowranges
+ global idrowranges rowrangelist
set row $commitidx
set idlist [lindex $rowidlist $row]
addextraid $id $row
unset idinlist($id)
lappend idrowranges($id) $row
+ lappend rowrangelist $idrowranges($id)
incr row
set offs [ntimes $col 0]
set idlist [lreplace $idlist $col $col]
lset rowoffsets $row 0
makeuparrow $id 0 $row 0
lappend idrowranges($id) $row
+ lappend rowrangelist $idrowranges($id)
incr row
lappend rowidlist {}
lappend rowoffsets {}
}
proc optimize_rows {row col endrow} {
- global rowidlist rowoffsets idrowranges linesegends displayorder
+ global rowidlist rowoffsets idrowranges displayorder
for {} {$row < $endrow} {incr row} {
set idlist [lindex $rowidlist $row]
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 idrowranges
+ 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 {}
}
}
if {[llength $coords] < 4} return
- set last [expr {[llength $idrowranges($id)] / 2 - 1}]
- if {$i < $last} {
+ 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 arrow [expr {2 * ($i > 0) + ($i < $last)}]
+ 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]
}
proc drawparentlinks {id row col olds} {
- global rowidlist canv colormap idrowranges
+ global rowidlist canv colormap
set row2 [expr {$row + 1}]
set x [xc $row $col]
if {$x2 > $rmx} {
set rmx $x2
}
- if {[info exists idrowranges($p)] &&
- $row2 == [lindex $idrowranges($p) 0] &&
- $row2 < [lindex $idrowranges($p) 1]} {
+ set ranges [rowranges $p]
+ if {$ranges ne {} && $row2 == [lindex $ranges 0]
+ && $row2 < [lindex $ranges 1]} {
# drawlineseg will do this one for us
continue
}
proc drawlines {id} {
global colormap canv
- global idrowranges idrangedrawn
+ global idrangedrawn
global childlist iddrawn commitrow rowidlist
$canv delete lines.$id
- 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
proc drawcmitrow {row} {
global displayorder rowidlist
- global idrowranges idrangedrawn iddrawn
+ global idrangedrawn iddrawn
global commitinfo commitlisted parentlist numcommits
if {$row >= $numcommits} return
foreach id [lindex $rowidlist $row] {
- if {![info exists idrowranges($id)]} continue
set i -1
- foreach {s e} $idrowranges($id) {
+ foreach {s e} [rowranges $id] {
incr i
if {$row < $s} continue
if {$e eq {}} break
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 commitrow parentlist children childlist
- global cornercrossings crossings
if {[info exists colormap($id)]} return
set ncolors [llength $colors]
}
}
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 $kids {
if {[info exists colormap($child)]
return $xt
}
-proc checkcrossings {row endrow} {
- global displayorder parentlist rowidlist
-
- for {} {$row < $endrow} {incr row} {
- set id [lindex $displayorder $row]
- set i [lsearch -exact [lindex $rowidlist $row] $id]
- if {$i < 0} continue
- set idlist [lindex $rowidlist [expr {$row+1}]]
- foreach p [lindex $parentlist $row] {
- 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 [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
$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 displayorder linehtag linentag linedtag
global canvy0 linespc parentlist childlist
global cflist currentid sha1entry
global commentend idtags linknum
- global mergemax numcommits
+ global mergemax numcommits pending_select
+ catch {unset pending_select}
$canv delete hover
normalline
if {$l < 0 || $l >= $numcommits} return
}
}
+ 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 gotocommit {} {
- global sha1string currentid commitrow tagids
+ 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]} {
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"
}
}
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 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
projects / git.git / commitdiff