Browse Source

Merge git://git.kernel.org/pub/scm/gitk/gitk

* git://git.kernel.org/pub/scm/gitk/gitk:
  [PATCH] Provide configurable UI font for gitk
  [PATCH] gitk: Use git wrapper to run git-ls-remote.
  [PATCH] gitk: add key bindings for selecting first and last commit
  gitk: Add a help menu item to display key bindings
  [PATCH] gitk: allow goto heads
  gitk: replace parent and children arrays with lists
maint
Junio C Hamano 19 years ago
parent
commit
521a3f6767
  1. 331
      gitk

331
gitk

@ -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

Loading…
Cancel
Save