@ -75,6 +75,7 @@ proc getcommitlines {commfd} {
global commitlisted nextupdate
global commitlisted nextupdate
global leftover
global leftover
global displayorder commitidx commitrow commitdata
global displayorder commitidx commitrow commitdata
global parentlist childlist children
set stuff [read $commfd]
set stuff [read $commfd]
if {$stuff == {}} {
if {$stuff == {}} {
@ -140,15 +141,26 @@ proc getcommitlines {commfd} {
set id [lindex $ids 0]
set id [lindex $ids 0]
if {$listed} {
if {$listed} {
set olds [lrange $ids 1 end]
set olds [lrange $ids 1 end]
set commitlisted($id) 1
if {[llength $olds] > 1} {
set olds [lsort -unique $olds]
}
foreach p $olds {
lappend children($p) $id
}
} else {
} else {
set olds {}
set olds {}
}
}
updatechildren $id $olds
lappend parentlist $olds
if {[info exists children($id)]} {
lappend childlist $children($id)
} else {
lappend childlist {}
}
set commitdata($id) [string range $cmit [expr {$j + 1}] end]
set commitdata($id) [string range $cmit [expr {$j + 1}] end]
set commitrow($id) $commitidx
set commitrow($id) $commitidx
incr commitidx
incr commitidx
lappend displayorder $id
lappend displayorder $id
lappend commitlisted $listed
set gotsome 1
set gotsome 1
}
}
if {$gotsome} {
if {$gotsome} {
@ -181,14 +193,12 @@ proc doupdate {reading} {
proc readcommit {id} {
proc readcommit {id} {
if {[catch {set contents [exec git-cat-file commit $id]}]} return
if {[catch {set contents [exec git-cat-file commit $id]}]} return
updatechildren $id {}
parsecommit $id $contents 0
parsecommit $id $contents 0
}
}
proc updatecommits {rargs} {
proc updatecommits {rargs} {
stopfindproc
stopfindproc
foreach v {children nchildren parents nparents commitlisted
foreach v {colormap selectedline matchinglines treediffs
colormap selectedline matchinglines treediffs
mergefilelist currentid rowtextx commitrow
mergefilelist currentid rowtextx commitrow
rowidlist rowoffsets idrowranges idrangedrawn iddrawn
rowidlist rowoffsets idrowranges idrangedrawn iddrawn
linesegends crossings cornercrossings} {
linesegends crossings cornercrossings} {
@ -200,26 +210,6 @@ proc updatecommits {rargs} {
getcommits $rargs
getcommits $rargs
}
}
proc updatechildren {id olds} {
global children nchildren parents nparents
if {![info exists nchildren($id)]} {
set children($id) {}
set nchildren($id) 0
}
set parents($id) $olds
set nparents($id) [llength $olds]
foreach p $olds {
if {![info exists nchildren($p)]} {
set children($p) [list $id]
set nchildren($p) 1
} elseif {[lsearch -exact $children($p) $id] < 0} {
lappend children($p) $id
incr nchildren($p)
}
}
}
proc parsecommit {id contents listed} {
proc parsecommit {id contents listed} {
global commitinfo cdate
global commitinfo cdate
@ -274,7 +264,7 @@ proc parsecommit {id contents listed} {
}
}
proc getcommit {id} {
proc getcommit {id} {
global commitdata commitinfo nparents
global commitdata commitinfo
if {[info exists commitdata($id)]} {
if {[info exists commitdata($id)]} {
parsecommit $id $commitdata($id) 1
parsecommit $id $commitdata($id) 1
@ -282,7 +272,6 @@ proc getcommit {id} {
readcommit $id
readcommit $id
if {![info exists commitinfo($id)]} {
if {![info exists commitinfo($id)]} {
set commitinfo($id) {"No commit information available"}
set commitinfo($id) {"No commit information available"}
set nparents($id) 0
}
}
}
}
return 1
return 1
@ -295,7 +284,7 @@ proc readrefs {} {
foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
catch {unset $v}
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]]} {
while {0 <= [set n [gets $refd line]]} {
if {![regexp {^([0-9a-f]{40}) refs/([^^]*)$} $line \
if {![regexp {^([0-9a-f]{40}) refs/([^^]*)$} $line \
match id path]} {
match id path]} {
@ -346,7 +335,7 @@ proc error_popup msg {
}
}
proc makewindow {rargs} {
proc makewindow {rargs} {
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 findtype findtypemenu findloc findstring fstring geometry
global entries sha1entry sha1string sha1but
global entries sha1entry sha1string sha1but
global maincursor textcursor curtextcursor
global maincursor textcursor curtextcursor
@ -354,16 +343,21 @@ proc makewindow {rargs} {
menu .bar
menu .bar
.bar add cascade -label "File" -menu .bar.file
.bar add cascade -label "File" -menu .bar.file
.bar configure -font $uifont
menu .bar.file
menu .bar.file
.bar.file add command -label "Update" -command [list updatecommits $rargs]
.bar.file add command -label "Update" -command [list updatecommits $rargs]
.bar.file add command -label "Reread references" -command rereadrefs
.bar.file add command -label "Reread references" -command rereadrefs
.bar.file add command -label "Quit" -command doquit
.bar.file add command -label "Quit" -command doquit
.bar.file configure -font $uifont
menu .bar.edit
menu .bar.edit
.bar add cascade -label "Edit" -menu .bar.edit
.bar add cascade -label "Edit" -menu .bar.edit
.bar.edit add command -label "Preferences" -command doprefs
.bar.edit add command -label "Preferences" -command doprefs
.bar.edit configure -font $uifont
menu .bar.help
menu .bar.help
.bar add cascade -label "Help" -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 "About gitk" -command about
.bar.help add command -label "Key bindings" -command keys
.bar.help configure -font $uifont
. configure -menu .bar
. configure -menu .bar
if {![info exists geometry(canv1)]} {
if {![info exists geometry(canv1)]} {
@ -410,7 +404,7 @@ proc makewindow {rargs} {
set entries $sha1entry
set entries $sha1entry
set sha1but .ctop.top.bar.sha1label
set sha1but .ctop.top.bar.sha1label
button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
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]
$sha1but conf -disabledforeground [$sha1but cget -foreground]
pack .ctop.top.bar.sha1label -side left
pack .ctop.top.bar.sha1label -side left
entry $sha1entry -width 40 -font $textfont -textvariable sha1string
entry $sha1entry -width 40 -font $textfont -textvariable sha1string
@ -440,19 +434,24 @@ proc makewindow {rargs} {
-state disabled -width 26
-state disabled -width 26
pack .ctop.top.bar.rightbut -side left -fill y
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
pack .ctop.top.bar.findbut -side left
set findstring {}
set findstring {}
set fstring .ctop.top.bar.findstring
set fstring .ctop.top.bar.findstring
lappend entries $fstring
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
pack $fstring -side left -expand 1 -fill x
set findtype Exact
set findtype Exact
set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
findtype Exact IgnCase Regexp]
findtype Exact IgnCase Regexp]
.ctop.top.bar.findtype configure -font $uifont
.ctop.top.bar.findtype.menu configure -font $uifont
set findloc "All fields"
set findloc "All fields"
tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
Comments Author Committer Files Pickaxe
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.findloc -side right
pack .ctop.top.bar.findtype -side right
pack .ctop.top.bar.findtype -side right
# for making sure type==Exact whenever loc==Pickaxe
# for making sure type==Exact whenever loc==Pickaxe
@ -499,7 +498,7 @@ proc makewindow {rargs} {
frame .ctop.cdet.right
frame .ctop.cdet.right
set cflist .ctop.cdet.right.cfiles
set cflist .ctop.cdet.right.cfiles
listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
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"
scrollbar .ctop.cdet.right.sb -command "$cflist yview"
pack .ctop.cdet.right.sb -side right -fill y
pack .ctop.cdet.right.sb -side right -fill y
pack $cflist -side left -fill both -expand 1
pack $cflist -side left -fill both -expand 1
@ -514,12 +513,20 @@ proc makewindow {rargs} {
bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
bindall <2> "canvscan mark %W %x %y"
bindall <2> "canvscan mark %W %x %y"
bindall <B2-Motion> "canvscan dragto %W %x %y"
bindall <B2-Motion> "canvscan dragto %W %x %y"
bindkey <Home> selfirstline
bindkey <End> sellastline
bind . <Key-Up> "selnextline -1"
bind . <Key-Up> "selnextline -1"
bind . <Key-Down> "selnextline 1"
bind . <Key-Down> "selnextline 1"
bind . <Key-Right> "goforw"
bindkey <Key-Right> "goforw"
bind . <Key-Left> "goback"
bindkey <Key-Left> "goback"
bind . <Key-Prior> "allcanvs yview scroll -1 pages"
bind . <Key-Prior> "selnextpage -1"
bind . <Key-Next> "allcanvs yview scroll 1 pages"
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-Delete> "$ctext yview scroll -1 pages"
bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
bindkey <Key-space> "$ctext yview scroll 1 pages"
bindkey <Key-space> "$ctext yview scroll 1 pages"
@ -612,7 +619,7 @@ proc click {w} {
}
}
proc savestuff {w} {
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 stuffsaved findmergefiles maxgraphpct
global maxwidth
global maxwidth
@ -622,6 +629,7 @@ proc savestuff {w} {
set f [open "~/.gitk-new" w]
set f [open "~/.gitk-new" w]
puts $f [list set mainfont $mainfont]
puts $f [list set mainfont $mainfont]
puts $f [list set textfont $textfont]
puts $f [list set textfont $textfont]
puts $f [list set uifont $uifont]
puts $f [list set findmergefiles $findmergefiles]
puts $f [list set findmergefiles $findmergefiles]
puts $f [list set maxgraphpct $maxgraphpct]
puts $f [list set maxgraphpct $maxgraphpct]
puts $f [list set maxwidth $maxwidth]
puts $f [list set maxwidth $maxwidth]
@ -729,6 +737,55 @@ Use and redistribute under the terms of the GNU General Public License} \
pack $w.ok -side bottom
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 shortids {ids} {
proc shortids {ids} {
set res {}
set res {}
foreach id $ids {
foreach id $ids {
@ -843,15 +900,20 @@ proc makeuparrow {oid x y z} {
}
}
proc initlayout {} {
proc initlayout {} {
global rowidlist rowoffsets displayorder
global rowidlist rowoffsets displayorder commitlisted
global rowlaidout rowoptim
global rowlaidout rowoptim
global idinlist rowchk
global idinlist rowchk
global commitidx numcommits canvxmax canv
global commitidx numcommits canvxmax canv
global nextcolor
global nextcolor
global parentlist childlist children
set commitidx 0
set commitidx 0
set numcommits 0
set numcommits 0
set displayorder {}
set displayorder {}
set commitlisted {}
set parentlist {}
set childlist {}
catch {unset children}
set nextcolor 0
set nextcolor 0
set rowidlist {{}}
set rowidlist {{}}
set rowoffsets {{}}
set rowoffsets {{}}
@ -950,7 +1012,7 @@ proc showstuff {canshow} {
proc layoutrows {row endrow last} {
proc layoutrows {row endrow last} {
global rowidlist rowoffsets displayorder
global rowidlist rowoffsets displayorder
global uparrowlen downarrowlen maxwidth mingaplen
global uparrowlen downarrowlen maxwidth mingaplen
global nchildren parents nparents
global childlist parentlist
global idrowranges linesegends
global idrowranges linesegends
global commitidx
global commitidx
global idinlist rowchk
global idinlist rowchk
@ -961,7 +1023,7 @@ proc layoutrows {row endrow last} {
set id [lindex $displayorder $row]
set id [lindex $displayorder $row]
set oldolds {}
set oldolds {}
set newolds {}
set newolds {}
foreach p $parents($id) {
foreach p [lindex $parentlist $row] {
if {![info exists idinlist($p)]} {
if {![info exists idinlist($p)]} {
lappend newolds $p
lappend newolds $p
} elseif {!$idinlist($p)} {
} elseif {!$idinlist($p)} {
@ -1000,7 +1062,7 @@ proc layoutrows {row endrow last} {
lappend idlist $id
lappend idlist $id
lset rowidlist $row $idlist
lset rowidlist $row $idlist
set z {}
set z {}
if {$nchildren($id) > 0} {
if {[lindex $childlist $row] ne {}} {
set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
unset idinlist($id)
unset idinlist($id)
}
}
@ -1053,16 +1115,22 @@ proc layoutrows {row endrow last} {
}
}
proc addextraid {id row} {
proc addextraid {id row} {
global displayorder commitrow commitinfo nparents
global displayorder commitrow commitinfo
global commitidx
global commitidx
global parentlist childlist children
incr commitidx
incr commitidx
lappend displayorder $id
lappend displayorder $id
lappend parentlist {}
set commitrow($id) $row
set commitrow($id) $row
readcommit $id
readcommit $id
if {![info exists commitinfo($id)]} {
if {![info exists commitinfo($id)]} {
set commitinfo($id) {"No commit information available"}
set commitinfo($id) {"No commit information available"}
set nparents($id) 0
}
if {[info exists children($id)]} {
lappend childlist $children($id)
} else {
lappend childlist {}
}
}
}
}
@ -1365,7 +1433,7 @@ proc drawparentlinks {id row col olds} {
proc drawlines {id} {
proc drawlines {id} {
global colormap canv
global colormap canv
global idrowranges idrangedrawn
global idrowranges idrangedrawn
global children iddrawn commitrow rowidlist
global childlist iddrawn commitrow rowidlist
$canv delete lines.$id
$canv delete lines.$id
set nr [expr {[llength $idrowranges($id)] / 2}]
set nr [expr {[llength $idrowranges($id)] / 2}]
@ -1374,14 +1442,12 @@ proc drawlines {id} {
drawlineseg $id $i
drawlineseg $id $i
}
}
}
}
if {[info exists children($id)]} {
foreach child [lindex $childlist $commitrow($id)] {
foreach child $children($id) {
if {[info exists iddrawn($child)]} {
if {[info exists iddrawn($child)]} {
set row $commitrow($child)
set row $commitrow($child)
set col [lsearch -exact [lindex $rowidlist $row] $child]
set col [lsearch -exact [lindex $rowidlist $row] $child]
if {$col >= 0} {
if {$col >= 0} {
drawparentlinks $child $row $col [list $id]
drawparentlinks $child $row $col [list $id]
}
}
}
}
}
}
}
@ -1394,7 +1460,7 @@ proc drawcmittext {id row col rmx} {
global linehtag linentag linedtag
global linehtag linentag linedtag
global mainfont namefont canvxmax
global mainfont namefont canvxmax
set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}]
set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
set x [xc $row $col]
set x [xc $row $col]
set y [yc $row]
set y [yc $row]
set orad [expr {$linespc / 3}]
set orad [expr {$linespc / 3}]
@ -1434,7 +1500,7 @@ proc drawcmittext {id row col rmx} {
proc drawcmitrow {row} {
proc drawcmitrow {row} {
global displayorder rowidlist
global displayorder rowidlist
global idrowranges idrangedrawn iddrawn
global idrowranges idrangedrawn iddrawn
global commitinfo commitlisted parents numcommits
global commitinfo commitlisted parentlist numcommits
if {$row >= $numcommits} return
if {$row >= $numcommits} return
foreach id [lindex $rowidlist $row] {
foreach id [lindex $rowidlist $row] {
@ -1465,9 +1531,9 @@ proc drawcmitrow {row} {
getcommit $id
getcommit $id
}
}
assigncolor $id
assigncolor $id
if {[info exists commitlisted($id)] && [info exists parents($id)]
set olds [lindex $parentlist $row]
&& $parents($id) ne {}} {
if {$olds ne {}} {
set rmx [drawparentlinks $id $row $col $parents($id)]
set rmx [drawparentlinks $id $row $col $olds]
} else {
} else {
set rmx 0
set rmx 0
}
}
@ -1511,15 +1577,22 @@ proc clear_display {} {
proc assigncolor {id} {
proc assigncolor {id} {
global colormap colors nextcolor
global colormap colors nextcolor
global parents nparents children nchildren
global commitrow parentlist children childlist
global cornercrossings crossings
global cornercrossings crossings
if {[info exists colormap($id)]} return
if {[info exists colormap($id)]} return
set ncolors [llength $colors]
set ncolors [llength $colors]
if {$nchildren($id) == 1} {
if {[info exists commitrow($id)]} {
set child [lindex $children($id) 0]
set kids [lindex $childlist $commitrow($id)]
} elseif {[info exists children($id)]} {
set kids $children($id)
} else {
set kids {}
}
if {[llength $kids] == 1} {
set child [lindex $kids 0]
if {[info exists colormap($child)]
if {[info exists colormap($child)]
&& $nparents($child) == 1} {
&& [llength [lindex $parentlist $commitrow($child)]] == 1} {
set colormap($id) $colormap($child)
set colormap($id) $colormap($child)
return
return
}
}
@ -1552,17 +1625,15 @@ proc assigncolor {id} {
set origbad $badcolors
set origbad $badcolors
}
}
if {[llength $badcolors] < $ncolors - 1} {
if {[llength $badcolors] < $ncolors - 1} {
foreach child $children($id) {
foreach child $kids {
if {[info exists colormap($child)]
if {[info exists colormap($child)]
&& [lsearch -exact $badcolors $colormap($child)] < 0} {
&& [lsearch -exact $badcolors $colormap($child)] < 0} {
lappend badcolors $colormap($child)
lappend badcolors $colormap($child)
}
}
if {[info exists parents($child)]} {
foreach p [lindex $parentlist $commitrow($child)] {
foreach p $parents($child) {
if {[info exists colormap($p)]
if {[info exists colormap($p)]
&& [lsearch -exact $badcolors $colormap($p)] < 0} {
&& [lsearch -exact $badcolors $colormap($p)] < 0} {
lappend badcolors $colormap($p)
lappend badcolors $colormap($p)
}
}
}
}
}
}
}
@ -1657,14 +1728,14 @@ proc drawtags {id x xt y1} {
}
}
proc checkcrossings {row endrow} {
proc checkcrossings {row endrow} {
global displayorder parents rowidlist
global displayorder parentlist rowidlist
for {} {$row < $endrow} {incr row} {
for {} {$row < $endrow} {incr row} {
set id [lindex $displayorder $row]
set id [lindex $displayorder $row]
set i [lsearch -exact [lindex $rowidlist $row] $id]
set i [lsearch -exact [lindex $rowidlist $row] $id]
if {$i < 0} continue
if {$i < 0} continue
set idlist [lindex $rowidlist [expr {$row+1}]]
set idlist [lindex $rowidlist [expr {$row+1}]]
foreach p $parents($id) {
foreach p [lindex $parentlist $row] {
set j [lsearch -exact $idlist $p]
set j [lsearch -exact $idlist $p]
if {$j > 0} {
if {$j > 0} {
if {$j < $i - 1} {
if {$j < $i - 1} {
@ -2046,7 +2117,7 @@ proc insertmatch {l id} {
proc findfiles {} {
proc findfiles {} {
global selectedline numcommits displayorder ctext
global selectedline numcommits displayorder ctext
global ffileline finddidsel parents nparents
global ffileline finddidsel parentlist
global findinprogress findstartline findinsertpos
global findinprogress findstartline findinsertpos
global treediffs fdiffid fdiffsneeded fdiffpos
global treediffs fdiffid fdiffsneeded fdiffpos
global findmergefiles
global findmergefiles
@ -2064,7 +2135,7 @@ proc findfiles {} {
set fdiffsneeded {}
set fdiffsneeded {}
while 1 {
while 1 {
set id [lindex $displayorder $l]
set id [lindex $displayorder $l]
if {$findmergefiles || $nparents($id) == 1} {
if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
if {![info exists treediffs($id)]} {
if {![info exists treediffs($id)]} {
append diffsneeded "$id\n"
append diffsneeded "$id\n"
lappend fdiffsneeded $id
lappend fdiffsneeded $id
@ -2096,7 +2167,7 @@ proc findfiles {} {
. config -cursor watch
. config -cursor watch
settextcursor watch
settextcursor watch
set findinprogress 1
set findinprogress 1
findcont $id
findcont
update
update
}
}
@ -2143,7 +2214,7 @@ proc donefilediff {} {
set treediffs($nullid) {}
set treediffs($nullid) {}
if {[info exists findid] && $nullid eq $findid} {
if {[info exists findid] && $nullid eq $findid} {
unset findid
unset findid
findcont $nullid
findcont
}
}
incr fdiffpos
incr fdiffpos
}
}
@ -2154,20 +2225,21 @@ proc donefilediff {} {
}
}
if {[info exists findid] && $fdiffid eq $findid} {
if {[info exists findid] && $fdiffid eq $findid} {
unset findid
unset findid
findcont $fdiffid
findcont
}
}
}
}
}
}
proc findcont {id} {
proc findcont {id} {
global findid treediffs parents nparents
global findid treediffs parentlist
global ffileline findstartline finddidsel
global ffileline findstartline finddidsel
global displayorder numcommits matchinglines findinprogress
global displayorder numcommits matchinglines findinprogress
global findmergefiles
global findmergefiles
set l $ffileline
set l $ffileline
while 1 {
while {1} {
if {$findmergefiles || $nparents($id) == 1} {
set id [lindex $displayorder $l]
if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
if {![info exists treediffs($id)]} {
if {![info exists treediffs($id)]} {
set findid $id
set findid $id
set ffileline $l
set ffileline $l
@ -2189,7 +2261,6 @@ proc findcont {id} {
set l 0
set l 0
}
}
if {$l == $findstartline} break
if {$l == $findstartline} break
set id [lindex $displayorder $l]
}
}
stopfindproc
stopfindproc
if {!$finddidsel} {
if {!$finddidsel} {
@ -2286,10 +2357,26 @@ proc appendwithlinks {text} {
$ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
$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} {
proc selectline {l isnew} {
global canv canv2 canv3 ctext commitinfo selectedline
global canv canv2 canv3 ctext commitinfo selectedline
global displayorder linehtag linentag linedtag
global displayorder linehtag linentag linedtag
global canvy0 linespc parents nparents children
global canvy0 linespc parentlist childlist
global cflist currentid sha1entry
global cflist currentid sha1entry
global commentend idtags linknum
global commentend idtags linknum
global mergemax numcommits
global mergemax numcommits
@ -2379,9 +2466,10 @@ proc selectline {l isnew} {
}
}
set comment {}
set comment {}
if {$nparents($id) > 1} {
set olds [lindex $parentlist $l]
if {[llength $olds] > 1} {
set np 0
set np 0
foreach p $parents($id) {
foreach p $olds {
if {$np >= $mergemax} {
if {$np >= $mergemax} {
set tag mmax
set tag mmax
} else {
} else {
@ -2392,17 +2480,13 @@ proc selectline {l isnew} {
incr np
incr np
}
}
} else {
} else {
if {[info exists parents($id)]} {
foreach p $olds {
foreach p $parents($id) {
append comment "Parent: [commit_descriptor $p]\n"
append comment "Parent: [commit_descriptor $p]\n"
}
}
}
}
}
if {[info exists children($id)]} {
foreach c [lindex $childlist $l] {
foreach c $children($id) {
append comment "Child: [commit_descriptor $c]\n"
append comment "Child: [commit_descriptor $c]\n"
}
}
}
append comment "\n"
append comment "\n"
append comment [lindex $info 5]
append comment [lindex $info 5]
@ -2417,13 +2501,25 @@ proc selectline {l isnew} {
$cflist delete 0 end
$cflist delete 0 end
$cflist insert end "Comments"
$cflist insert end "Comments"
if {$nparents($id) <= 1} {
if {[llength $olds] <= 1} {
startdiff $id
startdiff $id
} else {
} else {
mergediff $id
mergediff $id $l
}
}
}
}
proc selfirstline {} {
unmarkmatches
selectline 0 1
}
proc sellastline {} {
global numcommits
unmarkmatches
set l [expr {$numcommits - 1}]
selectline $l 1
}
proc selnextline {dir} {
proc selnextline {dir} {
global selectedline
global selectedline
if {![info exists selectedline]} return
if {![info exists selectedline]} return
@ -2432,6 +2528,25 @@ proc selnextline {dir} {
selectline $l 1
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 {} {
proc unselectline {} {
global selectedline
global selectedline
@ -2489,9 +2604,10 @@ proc goforw {} {
}
}
}
}
proc mergediff {id} {
proc mergediff {id l} {
global parents diffmergeid diffopts mdifffd
global diffmergeid diffopts mdifffd
global difffilestart diffids
global difffilestart diffids
global parentlist
set diffmergeid $id
set diffmergeid $id
set diffids $id
set diffids $id
@ -2505,12 +2621,13 @@ proc mergediff {id} {
}
}
fconfigure $mdf -blocking 0
fconfigure $mdf -blocking 0
set mdifffd($id) $mdf
set mdifffd($id) $mdf
fileevent $mdf readable [list getmergediffline $mdf $id]
set np [llength [lindex $parentlist $l]]
fileevent $mdf readable [list getmergediffline $mdf $id $np]
set nextupdate [expr {[clock clicks -milliseconds] + 100}]
set nextupdate [expr {[clock clicks -milliseconds] + 100}]
}
}
proc getmergediffline {mdf id} {
proc getmergediffline {mdf id np} {
global diffmergeid ctext cflist nextupdate nparents mergemax
global diffmergeid ctext cflist nextupdate mergemax
global difffilestart mdifffd
global difffilestart mdifffd
set n [gets $mdf line]
set n [gets $mdf line]
@ -2543,7 +2660,6 @@ proc getmergediffline {mdf id} {
# do nothing
# do nothing
} else {
} else {
# parse the prefix - one ' ', '-' or '+' for each parent
# parse the prefix - one ' ', '-' or '+' for each parent
set np $nparents($id)
set spaces {}
set spaces {}
set minuses {}
set minuses {}
set pluses {}
set pluses {}
@ -2611,7 +2727,7 @@ proc addtocflist {ids} {
}
}
proc gettreediffs {ids} {
proc gettreediffs {ids} {
global treediff parents treepending
global treediff treepending
set treepending $ids
set treepending $ids
set treediff {}
set treediff {}
if {[catch \
if {[catch \
@ -2846,13 +2962,15 @@ proc sha1change {n1 n2 op} {
}
}
proc gotocommit {} {
proc gotocommit {} {
global sha1string currentid commitrow tagids
global sha1string currentid commitrow tagids headids
global displayorder numcommits
global displayorder numcommits
if {$sha1string == {}
if {$sha1string == {}
|| ([info exists currentid] && $sha1string == $currentid)} return
|| ([info exists currentid] && $sha1string == $currentid)} return
if {[info exists tagids($sha1string)]} {
if {[info exists tagids($sha1string)]} {
set id $tagids($sha1string)
set id $tagids($sha1string)
} elseif {[info exists headids($sha1string)]} {
set id $headids($sha1string)
} else {
} else {
set id [string tolower $sha1string]
set id [string tolower $sha1string]
if {[regexp {^[0-9a-f]{4,39}$} $id]} {
if {[regexp {^[0-9a-f]{4,39}$} $id]} {
@ -2878,7 +2996,7 @@ proc gotocommit {} {
if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
set type "SHA1 id"
set type "SHA1 id"
} else {
} else {
set type "Tag"
set type "Tag/Head"
}
}
error_popup "$type $sha1string is not known"
error_popup "$type $sha1string is not known"
}
}
@ -2979,7 +3097,7 @@ proc arrowjump {id n y} {
}
}
proc lineclick {x y id isnew} {
proc lineclick {x y id isnew} {
global ctext commitinfo children cflist canv thickerline
global ctext commitinfo childlist commitrow cflist canv thickerline
if {![info exists commitinfo($id)] && ![getcommit $id]} return
if {![info exists commitinfo($id)] && ![getcommit $id]} return
unmarkmatches
unmarkmatches
@ -3018,10 +3136,11 @@ proc lineclick {x y id isnew} {
$ctext insert end "\tAuthor:\t[lindex $info 1]\n"
$ctext insert end "\tAuthor:\t[lindex $info 1]\n"
set date [formatdate [lindex $info 2]]
set date [formatdate [lindex $info 2]]
$ctext insert end "\tDate:\t$date\n"
$ctext insert end "\tDate:\t$date\n"
if {[info exists children($id)]} {
set kids [lindex $childlist $commitrow($id)]
if {$kids ne {}} {
$ctext insert end "\nChildren:"
$ctext insert end "\nChildren:"
set i 0
set i 0
foreach child $children($id) {
foreach child $kids {
incr i
incr i
if {![info exists commitinfo($child)] && ![getcommit $child]} continue
if {![info exists commitinfo($child)] && ![getcommit $child]} continue
set info $commitinfo($child)
set info $commitinfo($child)
@ -3368,7 +3487,6 @@ proc listrefs {id} {
proc rereadrefs {} {
proc rereadrefs {} {
global idtags idheads idotherrefs
global idtags idheads idotherrefs
global tagids headids otherrefids
set refids [concat [array names idtags] \
set refids [concat [array names idtags] \
[array names idheads] [array names idotherrefs]]
[array names idheads] [array names idotherrefs]]
@ -3777,6 +3895,7 @@ if {$tclencoding == {}} {
set mainfont {Helvetica 9}
set mainfont {Helvetica 9}
set textfont {Courier 9}
set textfont {Courier 9}
set uifont {Helvetica 9 bold}
set findmergefiles 0
set findmergefiles 0
set maxgraphpct 50
set maxgraphpct 50
set maxwidth 16
set maxwidth 16