X-Git-Url: https://git.octo.it/?a=blobdiff_plain;f=gitk;h=87e71629afd4b2eca8d1c768bea0a20815405b2b;hb=refs%2Fheads%2Fmaint;hp=a847ef69c7ae87c9035aff23af359e1832abceea;hpb=9cac9d368934f68e75810df95211a6522d4d139e;p=git.git diff --git a/gitk b/gitk index a847ef69..87e71629 100755 --- a/gitk +++ b/gitk @@ -16,52 +16,66 @@ proc gitdir {} { } } -proc getcommits {rargs} { - global commits commfd phase canv mainfont env - global startmsecs nextupdate ncmupdate - global ctext maincursor textcursor leftover gitencoding +proc parse_args {rargs} { + global parsed_args - # check that we can find a .git directory somewhere... - set gitdir [gitdir] - if {![file isdirectory $gitdir]} { - error_popup "Cannot find the git directory \"$gitdir\"." - exit 1 - } - set commits {} - set phase getcommits - set startmsecs [clock clicks -milliseconds] - set nextupdate [expr {$startmsecs + 100}] - set ncmupdate 1 - if [catch { + if {[catch { set parse_args [concat --default HEAD $rargs] set parsed_args [split [eval exec git-rev-parse $parse_args] "\n"] - }] { + }]} { # if git-rev-parse failed for some reason... if {$rargs == {}} { set rargs HEAD } set parsed_args $rargs } - if [catch { - set commfd [open "|git-rev-list --header --topo-order --parents $parsed_args" r] - } err] { + return $parsed_args +} + +proc start_rev_list {rlargs} { + global startmsecs nextupdate ncmupdate + global commfd leftover tclencoding datemode + + set startmsecs [clock clicks -milliseconds] + set nextupdate [expr {$startmsecs + 100}] + set ncmupdate 1 + initlayout + set order "--topo-order" + if {$datemode} { + set order "--date-order" + } + if {[catch { + set commfd [open [concat | git-rev-list --header $order \ + --parents --boundary $rlargs] r] + } err]} { puts stderr "Error executing git-rev-list: $err" exit 1 } set leftover {} - fconfigure $commfd -blocking 0 -translation lf -encoding $gitencoding + fconfigure $commfd -blocking 0 -translation lf + if {$tclencoding != {}} { + fconfigure $commfd -encoding $tclencoding + } fileevent $commfd readable [list getcommitlines $commfd] + . config -cursor watch + settextcursor watch +} + +proc getcommits {rargs} { + global phase canv mainfont + + set phase getcommits + start_rev_list [parse_args $rargs] $canv delete all $canv create text 3 3 -anchor nw -text "Reading commits..." \ -font $mainfont -tags textitems - . config -cursor watch - settextcursor watch } proc getcommitlines {commfd} { - global commits parents cdate children - global commitlisted phase nextupdate - global stopped redisplaying leftover + global commitlisted nextupdate + global leftover + global displayorder commitidx commitrow commitdata + global parentlist childlist children set stuff [read $commfd] if {$stuff == {}} { @@ -84,25 +98,33 @@ proc getcommitlines {commfd} { exit 1 } set start 0 + set gotsome 0 while 1 { set i [string first "\0" $stuff $start] if {$i < 0} { append leftover [string range $stuff $start end] - return + break } - set cmit [string range $stuff $start [expr {$i - 1}]] if {$start == 0} { - set cmit "$leftover$cmit" + set cmit $leftover + append cmit [string range $stuff 0 [expr {$i - 1}]] set leftover {} + } else { + set cmit [string range $stuff $start [expr {$i - 1}]] } set start [expr {$i + 1}] set j [string first "\n" $cmit] set ok 0 + set listed 1 if {$j >= 0} { set ids [string range $cmit 0 [expr {$j - 1}]] + if {[string range $ids 0 0] == "-"} { + set listed 0 + set ids [string range $ids 1 end] + } set ok 1 foreach id $ids { - if {![regexp {^[0-9a-f]{40}$} $id]} { + if {[string length $id] != 40} { set ok 0 break } @@ -117,29 +139,35 @@ proc getcommitlines {commfd} { exit 1 } set id [lindex $ids 0] - set olds [lrange $ids 1 end] - set cmit [string range $cmit [expr {$j + 1}] end] - lappend commits $id - set commitlisted($id) 1 - parsecommit $id $cmit 1 [lrange $ids 1 end] - drawcommit $id - if {[clock clicks -milliseconds] >= $nextupdate} { - doupdate 1 - } - while {$redisplaying} { - set redisplaying 0 - if {$stopped == 1} { - set stopped 0 - set phase "getcommits" - foreach id $commits { - drawcommit $id - if {$stopped} break - if {[clock clicks -milliseconds] >= $nextupdate} { - doupdate 1 - } - } + if {$listed} { + set olds [lrange $ids 1 end] + if {[llength $olds] > 1} { + set olds [lsort -unique $olds] } + foreach p $olds { + lappend children($p) $id + } + } else { + set olds {} + } + lappend parentlist $olds + if {[info exists children($id)]} { + lappend childlist $children($id) + } else { + lappend childlist {} } + set commitdata($id) [string range $cmit [expr {$j + 1}] end] + set commitrow($id) $commitidx + incr commitidx + lappend displayorder $id + lappend commitlisted $listed + set gotsome 1 + } + if {$gotsome} { + layoutmore + } + if {[clock clicks -milliseconds] >= $nextupdate} { + doupdate 1 } } @@ -164,12 +192,26 @@ proc doupdate {reading} { } proc readcommit {id} { - if [catch {set contents [exec git-cat-file commit $id]}] return - parsecommit $id $contents 0 {} + if {[catch {set contents [exec git-cat-file commit $id]}]} return + parsecommit $id $contents 0 } -proc parsecommit {id contents listed olds} { - global commitinfo children nchildren parents nparents cdate ncleft +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 parsecommit {id contents listed} { + global commitinfo cdate set inhdr 1 set comment {} @@ -178,24 +220,6 @@ proc parsecommit {id contents listed olds} { set audate {} set comname {} set comdate {} - if {![info exists nchildren($id)]} { - set children($id) {} - set nchildren($id) 0 - set ncleft($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 - set ncleft($p) 1 - } elseif {[lsearch -exact $children($p) $id] < 0} { - lappend children($p) $id - incr nchildren($p) - incr ncleft($p) - } - } set hdrend [string first "\n\n" $contents] if {$hdrend < 0} { # should never happen... @@ -239,11 +263,28 @@ proc parsecommit {id contents listed olds} { $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 - set refd [open [list | git-ls-remote [gitdir]] r] + 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]} { @@ -289,11 +330,12 @@ proc error_popup msg { button $w.ok -text OK -command "destroy $w" pack $w.ok -side bottom -fill x bind $w "grab $w; focus $w" + bind $w "destroy $w" tkwait window $w } -proc makewindow {} { - global canv canv2 canv3 linespc charspc ctext cflist textfont +proc makewindow {rargs} { + 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 @@ -301,15 +343,21 @@ proc makewindow {} { 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 "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.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)]} { @@ -340,7 +388,7 @@ proc makewindow {} { set canv .ctop.top.clist.canv canvas $canv -height $geometry(canvh) -width $geometry(canv1) \ -bg white -bd 0 \ - -yscrollincr $linespc -yscrollcommand "$cscroll set" + -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll" .ctop.top.clist add $canv set canv2 .ctop.top.clist.canv2 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \ @@ -356,7 +404,7 @@ proc makewindow {} { 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 @@ -386,19 +434,24 @@ proc makewindow {} { -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 @@ -425,8 +478,19 @@ proc makewindow {} { $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 5 + 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 @@ -434,7 +498,7 @@ proc makewindow {} { 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 @@ -447,14 +511,22 @@ proc makewindow {} { #bindall {selcanvline %W %x %y} bindall "allcanvs yview scroll -5 units" bindall "allcanvs yview scroll 5 units" - bindall <2> "allcanvs scan mark 0 %y" - bindall "allcanvs scan dragto 0 %y" + bindall <2> "canvscan mark %W %x %y" + bindall "canvscan dragto %W %x %y" + bindkey selfirstline + bindkey sellastline bind . "selnextline -1" bind . "selnextline 1" - bind . "goforw" - bind . "goback" - bind . "allcanvs yview scroll -1 pages" - bind . "allcanvs yview scroll 1 pages" + bindkey "goforw" + bindkey "goback" + bind . "selnextpage -1" + bind . "selnextpage 1" + bind . "allcanvs yview moveto 0.0" + bind . "allcanvs yview moveto 1.0" + bind . "allcanvs yview scroll -1 units" + bind . "allcanvs yview scroll 1 units" + bind . "allcanvs yview scroll -1 pages" + bind . "allcanvs yview scroll 1 pages" bindkey "$ctext yview scroll -1 pages" bindkey "$ctext yview scroll -1 pages" bindkey "$ctext yview scroll 1 pages" @@ -503,6 +575,24 @@ proc makewindow {} { $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 +} + # 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. @@ -529,7 +619,7 @@ proc click {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 maxwidth @@ -539,6 +629,7 @@ proc savestuff {w} { 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] @@ -562,7 +653,7 @@ proc savestuff {w} { proc resizeclistpanes {win w} { global oldwidth - if [info exists oldwidth($win)] { + if {[info exists oldwidth($win)]} { set s0 [$win sash coord 0] set s1 [$win sash coord 1] if {$w < 60} { @@ -593,7 +684,7 @@ proc resizeclistpanes {win w} { proc resizecdetpanes {win w} { global oldwidth - if [info exists oldwidth($win)] { + if {[info exists oldwidth($win)]} { set s0 [$win sash coord 0] if {$w < 60} { set sash0 [expr {int($w*3/4 - 2)}] @@ -635,9 +726,9 @@ proc about {} { toplevel $w wm title $w "About gitk" message $w.m -text { -Gitk version 1.2 +Gitk - a commit viewer for git -Copyright © 2005 Paul Mackerras +Copyright © 2005-2006 Paul Mackerras Use and redistribute under the terms of the GNU General Public License} \ -justify center -aspect 400 @@ -646,17 +737,863 @@ Use and redistribute under the terms of the GNU General Public License} \ 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: + + Quit + Move to first commit + Move to last commit +, p, i Move up one commit +, n, k Move down one commit +, z, j Go back in history list +, x, l Go forward in history list + Move up one page in commit list + Move down one page in commit list + Scroll to top of commit list + Scroll to bottom of commit list + Scroll commit list up one line + Scroll commit list down one line + Scroll commit list up one page + Scroll commit list down one page +, b Scroll diff view up one page + Scroll diff view up one page + Scroll diff view down one page +u Scroll diff view up 18 lines +d Scroll diff view down 18 lines + Find + Move to next find hit + Move to previous find hit + 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 + Increase font size + Increase font size + Decrease font size + 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} { + 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 + + if {[info exists commitrow($id)]} { + set r $commitrow($id) + if {$l1 <= $r && $r <= $l2} { + return [expr {$r - $l1 + 1}] + } + } + foreach c $children($id) { + if {[info exists commitrow($c)]} { + set r $commitrow($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 + global commitidx numcommits canvxmax canv + global nextcolor + global parentlist childlist children + + set commitidx 0 + set numcommits 0 + set displayorder {} + set commitlisted {} + set parentlist {} + set childlist {} + catch {unset children} + set nextcolor 0 + set rowidlist {{}} + set rowoffsets {{}} + catch {unset idinlist} + catch {unset rowchk} + set rowlaidout 0 + set rowoptim 0 + set canvxmax [$canv cget -width] +} + +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 + + set row $rowlaidout + 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 + } + set canshow [expr {$rowoptim - $optim_delay}] + if {$canshow > $numcommits} { + showstuff $canshow + } +} + +proc showstuff {canshow} { + global numcommits + global linesegends idrowranges idrangedrawn + + 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] + for {set r $row} {$r < $canshow} {incr r} { + if {[info exists linesegends($r)]} { + foreach id $linesegends($r) { + set i -1 + foreach {s e} $idrowranges($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 + } +} + +proc layoutrows {row endrow last} { + global rowidlist rowoffsets displayorder + global uparrowlen downarrowlen maxwidth mingaplen + global childlist parentlist + global idrowranges linesegends + global commitidx + global idinlist rowchk + + 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 nev [expr {[llength $idlist] + [llength $newolds] + + [llength $oldolds] - $maxwidth + 1}] + if {$nev > 0} { + if {!$last && $row + $uparrowlen + $mingaplen >= $commitidx} 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 linesegends($rm1) $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 + } + 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) + } + if {[info exists idrowranges($id)]} { + lappend idrowranges($id) $row + } + 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 + + incr commitidx + lappend displayorder $id + lappend commitlisted 0 + lappend parentlist {} + set commitrow($id) $row + readcommit $id + if {![info exists commitinfo($id)]} { + set commitinfo($id) {"No commit information available"} + } + if {[info exists children($id)]} { + lappend childlist $children($id) + } else { + lappend childlist {} + } +} + +proc layouttail {} { + global rowidlist rowoffsets idinlist commitidx + global idrowranges + + set row $commitidx + 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 + 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 + 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 linesegends 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] + if {[info exists idrowranges($id)] && + $y0 > [lindex $idrowranges($id) 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] + if {[info exists idrowranges($id)] && + $row == [lindex $idrowranges($id) 0]} { + # it is, work out offset to child + set y0 [expr {$row - 1}] + set id [lindex $displayorder $y0] + set x0 [lsearch -exact [lindex $rowidlist $y0] $id] + if {$x0 >= 0} { + set o [expr {$x0 - $col}] + } + } + } + if {$o eq {} || $o <= 0} break + } + if {$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] + } + } + lset rowidlist $row $idlist + lset rowoffsets $row $offs + set col 0 + } +} + +proc xc {row col} { + global canvx0 linespc + return [expr {$canvx0 + $col * $linespc}] +} + +proc yc {row} { + global canvy0 linespc + return [expr {$canvy0 + $row * $linespc}] +} + +proc linewidth {id} { + global thickerline lthickness + + set wid $lthickness + if {[info exists thickerline] && $id eq $thickerline} { + set wid [expr {2 * $lthickness}] + } + return $wid +} + +proc drawlineseg {id i} { + global rowoffsets rowidlist idrowranges + global displayorder + global canv colormap linespc + + set startrow [lindex $idrowranges($id) [expr {2 * $i}]] + set row [lindex $idrowranges($id) [expr {2 * $i + 1}]] + if {$startrow == $row} return + assigncolor $id + set coords {} + set col [lsearch -exact [lindex $rowidlist $row] $id] + if {$col < 0} { + puts "oops: drawline: id $id not on row $row" + return + } + set lasto {} + set ns 0 + while {1} { + set o [lindex $rowoffsets $row $col] + if {$o eq {}} break + if {$o ne $lasto} { + # changing direction + set x [xc $row $col] + set y [yc $row] + lappend coords $x $y + set lasto $o + } + incr col $o + incr row -1 + } + set x [xc $row $col] + set y [yc $row] + lappend coords $x $y + if {$i == 0} { + # draw the link to the first child as part of this line + incr row -1 + set child [lindex $displayorder $row] + set ccol [lsearch -exact [lindex $rowidlist $row] $child] + if {$ccol >= 0} { + set x [xc $row $ccol] + set y [yc $row] + if {$ccol < $col - 1} { + lappend coords [xc $row [expr {$col - 1}]] [yc $row] + } elseif {$ccol > $col + 1} { + lappend coords [xc $row [expr {$col + 1}]] [yc $row] + } + lappend coords $x $y + } + } + if {[llength $coords] < 4} return + set last [expr {[llength $idrowranges($id)] / 2 - 1}] + if {$i < $last} { + # This line has an arrow at the lower end: check if the arrow is + # on a diagonal segment, and if so, work around the Tk 8.4 + # refusal to draw arrows on diagonal lines. + set x0 [lindex $coords 0] + set x1 [lindex $coords 2] + if {$x0 != $x1} { + set y0 [lindex $coords 1] + set y1 [lindex $coords 3] + if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} { + # we have a nearby vertical segment, just trim off the diag bit + set coords [lrange $coords 2 end] + } else { + set slope [expr {($x0 - $x1) / ($y0 - $y1)}] + set xi [expr {$x0 - $slope * $linespc / 2}] + set yi [expr {$y0 - $linespc / 2}] + set coords [lreplace $coords 0 1 $xi $y0 $xi $yi] + } + } + } + set arrow [expr {2 * ($i > 0) + ($i < $last)}] + set arrow [lindex {none first last both} $arrow] + set t [$canv create line $coords -width [linewidth $id] \ + -fill $colormap($id) -tags lines.$id -arrow $arrow] + $canv lower $t + bindline $t $id +} + +proc drawparentlinks {id row col olds} { + global rowidlist canv colormap idrowranges + + set row2 [expr {$row + 1}] + set x [xc $row $col] + set y [yc $row] + set y2 [yc $row2] + set ids [lindex $rowidlist $row2] + # rmx = right-most X coord used + set rmx 0 + foreach p $olds { + set i [lsearch -exact $ids $p] + if {$i < 0} { + puts "oops, parent $p of $id not in list" + continue + } + set x2 [xc $row2 $i] + if {$x2 > $rmx} { + set rmx $x2 + } + if {[info exists idrowranges($p)] && + $row2 == [lindex $idrowranges($p) 0] && + $row2 < [lindex $idrowranges($p) 1]} { + # drawlineseg will do this one for us + continue + } + assigncolor $p + # should handle duplicated parents here... + set coords [list $x $y] + if {$i < $col - 1} { + lappend coords [xc $row [expr {$i + 1}]] $y + } elseif {$i > $col + 1} { + lappend coords [xc $row [expr {$i - 1}]] $y + } + lappend coords $x2 $y2 + set t [$canv create line $coords -width [linewidth $p] \ + -fill $colormap($p) -tags lines.$p] + $canv lower $t + bindline $t $p + } + return $rmx +} + +proc drawlines {id} { + global colormap canv + global idrowranges idrangedrawn + global childlist iddrawn commitrow rowidlist + + $canv delete lines.$id + set nr [expr {[llength $idrowranges($id)] / 2}] + for {set i 0} {$i < $nr} {incr i} { + if {[info exists idrangedrawn($id,$i)]} { + drawlineseg $id $i + } + } + foreach child [lindex $childlist $commitrow($id)] { + if {[info exists iddrawn($child)]} { + set row $commitrow($child) + set col [lsearch -exact [lindex $rowidlist $row] $child] + if {$col >= 0} { + drawparentlinks $child $row $col [list $id] + } + } + } +} + +proc drawcmittext {id row col rmx} { + global linespc canv canv2 canv3 canvy0 + global commitlisted commitinfo rowidlist + global rowtextx idpos idtags idheads idotherrefs + global linehtag linentag linedtag + global mainfont namefont canvxmax + + set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}] + set x [xc $row $col] + set y [yc $row] + set orad [expr {$linespc / 3}] + set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \ + [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \ + -fill $ofill -outline black -width 1] + $canv raise $t + $canv bind $t <1> {selcanvline {} %x %y} + set xt [xc $row [llength [lindex $rowidlist $row]]] + if {$xt < $rmx} { + set xt $rmx + } + set rowtextx($row) $xt + set idpos($id) [list $x $xt $y] + if {[info exists idtags($id)] || [info exists idheads($id)] + || [info exists idotherrefs($id)]} { + set xt [drawtags $id $x $xt $y] + } + set headline [lindex $commitinfo($id) 0] + set name [lindex $commitinfo($id) 1] + set date [lindex $commitinfo($id) 2] + set date [formatdate $date] + set linehtag($row) [$canv create text $xt $y -anchor w \ + -text $headline -font $mainfont ] + $canv bind $linehtag($row) "rowmenu %X %Y $id" + set linentag($row) [$canv2 create text 3 $y -anchor w \ + -text $name -font $namefont] + set linedtag($row) [$canv3 create text 3 $y -anchor w \ + -text $date -font $mainfont] + set xr [expr {$xt + [font measure $mainfont $headline]}] + if {$xr > $canvxmax} { + set canvxmax $xr + setcanvscroll + } +} + +proc drawcmitrow {row} { + global displayorder rowidlist + global idrowranges idrangedrawn iddrawn + global commitinfo 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) { + incr i + if {$row < $s} continue + if {$e eq {}} break + if {$row <= $e} { + if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} { + drawlineseg $id $i + set idrangedrawn($id,$i) 1 + } + break + } + } + } + + set id [lindex $displayorder $row] + if {[info exists iddrawn($id)]} return + set col [lsearch -exact [lindex $rowidlist $row] $id] + if {$col < 0} { + puts "oops, row $row id $id not in list" + return + } + if {![info exists commitinfo($id)]} { + getcommit $id + } + assigncolor $id + set olds [lindex $parentlist $row] + if {$olds ne {}} { + set rmx [drawparentlinks $id $row $col $olds] + } else { + set rmx 0 + } + drawcmittext $id $row $col $rmx + set iddrawn($id) 1 +} + +proc drawfrac {f0 f1} { + global numcommits canv + global linespc + + set ymax [lindex [$canv cget -scrollregion] 3] + if {$ymax eq {} || $ymax == 0} return + set y0 [expr {int($f0 * $ymax)}] + set row [expr {int(($y0 - 3) / $linespc) - 1}] + if {$row < 0} { + set row 0 + } + set y1 [expr {int($f1 * $ymax)}] + set endrow [expr {int(($y1 - 3) / $linespc) + 1}] + if {$endrow >= $numcommits} { + set endrow [expr {$numcommits - 1}] + } + for {} {$row <= $endrow} {incr row} { + drawcmitrow $row + } +} + +proc drawvisible {} { + global canv + eval drawfrac [$canv yview] +} + +proc clear_display {} { + global iddrawn idrangedrawn + + allcanvs delete all + catch {unset iddrawn} + catch {unset idrangedrawn} +} + proc assigncolor {id} { - global colormap commcolors colors nextcolor - global parents nparents children nchildren + global colormap colors nextcolor + global commitrow parentlist children childlist global cornercrossings crossings - if [info exists colormap($id)] return + if {[info exists colormap($id)]} return set ncolors [llength $colors] - if {$nparents($id) <= 1 && $nchildren($id) == 1} { - set child [lindex $children($id) 0] + if {[info exists commitrow($id)]} { + set kids [lindex $childlist $commitrow($id)] + } elseif {[info exists children($id)]} { + set kids $children($id) + } else { + set kids {} + } + if {[llength $kids] == 1} { + set child [lindex $kids 0] if {[info exists colormap($child)] - && $nparents($child) == 1} { + && [llength [lindex $parentlist $commitrow($child)]] == 1} { set colormap($id) $colormap($child) return } @@ -689,17 +1626,15 @@ proc assigncolor {id} { set origbad $badcolors } if {[llength $badcolors] < $ncolors - 1} { - foreach child $children($id) { + foreach child $kids { if {[info exists colormap($child)] && [lsearch -exact $badcolors $colormap($child)] < 0} { lappend badcolors $colormap($child) } - if {[info exists parents($child)]} { - foreach p $parents($child) { - if {[info exists colormap($p)] - && [lsearch -exact $badcolors $colormap($p)] < 0} { - lappend badcolors $colormap($p) - } + foreach p [lindex $parentlist $commitrow($child)] { + if {[info exists colormap($p)] + && [lsearch -exact $badcolors $colormap($p)] < 0} { + lappend badcolors $colormap($p) } } } @@ -717,27 +1652,6 @@ proc assigncolor {id} { set colormap($id) $c } -proc initgraph {} { - global canvy canvy0 lineno numcommits nextcolor linespc - global mainline mainlinearrow sidelines - global nchildren ncleft - global displist nhyperspace - - allcanvs delete all - set nextcolor 0 - set canvy $canvy0 - set lineno -1 - set numcommits 0 - catch {unset mainline} - catch {unset mainlinearrow} - catch {unset sidelines} - foreach id [array names nchildren] { - set ncleft($id) $nchildren($id) - } - set displist {} - set nhyperspace 0 -} - proc bindline {t id} { global canv @@ -747,121 +1661,10 @@ proc bindline {t id} { $canv bind $t "lineclick %x %y $id 1" } -proc drawlines {id xtra delold} { - global mainline mainlinearrow sidelines lthickness colormap canv - - if {$delold} { - $canv delete lines.$id - } - if {[info exists mainline($id)]} { - set t [$canv create line $mainline($id) \ - -width [expr {($xtra + 1) * $lthickness}] \ - -fill $colormap($id) -tags lines.$id \ - -arrow $mainlinearrow($id)] - $canv lower $t - bindline $t $id - } - if {[info exists sidelines($id)]} { - foreach ls $sidelines($id) { - set coords [lindex $ls 0] - set thick [lindex $ls 1] - set arrow [lindex $ls 2] - set t [$canv create line $coords -fill $colormap($id) \ - -width [expr {($thick + $xtra) * $lthickness}] \ - -arrow $arrow -tags lines.$id] - $canv lower $t - bindline $t $id - } - } -} - -# level here is an index in displist -proc drawcommitline {level} { - global parents children nparents displist - global canv canv2 canv3 mainfont namefont canvy linespc - global lineid linehtag linentag linedtag commitinfo - global colormap numcommits currentparents dupparents - global idtags idline idheads idotherrefs - global lineno lthickness mainline mainlinearrow sidelines - global commitlisted rowtextx idpos lastuse displist - global oldnlines olddlevel olddisplist - - incr numcommits - incr lineno - set id [lindex $displist $level] - set lastuse($id) $lineno - set lineid($lineno) $id - set idline($id) $lineno - set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}] - if {![info exists commitinfo($id)]} { - readcommit $id - if {![info exists commitinfo($id)]} { - set commitinfo($id) {"No commit information available"} - set nparents($id) 0 - } - } - assigncolor $id - set currentparents {} - set dupparents {} - if {[info exists commitlisted($id)] && [info exists parents($id)]} { - foreach p $parents($id) { - if {[lsearch -exact $currentparents $p] < 0} { - lappend currentparents $p - } else { - # remember that this parent was listed twice - lappend dupparents $p - } - } - } - set x [xcoord $level $level $lineno] - set y1 $canvy - set canvy [expr {$canvy + $linespc}] - allcanvs conf -scrollregion \ - [list 0 0 0 [expr {$y1 + 0.5 * $linespc + 2}]] - if {[info exists mainline($id)]} { - lappend mainline($id) $x $y1 - if {$mainlinearrow($id) ne "none"} { - set mainline($id) [trimdiagstart $mainline($id)] - } - } - drawlines $id 0 0 - set orad [expr {$linespc / 3}] - set t [$canv create oval [expr {$x - $orad}] [expr {$y1 - $orad}] \ - [expr {$x + $orad - 1}] [expr {$y1 + $orad - 1}] \ - -fill $ofill -outline black -width 1] - $canv raise $t - $canv bind $t <1> {selcanvline {} %x %y} - set xt [xcoord [llength $displist] $level $lineno] - if {[llength $currentparents] > 2} { - set xt [expr {$xt + ([llength $currentparents] - 2) * $linespc}] - } - set rowtextx($lineno) $xt - set idpos($id) [list $x $xt $y1] - if {[info exists idtags($id)] || [info exists idheads($id)] - || [info exists idotherrefs($id)]} { - set xt [drawtags $id $x $xt $y1] - } - set headline [lindex $commitinfo($id) 0] - set name [lindex $commitinfo($id) 1] - set date [lindex $commitinfo($id) 2] - set date [formatdate $date] - set linehtag($lineno) [$canv create text $xt $y1 -anchor w \ - -text $headline -font $mainfont ] - $canv bind $linehtag($lineno) "rowmenu %X %Y $id" - set linentag($lineno) [$canv2 create text 3 $y1 -anchor w \ - -text $name -font $namefont] - set linedtag($lineno) [$canv3 create text 3 $y1 -anchor w \ - -text $date -font $mainfont] - - set olddlevel $level - set olddisplist $displist - set oldnlines [llength $displist] -} - proc drawtags {id x xt y1} { global idtags idheads idotherrefs global linespc lthickness - global canv mainfont idline rowtextx + global canv mainfont commitrow rowtextx set marks {} set ntags 0 @@ -904,7 +1707,7 @@ proc drawtags {id x xt y1} { $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \ -width 1 -outline black -fill yellow -tags tag.$id] $canv bind $t <1> [list showtag $tag 1] - set rowtextx($idline($id)) [expr {$xr + $linespc}] + set rowtextx($commitrow($id)) [expr {$xr + $linespc}] } else { # draw a head or other ref if {[incr nheads -1] >= 0} { @@ -925,11 +1728,32 @@ proc drawtags {id x xt y1} { return $xt } -proc notecrossings {id lo hi corner} { - global olddisplist crossings cornercrossings +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 $olddisplist $i] + set p [lindex [lindex $rowidlist $row] $i] if {$p == {}} continue if {$i == $corner} { if {![info exists cornercrossings($id)] @@ -965,509 +1789,23 @@ proc xcoord {i level ln} { return $x } -# it seems Tk can't draw arrows on the end of diagonal line segments... -proc trimdiagend {line} { - while {[llength $line] > 4} { - set x1 [lindex $line end-3] - set y1 [lindex $line end-2] - set x2 [lindex $line end-1] - set y2 [lindex $line end] - if {($x1 == $x2) != ($y1 == $y2)} break - set line [lreplace $line end-1 end] - } - return $line -} - -proc trimdiagstart {line} { - while {[llength $line] > 4} { - set x1 [lindex $line 0] - set y1 [lindex $line 1] - set x2 [lindex $line 2] - set y2 [lindex $line 3] - if {($x1 == $x2) != ($y1 == $y2)} break - set line [lreplace $line 0 1] - } - return $line -} - -proc drawslants {id needonscreen nohs} { - global canv mainline mainlinearrow sidelines - global canvx0 canvy xspc1 xspc2 lthickness - global currentparents dupparents - global lthickness linespc canvy colormap lineno geometry - global maxgraphpct maxwidth - global displist onscreen lastuse - global parents commitlisted - global oldnlines olddlevel olddisplist - global nhyperspace numcommits nnewparents - - if {$lineno < 0} { - lappend displist $id - set onscreen($id) 1 - return 0 - } - - set y1 [expr {$canvy - $linespc}] - set y2 $canvy - - # work out what we need to get back on screen - set reins {} - if {$onscreen($id) < 0} { - # next to do isn't displayed, better get it on screen... - lappend reins [list $id 0] - } - # make sure all the previous commits's parents are on the screen - foreach p $currentparents { - if {$onscreen($p) < 0} { - lappend reins [list $p 0] - } - } - # bring back anything requested by caller - if {$needonscreen ne {}} { - lappend reins $needonscreen - } - - # try the shortcut - if {$currentparents == $id && $onscreen($id) == 0 && $reins eq {}} { - set dlevel $olddlevel - set x [xcoord $dlevel $dlevel $lineno] - set mainline($id) [list $x $y1] - set mainlinearrow($id) none - set lastuse($id) $lineno - set displist [lreplace $displist $dlevel $dlevel $id] - set onscreen($id) 1 - set xspc1([expr {$lineno + 1}]) $xspc1($lineno) - return $dlevel - } - - # update displist - set displist [lreplace $displist $olddlevel $olddlevel] - set j $olddlevel - foreach p $currentparents { - set lastuse($p) $lineno - if {$onscreen($p) == 0} { - set displist [linsert $displist $j $p] - set onscreen($p) 1 - incr j - } - } - if {$onscreen($id) == 0} { - lappend displist $id - set onscreen($id) 1 - } - - # remove the null entry if present - set nullentry [lsearch -exact $displist {}] - if {$nullentry >= 0} { - set displist [lreplace $displist $nullentry $nullentry] - } - - # bring back the ones we need now (if we did it earlier - # it would change displist and invalidate olddlevel) - foreach pi $reins { - # test again in case of duplicates in reins - set p [lindex $pi 0] - if {$onscreen($p) < 0} { - set onscreen($p) 1 - set lastuse($p) $lineno - set displist [linsert $displist [lindex $pi 1] $p] - incr nhyperspace -1 - } - } - - set lastuse($id) $lineno - - # see if we need to make any lines jump off into hyperspace - set displ [llength $displist] - if {$displ > $maxwidth} { - set ages {} - foreach x $displist { - lappend ages [list $lastuse($x) $x] - } - set ages [lsort -integer -index 0 $ages] - set k 0 - while {$displ > $maxwidth} { - set use [lindex $ages $k 0] - set victim [lindex $ages $k 1] - if {$use >= $lineno - 5} break - incr k - if {[lsearch -exact $nohs $victim] >= 0} continue - set i [lsearch -exact $displist $victim] - set displist [lreplace $displist $i $i] - set onscreen($victim) -1 - incr nhyperspace - incr displ -1 - if {$i < $nullentry} { - incr nullentry -1 - } - set x [lindex $mainline($victim) end-1] - lappend mainline($victim) $x $y1 - set line [trimdiagend $mainline($victim)] - set arrow "last" - if {$mainlinearrow($victim) ne "none"} { - set line [trimdiagstart $line] - set arrow "both" - } - lappend sidelines($victim) [list $line 1 $arrow] - unset mainline($victim) - } - } - - set dlevel [lsearch -exact $displist $id] - - # If we are reducing, put in a null entry - if {$displ < $oldnlines} { - # does the next line look like a merge? - # i.e. does it have > 1 new parent? - if {$nnewparents($id) > 1} { - set i [expr {$dlevel + 1}] - } elseif {$nnewparents([lindex $olddisplist $olddlevel]) == 0} { - set i $olddlevel - if {$nullentry >= 0 && $nullentry < $i} { - incr i -1 - } - } elseif {$nullentry >= 0} { - set i $nullentry - while {$i < $displ - && [lindex $olddisplist $i] == [lindex $displist $i]} { - incr i - } - } else { - set i $olddlevel - if {$dlevel >= $i} { - incr i - } - } - if {$i < $displ} { - set displist [linsert $displist $i {}] - incr displ - if {$dlevel >= $i} { - incr dlevel - } - } - } - - # decide on the line spacing for the next line - set lj [expr {$lineno + 1}] - set maxw [expr {$maxgraphpct * $geometry(canv1) / 100}] - if {$displ <= 1 || $canvx0 + $displ * $xspc2 <= $maxw} { - set xspc1($lj) $xspc2 - } else { - set xspc1($lj) [expr {($maxw - $canvx0 - $xspc2) / ($displ - 1)}] - if {$xspc1($lj) < $lthickness} { - set xspc1($lj) $lthickness - } - } - - foreach idi $reins { - set id [lindex $idi 0] - set j [lsearch -exact $displist $id] - set xj [xcoord $j $dlevel $lj] - set mainline($id) [list $xj $y2] - set mainlinearrow($id) first - } - - set i -1 - foreach id $olddisplist { - incr i - if {$id == {}} continue - if {$onscreen($id) <= 0} continue - set xi [xcoord $i $olddlevel $lineno] - if {$i == $olddlevel} { - foreach p $currentparents { - set j [lsearch -exact $displist $p] - set coords [list $xi $y1] - set xj [xcoord $j $dlevel $lj] - if {$xj < $xi - $linespc} { - lappend coords [expr {$xj + $linespc}] $y1 - notecrossings $p $j $i [expr {$j + 1}] - } elseif {$xj > $xi + $linespc} { - lappend coords [expr {$xj - $linespc}] $y1 - notecrossings $p $i $j [expr {$j - 1}] - } - if {[lsearch -exact $dupparents $p] >= 0} { - # draw a double-width line to indicate the doubled parent - lappend coords $xj $y2 - lappend sidelines($p) [list $coords 2 none] - if {![info exists mainline($p)]} { - set mainline($p) [list $xj $y2] - set mainlinearrow($p) none - } - } else { - # normal case, no parent duplicated - set yb $y2 - set dx [expr {abs($xi - $xj)}] - if {0 && $dx < $linespc} { - set yb [expr {$y1 + $dx}] - } - if {![info exists mainline($p)]} { - if {$xi != $xj} { - lappend coords $xj $yb - } - set mainline($p) $coords - set mainlinearrow($p) none - } else { - lappend coords $xj $yb - if {$yb < $y2} { - lappend coords $xj $y2 - } - lappend sidelines($p) [list $coords 1 none] - } - } - } - } else { - set j $i - if {[lindex $displist $i] != $id} { - set j [lsearch -exact $displist $id] - } - if {$j != $i || $xspc1($lineno) != $xspc1($lj) - || ($olddlevel < $i && $i < $dlevel) - || ($dlevel < $i && $i < $olddlevel)} { - set xj [xcoord $j $dlevel $lj] - lappend mainline($id) $xi $y1 $xj $y2 - } - } - } - return $dlevel -} - -# search for x in a list of lists -proc llsearch {llist x} { - set i 0 - foreach l $llist { - if {$l == $x || [lsearch -exact $l $x] >= 0} { - return $i - } - incr i - } - return -1 -} - -proc drawmore {reading} { - global displayorder numcommits ncmupdate nextupdate - global stopped nhyperspace parents commitlisted - global maxwidth onscreen displist currentparents olddlevel - - set n [llength $displayorder] - while {$numcommits < $n} { - set id [lindex $displayorder $numcommits] - set ctxend [expr {$numcommits + 10}] - if {!$reading && $ctxend > $n} { - set ctxend $n - } - set dlist {} - if {$numcommits > 0} { - set dlist [lreplace $displist $olddlevel $olddlevel] - set i $olddlevel - foreach p $currentparents { - if {$onscreen($p) == 0} { - set dlist [linsert $dlist $i $p] - incr i - } - } - } - set nohs {} - set reins {} - set isfat [expr {[llength $dlist] > $maxwidth}] - if {$nhyperspace > 0 || $isfat} { - if {$ctxend > $n} break - # work out what to bring back and - # what we want to don't want to send into hyperspace - set room 1 - for {set k $numcommits} {$k < $ctxend} {incr k} { - set x [lindex $displayorder $k] - set i [llsearch $dlist $x] - if {$i < 0} { - set i [llength $dlist] - lappend dlist $x - } - if {[lsearch -exact $nohs $x] < 0} { - lappend nohs $x - } - if {$reins eq {} && $onscreen($x) < 0 && $room} { - set reins [list $x $i] - } - set newp {} - if {[info exists commitlisted($x)]} { - set right 0 - foreach p $parents($x) { - if {[llsearch $dlist $p] < 0} { - lappend newp $p - if {[lsearch -exact $nohs $p] < 0} { - lappend nohs $p - } - if {$reins eq {} && $onscreen($p) < 0 && $room} { - set reins [list $p [expr {$i + $right}]] - } - } - set right 1 - } - } - set l [lindex $dlist $i] - if {[llength $l] == 1} { - set l $newp - } else { - set j [lsearch -exact $l $x] - set l [concat [lreplace $l $j $j] $newp] - } - set dlist [lreplace $dlist $i $i $l] - if {$room && $isfat && [llength $newp] <= 1} { - set room 0 - } - } - } - - set dlevel [drawslants $id $reins $nohs] - drawcommitline $dlevel - if {[clock clicks -milliseconds] >= $nextupdate - && $numcommits >= $ncmupdate} { - doupdate $reading - if {$stopped} break - } - } -} - -# level here is an index in todo -proc updatetodo {level noshortcut} { - global ncleft todo nnewparents - global commitlisted parents onscreen - - set id [lindex $todo $level] - set olds {} - if {[info exists commitlisted($id)]} { - foreach p $parents($id) { - if {[lsearch -exact $olds $p] < 0} { - lappend olds $p - } - } - } - if {!$noshortcut && [llength $olds] == 1} { - set p [lindex $olds 0] - if {$ncleft($p) == 1 && [lsearch -exact $todo $p] < 0} { - set ncleft($p) 0 - set todo [lreplace $todo $level $level $p] - set onscreen($p) 0 - set nnewparents($id) 1 - return 0 - } - } - - set todo [lreplace $todo $level $level] - set i $level - set n 0 - foreach p $olds { - incr ncleft($p) -1 - set k [lsearch -exact $todo $p] - if {$k < 0} { - set todo [linsert $todo $i $p] - set onscreen($p) 0 - incr i - incr n - } - } - set nnewparents($id) $n - - return 1 -} - -proc decidenext {{noread 0}} { - global ncleft todo - global datemode cdate - global commitinfo - - # choose which one to do next time around - set todol [llength $todo] - set level -1 - set latest {} - for {set k $todol} {[incr k -1] >= 0} {} { - set p [lindex $todo $k] - if {$ncleft($p) == 0} { - if {$datemode} { - if {![info exists commitinfo($p)]} { - if {$noread} { - return {} - } - readcommit $p - } - if {$latest == {} || $cdate($p) > $latest} { - set level $k - set latest $cdate($p) - } - } else { - set level $k - break - } - } - } - if {$level < 0} { - if {$todo != {}} { - puts "ERROR: none of the pending commits can be done yet:" - foreach p $todo { - puts " $p ($ncleft($p))" - } - } - return -1 - } - - return $level -} - -proc drawcommit {id} { - global phase todo nchildren datemode nextupdate revlistorder - global numcommits ncmupdate displayorder todo onscreen parents - - if {$phase != "incrdraw"} { - set phase incrdraw - set displayorder {} - set todo {} - initgraph - } - if {$nchildren($id) == 0} { - lappend todo $id - set onscreen($id) 0 - } - if {$revlistorder} { - set level [lsearch -exact $todo $id] - if {$level < 0} { - error_popup "oops, $id isn't in todo" - return - } - lappend displayorder $id - updatetodo $level 0 - } else { - set level [decidenext 1] - if {$level == {} || $id != [lindex $todo $level]} { - return - } - while 1 { - lappend displayorder [lindex $todo $level] - if {[updatetodo $level $datemode]} { - set level [decidenext 1] - if {$level == {}} break - } - set id [lindex $todo $level] - if {![info exists commitlisted($id)]} { - break - } - } - } - drawmore 1 -} - proc finishcommits {} { - global phase + global commitidx phase global canv mainfont ctext maincursor textcursor + global findinprogress - if {$phase != "incrdraw"} { + if {$commitidx > 0} { + drawrest + } else { $canv delete all $canv create text 3 3 -anchor nw -text "No commits selected" \ -font $mainfont -tags textitems - set phase {} - } else { - drawrest } - . config -cursor $maincursor - settextcursor $textcursor + if {![info exists findinprogress]} { + . config -cursor $maincursor + settextcursor $textcursor + } + set phase {} } # Don't change the text pane cursor if it is currently the hand cursor, @@ -1481,54 +1819,20 @@ proc settextcursor {c} { set curtextcursor $c } -proc drawgraph {} { - global nextupdate startmsecs ncmupdate - global displayorder onscreen - - if {$displayorder == {}} return - set startmsecs [clock clicks -milliseconds] - set nextupdate [expr {$startmsecs + 100}] - set ncmupdate 1 - initgraph - foreach id $displayorder { - set onscreen($id) 0 - } - drawmore 0 -} - proc drawrest {} { - global phase stopped redisplaying selectedline - global datemode todo displayorder - global numcommits ncmupdate - global nextupdate startmsecs revlistorder + global numcommits + global startmsecs + global canvy0 numcommits linespc + global rowlaidout commitidx + + set row $rowlaidout + layoutrows $rowlaidout $commitidx 1 + layouttail + optimize_rows $row 0 $commitidx + showstuff $commitidx - set level [decidenext] - if {$level >= 0} { - set phase drawgraph - while 1 { - lappend displayorder [lindex $todo $level] - set hard [updatetodo $level $datemode] - if {$hard} { - set level [decidenext] - if {$level < 0} break - } - } - } - drawmore 0 - set phase {} set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}] #puts "overall $drawmsecs ms for $numcommits commits" - if {$redisplaying} { - if {$stopped == 0 && [info exists selectedline]} { - selectline $selectedline 0 - } - if {$stopped == 1} { - set stopped 0 - after idle drawgraph - } else { - set redisplaying 0 - } - } } proc findmatches {f} { @@ -1553,9 +1857,10 @@ proc findmatches {f} { proc dofind {} { global findtype findloc findstring markedmatches commitinfo - global numcommits lineid linehtag linentag linedtag + global numcommits displayorder linehtag linentag linedtag global mainfont namefont canv canv2 canv3 selectedline - global matchinglines foundstring foundstrlen + global matchinglines foundstring foundstrlen matchstring + global commitdata stopfindproc unmarkmatches @@ -1572,6 +1877,8 @@ proc dofind {} { } set foundstrlen [string length $findstring] if {$foundstrlen == 0} return + regsub -all {[*?\[\\]} $foundstring {\\&} matchstring + set matchstring "*$matchstring*" if {$findloc == "Files"} { findfiles return @@ -1583,8 +1890,21 @@ proc dofind {} { } set didsel 0 set fldtypes {Headline Author Date Committer CDate Comment} - for {set l 0} {$l < $numcommits} {incr l} { - set id $lineid($l) + set l -1 + foreach id $displayorder { + set d $commitdata($id) + incr l + if {$findtype == "Regexp"} { + set doesmatch [regexp $foundstring $d] + } elseif {$findtype == "IgnCase"} { + set doesmatch [string match -nocase $matchstring $d] + } else { + set doesmatch [string match $matchstring $d] + } + if {!$doesmatch} continue + if {![info exists commitinfo($id)]} { + getcommit $id + } set info $commitinfo($id) set doesmatch 0 foreach f $info ty $fldtypes { @@ -1595,10 +1915,13 @@ proc dofind {} { if {$matches == {}} continue set doesmatch 1 if {$ty == "Headline"} { + drawcmitrow $l markmatches $canv $l $f $linehtag($l) $matches $mainfont } elseif {$ty == "Author"} { + drawcmitrow $l markmatches $canv2 $l $f $linentag($l) $matches $namefont } elseif {$ty == "Date"} { + drawcmitrow $l markmatches $canv3 $l $f $linedtag($l) $matches $mainfont } } @@ -1706,7 +2029,7 @@ proc stopfindproc {{done 0}} { proc findpatches {} { global findstring selectedline numcommits global findprocpid findprocfile - global finddidsel ctext lineid findinprogress + global finddidsel ctext displayorder findinprogress global findinsertpos if {$numcommits == 0} return @@ -1723,7 +2046,7 @@ proc findpatches {} { if {[incr l] >= $numcommits} { set l 0 } - append inputids $lineid($l) "\n" + append inputids [lindex $displayorder $l] "\n" } if {[catch { @@ -1747,7 +2070,7 @@ proc findpatches {} { proc readfindproc {} { global findprocfile finddidsel - global idline matchinglines findinsertpos + global commitrow matchinglines findinsertpos set n [gets $findprocfile line] if {$n < 0} { @@ -1764,11 +2087,11 @@ proc readfindproc {} { stopfindproc return } - if {![info exists idline($id)]} { + if {![info exists commitrow($id)]} { puts stderr "spurious id: $id" return } - set l $idline($id) + set l $commitrow($id) insertmatch $l $id } @@ -1794,10 +2117,10 @@ proc insertmatch {l id} { } proc findfiles {} { - global selectedline numcommits lineid ctext - global ffileline finddidsel parents nparents + global selectedline numcommits displayorder ctext + global ffileline finddidsel parentlist global findinprogress findstartline findinsertpos - global treediffs fdiffids fdiffsneeded fdiffpos + global treediffs fdiffid fdiffsneeded fdiffpos global findmergefiles if {$numcommits == 0} return @@ -1812,13 +2135,11 @@ proc findfiles {} { set diffsneeded {} set fdiffsneeded {} while 1 { - set id $lineid($l) - if {$findmergefiles || $nparents($id) == 1} { - foreach p $parents($id) { - if {![info exists treediffs([list $id $p])]} { - append diffsneeded "$id $p\n" - lappend fdiffsneeded [list $id $p] - } + set id [lindex $displayorder $l] + if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} { + if {![info exists treediffs($id)]} { + append diffsneeded "$id\n" + lappend fdiffsneeded $id } } if {[incr l] >= $numcommits} { @@ -1835,7 +2156,7 @@ proc findfiles {} { error_popup "Error starting search process: $err" return } - catch {unset fdiffids} + catch {unset fdiffid} set fdiffpos 0 fconfigure $df -blocking 0 fileevent $df readable [list readfilediffs $df] @@ -1843,17 +2164,16 @@ proc findfiles {} { set finddidsel 0 set findinsertpos end - set id $lineid($l) - set p [lindex $parents($id) 0] + set id [lindex $displayorder $l] . config -cursor watch settextcursor watch set findinprogress 1 - findcont [list $id $p] + findcont update } proc readfilediffs {df} { - global findids fdiffids fdiffs + global findid fdiffid fdiffs set n [gets $df line] if {$n < 0} { @@ -1863,19 +2183,19 @@ proc readfilediffs {df} { stopfindproc bell error_popup "Error in git-diff-tree: $err" - } elseif {[info exists findids]} { - set ids $findids + } elseif {[info exists findid]} { + set id $findid stopfindproc bell - error_popup "Couldn't find diffs for {$ids}" + error_popup "Couldn't find diffs for $id" } } return } - if {[regexp {^([0-9a-f]{40}) \(from ([0-9a-f]{40})\)} $line match id p]} { + if {[regexp {^([0-9a-f]{40})$} $line match id]} { # start of a new string of diffs donefilediff - set fdiffids [list $id $p] + set fdiffid $id set fdiffs {} } elseif {[string match ":*" $line]} { lappend fdiffs [lindex $line 5] @@ -1883,53 +2203,51 @@ proc readfilediffs {df} { } proc donefilediff {} { - global fdiffids fdiffs treediffs findids + global fdiffid fdiffs treediffs findid global fdiffsneeded fdiffpos - if {[info exists fdiffids]} { - while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffids + if {[info exists fdiffid]} { + while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid && $fdiffpos < [llength $fdiffsneeded]} { # git-diff-tree doesn't output anything for a commit # which doesn't change anything - set nullids [lindex $fdiffsneeded $fdiffpos] - set treediffs($nullids) {} - if {[info exists findids] && $nullids eq $findids} { - unset findids - findcont $nullids + set nullid [lindex $fdiffsneeded $fdiffpos] + set treediffs($nullid) {} + if {[info exists findid] && $nullid eq $findid} { + unset findid + findcont } incr fdiffpos } incr fdiffpos - if {![info exists treediffs($fdiffids)]} { - set treediffs($fdiffids) $fdiffs + if {![info exists treediffs($fdiffid)]} { + set treediffs($fdiffid) $fdiffs } - if {[info exists findids] && $fdiffids eq $findids} { - unset findids - findcont $fdiffids + if {[info exists findid] && $fdiffid eq $findid} { + unset findid + findcont } } } -proc findcont {ids} { - global findids treediffs parents nparents +proc findcont {} { + global findid treediffs parentlist global ffileline findstartline finddidsel - global lineid numcommits matchinglines findinprogress + global displayorder numcommits matchinglines findinprogress global findmergefiles - set id [lindex $ids 0] - set p [lindex $ids 1] - set pi [lsearch -exact $parents($id) $p] set l $ffileline - while 1 { - if {$findmergefiles || $nparents($id) == 1} { - if {![info exists treediffs($ids)]} { - set findids $ids + while {1} { + set id [lindex $displayorder $l] + if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} { + if {![info exists treediffs($id)]} { + set findid $id set ffileline $l return } set doesmatch 0 - foreach f $treediffs($ids) { + foreach f $treediffs($id) { set x [findmatches $f] if {$x != {}} { set doesmatch 1 @@ -1938,21 +2256,12 @@ proc findcont {ids} { } if {$doesmatch} { insertmatch $l $id - set pi $nparents($id) } - } else { - set pi $nparents($id) } - if {[incr pi] >= $nparents($id)} { - set pi 0 - if {[incr l] >= $numcommits} { - set l 0 - } - if {$l == $findstartline} break - set id $lineid($l) + if {[incr l] >= $numcommits} { + set l 0 } - set p [lindex $parents($id) $pi] - set ids [list $id $p] + if {$l == $findstartline} break } stopfindproc if {!$finddidsel} { @@ -1963,8 +2272,9 @@ proc findcont {ids} { # mark a commit as matching by putting a yellow background # behind the headline proc markheadline {l id} { - global canv mainfont linehtag commitinfo + global canv mainfont linehtag + drawcmitrow $l set bbox [$canv bbox $linehtag($l)] set t [$canv create rect $bbox -outline {} -tags matches -fill yellow] $canv lower $t @@ -1998,7 +2308,7 @@ proc unmarkmatches {} { proc selcanvline {w x y} { global canv canvy0 ctext linespc - global lineid linehtag linentag linedtag rowtextx + global rowtextx set ymax [lindex [$canv cget -scrollregion] 3] if {$ymax == {}} return set yfrac [lindex [$canv yview] 0] @@ -2026,7 +2336,7 @@ proc commit_descriptor {p} { # append some text to the ctext widget, and make any SHA1 ID # that we know about be a clickable link. proc appendwithlinks {text} { - global ctext idline linknum + global ctext commitrow linknum set start [$ctext index "end - 1c"] $ctext insert end $text @@ -2036,11 +2346,11 @@ proc appendwithlinks {text} { set s [lindex $l 0] set e [lindex $l 1] set linkid [string range $text $s $e] - if {![info exists idline($linkid)]} continue + if {![info exists commitrow($linkid)]} continue incr e $ctext tag add link "$start + $s c" "$start + $e c" $ctext tag add link$linknum "$start + $s c" "$start + $e c" - $ctext tag bind link$linknum <1> [list selectline $idline($linkid) 1] + $ctext tag bind link$linknum <1> [list selectline $commitrow($linkid) 1] incr linknum } $ctext tag conf link -foreground blue -underline 1 @@ -2048,28 +2358,33 @@ proc appendwithlinks {text} { $ctext tag bind link { %W configure -cursor $curtextcursor } } +proc viewnextline {dir} { + global canv linespc + + $canv delete hover + set ymax [lindex [$canv cget -scrollregion] 3] + set wnow [$canv yview] + set wtop [expr {[lindex $wnow 0] * $ymax}] + set newtop [expr {$wtop + $dir * $linespc}] + if {$newtop < 0} { + set newtop 0 + } elseif {$newtop > $ymax} { + set newtop $ymax + } + allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}] +} + proc selectline {l isnew} { global canv canv2 canv3 ctext commitinfo selectedline - global lineid linehtag linentag linedtag - global canvy0 linespc parents nparents children + global displayorder linehtag linentag linedtag + global canvy0 linespc parentlist childlist global cflist currentid sha1entry - global commentend idtags idline linknum + global commentend idtags linknum + global mergemax numcommits $canv delete hover normalline - if {![info exists lineid($l)] || ![info exists linehtag($l)]} return - $canv delete secsel - set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \ - -tags secsel -fill [$canv cget -selectbackground]] - $canv lower $t - $canv2 delete secsel - set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \ - -tags secsel -fill [$canv2 cget -selectbackground]] - $canv2 lower $t - $canv3 delete secsel - set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \ - -tags secsel -fill [$canv3 cget -selectbackground]] - $canv3 lower $t + if {$l < 0 || $l >= $numcommits} return set y [expr {$canvy0 + $l * $linespc}] set ymax [lindex [$canv cget -scrollregion] 3] set ytop [expr {$y - $linespc - 1}] @@ -2103,15 +2418,30 @@ proc selectline {l isnew} { set newtop 0 } allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}] + drawvisible } + if {![info exists linehtag($l)]} return + $canv delete secsel + set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \ + -tags secsel -fill [$canv cget -selectbackground]] + $canv lower $t + $canv2 delete secsel + set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \ + -tags secsel -fill [$canv2 cget -selectbackground]] + $canv2 lower $t + $canv3 delete secsel + set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \ + -tags secsel -fill [$canv3 cget -selectbackground]] + $canv3 lower $t + if {$isnew} { addtohistory [list selectline $l 0] } set selectedline $l - set id $lineid($l) + set id [lindex $displayorder $l] set currentid $id $sha1entry delete 0 end $sha1entry insert 0 $id @@ -2137,15 +2467,27 @@ proc selectline {l isnew} { } set comment {} - if {[info exists parents($id)]} { - foreach p $parents($id) { + set olds [lindex $parentlist $l] + if {[llength $olds] > 1} { + set np 0 + foreach p $olds { + if {$np >= $mergemax} { + set tag mmax + } else { + set tag m$np + } + $ctext insert end "Parent: " $tag + appendwithlinks [commit_descriptor $p] + incr np + } + } else { + foreach p $olds { append comment "Parent: [commit_descriptor $p]\n" } } - if {[info exists children($id)]} { - foreach c $children($id) { - append comment "Child: [commit_descriptor $c]\n" - } + + foreach c [lindex $childlist $l] { + append comment "Child: [commit_descriptor $c]\n" } append comment "\n" append comment [lindex $info 5] @@ -2160,13 +2502,25 @@ proc selectline {l isnew} { $cflist delete 0 end $cflist insert end "Comments" - if {$nparents($id) == 1} { + if {[llength $olds] <= 1} { startdiff $id - } elseif {$nparents($id) > 1} { - mergediff $id + } else { + mergediff $id $l } } +proc selfirstline {} { + unmarkmatches + selectline 0 1 +} + +proc sellastline {} { + global numcommits + unmarkmatches + set l [expr {$numcommits - 1}] + selectline $l 1 +} + proc selnextline {dir} { global selectedline if {![info exists selectedline]} return @@ -2175,6 +2529,25 @@ proc selnextline {dir} { 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 @@ -2232,530 +2605,104 @@ proc goforw {} { } } -proc mergediff {id} { - global parents diffmergeid diffmergegca mergefilelist diffpindex +proc mergediff {id l} { + global diffmergeid diffopts mdifffd + global difffilestart diffids + global parentlist set diffmergeid $id - set diffpindex -1 - set diffmergegca [findgca $parents($id)] - if {[info exists mergefilelist($id)]} { - if {$mergefilelist($id) ne {}} { - showmergediff - } - } else { - contmergediff {} - } -} - -proc findgca {ids} { - set gca {} - foreach id $ids { - if {$gca eq {}} { - set gca $id - } else { - if {[catch { - set gca [exec git-merge-base $gca $id] - } err]} { - return {} - } - } - } - return $gca -} - -proc contmergediff {ids} { - global diffmergeid diffpindex parents nparents diffmergegca - global treediffs mergefilelist diffids treepending - - # diff the child against each of the parents, and diff - # each of the parents against the GCA. - while 1 { - if {[lindex $ids 1] == $diffmergeid && $diffmergegca ne {}} { - set ids [list $diffmergegca [lindex $ids 0]] - } else { - if {[incr diffpindex] >= $nparents($diffmergeid)} break - set p [lindex $parents($diffmergeid) $diffpindex] - set ids [list $p $diffmergeid] - } - if {![info exists treediffs($ids)]} { - set diffids $ids - if {![info exists treepending]} { - gettreediffs $ids - } - return - } - } - - # If a file in some parent is different from the child and also - # different from the GCA, then it's interesting. - # If we don't have a GCA, then a file is interesting if it is - # different from the child in all the parents. - if {$diffmergegca ne {}} { - set files {} - foreach p $parents($diffmergeid) { - set gcadiffs $treediffs([list $diffmergegca $p]) - foreach f $treediffs([list $p $diffmergeid]) { - if {[lsearch -exact $files $f] < 0 - && [lsearch -exact $gcadiffs $f] >= 0} { - lappend files $f - } - } - } - set files [lsort $files] - } else { - set p [lindex $parents($diffmergeid) 0] - set files $treediffs([list $diffmergeid $p]) - for {set i 1} {$i < $nparents($diffmergeid) && $files ne {}} {incr i} { - set p [lindex $parents($diffmergeid) $i] - set df $treediffs([list $p $diffmergeid]) - set nf {} - foreach f $files { - if {[lsearch -exact $df $f] >= 0} { - lappend nf $f - } - } - set files $nf - } - } - - set mergefilelist($diffmergeid) $files - if {$files ne {}} { - showmergediff - } -} - -proc showmergediff {} { - global cflist diffmergeid mergefilelist parents - global diffopts diffinhunk currentfile currenthunk filelines - global diffblocked groupfilelast mergefds groupfilenum grouphunks - - set files $mergefilelist($diffmergeid) - foreach f $files { - $cflist insert end $f - } + set diffids $id + catch {unset difffilestart} + # this doesn't seem to actually affect anything... set env(GIT_DIFF_OPTS) $diffopts - set flist {} - catch {unset currentfile} - catch {unset currenthunk} - catch {unset filelines} - catch {unset groupfilenum} - catch {unset grouphunks} - set groupfilelast -1 - foreach p $parents($diffmergeid) { - set cmd [list | git-diff-tree -p $p $diffmergeid] - set cmd [concat $cmd $mergefilelist($diffmergeid)] - if {[catch {set f [open $cmd r]} err]} { - error_popup "Error getting diffs: $err" - foreach f $flist { - catch {close $f} - } - return - } - lappend flist $f - set ids [list $diffmergeid $p] - set mergefds($ids) $f - set diffinhunk($ids) 0 - set diffblocked($ids) 0 - fconfigure $f -blocking 0 - fileevent $f readable [list getmergediffline $f $ids $diffmergeid] + set cmd [concat | git-diff-tree --no-commit-id --cc $id] + if {[catch {set mdf [open $cmd r]} err]} { + error_popup "Error getting merge diffs: $err" + return } + fconfigure $mdf -blocking 0 + set mdifffd($id) $mdf + set np [llength [lindex $parentlist $l]] + fileevent $mdf readable [list getmergediffline $mdf $id $np] + set nextupdate [expr {[clock clicks -milliseconds] + 100}] } -proc getmergediffline {f ids id} { - global diffmergeid diffinhunk diffoldlines diffnewlines - global currentfile currenthunk - global diffoldstart diffnewstart diffoldlno diffnewlno - global diffblocked mergefilelist - global noldlines nnewlines difflcounts filelines +proc getmergediffline {mdf id np} { + global diffmergeid ctext cflist nextupdate mergemax + global difffilestart mdifffd - set n [gets $f line] + set n [gets $mdf line] if {$n < 0} { - if {![eof $f]} return - } - - if {!([info exists diffmergeid] && $diffmergeid == $id)} { - if {$n < 0} { - close $f + if {[eof $mdf]} { + close $mdf } return } - - if {$diffinhunk($ids) != 0} { - set fi $currentfile($ids) - if {$n > 0 && [regexp {^[-+ \\]} $line match]} { - # continuing an existing hunk - set line [string range $line 1 end] - set p [lindex $ids 1] - if {$match eq "-" || $match eq " "} { - set filelines($p,$fi,$diffoldlno($ids)) $line - incr diffoldlno($ids) - } - if {$match eq "+" || $match eq " "} { - set filelines($id,$fi,$diffnewlno($ids)) $line - incr diffnewlno($ids) - } - if {$match eq " "} { - if {$diffinhunk($ids) == 2} { - lappend difflcounts($ids) \ - [list $noldlines($ids) $nnewlines($ids)] - set noldlines($ids) 0 - set diffinhunk($ids) 1 - } - incr noldlines($ids) - } elseif {$match eq "-" || $match eq "+"} { - if {$diffinhunk($ids) == 1} { - lappend difflcounts($ids) [list $noldlines($ids)] - set noldlines($ids) 0 - set nnewlines($ids) 0 - set diffinhunk($ids) 2 - } - if {$match eq "-"} { - incr noldlines($ids) - } else { - incr nnewlines($ids) - } - } - # and if it's \ No newline at end of line, then what? - return - } - # end of a hunk - if {$diffinhunk($ids) == 1 && $noldlines($ids) != 0} { - lappend difflcounts($ids) [list $noldlines($ids)] - } elseif {$diffinhunk($ids) == 2 - && ($noldlines($ids) != 0 || $nnewlines($ids) != 0)} { - lappend difflcounts($ids) [list $noldlines($ids) $nnewlines($ids)] - } - set currenthunk($ids) [list $currentfile($ids) \ - $diffoldstart($ids) $diffnewstart($ids) \ - $diffoldlno($ids) $diffnewlno($ids) \ - $difflcounts($ids)] - set diffinhunk($ids) 0 - # -1 = need to block, 0 = unblocked, 1 = is blocked - set diffblocked($ids) -1 - processhunks - if {$diffblocked($ids) == -1} { - fileevent $f readable {} - set diffblocked($ids) 1 - } - } - - if {$n < 0} { - # eof - if {!$diffblocked($ids)} { - close $f - set currentfile($ids) [llength $mergefilelist($diffmergeid)] - set currenthunk($ids) [list $currentfile($ids) 0 0 0 0 {}] - processhunks - } - } elseif {[regexp {^diff --git a/(.*) b/} $line match fname]} { - # start of a new file - set currentfile($ids) \ - [lsearch -exact $mergefilelist($diffmergeid) $fname] - } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \ - $line match f1l f1c f2l f2c rest]} { - if {[info exists currentfile($ids)] && $currentfile($ids) >= 0} { - # start of a new hunk - if {$f1l == 0 && $f1c == 0} { - set f1l 1 - } - if {$f2l == 0 && $f2c == 0} { - set f2l 1 - } - set diffinhunk($ids) 1 - set diffoldstart($ids) $f1l - set diffnewstart($ids) $f2l - set diffoldlno($ids) $f1l - set diffnewlno($ids) $f2l - set difflcounts($ids) {} - set noldlines($ids) 0 - set nnewlines($ids) 0 - } - } -} - -proc processhunks {} { - global diffmergeid parents nparents currenthunk - global mergefilelist diffblocked mergefds - global grouphunks grouplinestart grouplineend groupfilenum - - set nfiles [llength $mergefilelist($diffmergeid)] - while 1 { - set fi $nfiles - set lno 0 - # look for the earliest hunk - foreach p $parents($diffmergeid) { - set ids [list $diffmergeid $p] - if {![info exists currenthunk($ids)]} return - set i [lindex $currenthunk($ids) 0] - set l [lindex $currenthunk($ids) 2] - if {$i < $fi || ($i == $fi && $l < $lno)} { - set fi $i - set lno $l - set pi $p - } - } - - if {$fi < $nfiles} { - set ids [list $diffmergeid $pi] - set hunk $currenthunk($ids) - unset currenthunk($ids) - if {$diffblocked($ids) > 0} { - fileevent $mergefds($ids) readable \ - [list getmergediffline $mergefds($ids) $ids $diffmergeid] - } - set diffblocked($ids) 0 - - if {[info exists groupfilenum] && $groupfilenum == $fi - && $lno <= $grouplineend} { - # add this hunk to the pending group - lappend grouphunks($pi) $hunk - set endln [lindex $hunk 4] - if {$endln > $grouplineend} { - set grouplineend $endln - } - continue - } - } - - # succeeding stuff doesn't belong in this group, so - # process the group now - if {[info exists groupfilenum]} { - processgroup - unset groupfilenum - unset grouphunks - } - - if {$fi >= $nfiles} break - - # start a new group - set groupfilenum $fi - set grouphunks($pi) [list $hunk] - set grouplinestart $lno - set grouplineend [lindex $hunk 4] + if {![info exists diffmergeid] || $id != $diffmergeid + || $mdf != $mdifffd($id)} { + return } -} - -proc processgroup {} { - global groupfilelast groupfilenum difffilestart - global mergefilelist diffmergeid ctext filelines - global parents diffmergeid diffoffset - global grouphunks grouplinestart grouplineend nparents - global mergemax - $ctext conf -state normal - set id $diffmergeid - set f $groupfilenum - if {$groupfilelast != $f} { + if {[regexp {^diff --cc (.*)} $line match fname]} { + # start of a new file $ctext insert end "\n" set here [$ctext index "end - 1c"] - set difffilestart($f) $here - set mark fmark.[expr {$f + 1}] - $ctext mark set $mark $here - $ctext mark gravity $mark left - set header [lindex $mergefilelist($id) $f] - set l [expr {(78 - [string length $header]) / 2}] + set i [$cflist index end] + $ctext mark set fmark.$i $here + $ctext mark gravity fmark.$i left + set difffilestart([expr {$i-1}]) $here + $cflist insert end $fname + set l [expr {(78 - [string length $fname]) / 2}] set pad [string range "----------------------------------------" 1 $l] - $ctext insert end "$pad $header $pad\n" filesep - set groupfilelast $f - foreach p $parents($id) { - set diffoffset($p) 0 - } - } - - $ctext insert end "@@" msep - set nlines [expr {$grouplineend - $grouplinestart}] - set events {} - set pnum 0 - foreach p $parents($id) { - set startline [expr {$grouplinestart + $diffoffset($p)}] - set ol $startline - set nl $grouplinestart - if {[info exists grouphunks($p)]} { - foreach h $grouphunks($p) { - set l [lindex $h 2] - if {$nl < $l} { - for {} {$nl < $l} {incr nl} { - set filelines($p,$f,$ol) $filelines($id,$f,$nl) - incr ol - } - } - foreach chunk [lindex $h 5] { - if {[llength $chunk] == 2} { - set olc [lindex $chunk 0] - set nlc [lindex $chunk 1] - set nnl [expr {$nl + $nlc}] - lappend events [list $nl $nnl $pnum $olc $nlc] - incr ol $olc - set nl $nnl - } else { - incr ol [lindex $chunk 0] - incr nl [lindex $chunk 0] - } - } - } - } - if {$nl < $grouplineend} { - for {} {$nl < $grouplineend} {incr nl} { - set filelines($p,$f,$ol) $filelines($id,$f,$nl) - incr ol - } - } - set nlines [expr {$ol - $startline}] - $ctext insert end " -$startline,$nlines" msep - incr pnum - } - - set nlines [expr {$grouplineend - $grouplinestart}] - $ctext insert end " +$grouplinestart,$nlines @@\n" msep - - set events [lsort -integer -index 0 $events] - set nevents [llength $events] - set nmerge $nparents($diffmergeid) - set l $grouplinestart - for {set i 0} {$i < $nevents} {set i $j} { - set nl [lindex $events $i 0] - while {$l < $nl} { - $ctext insert end " $filelines($id,$f,$l)\n" - incr l - } - set e [lindex $events $i] - set enl [lindex $e 1] - set j $i - set active {} - while 1 { - set pnum [lindex $e 2] - set olc [lindex $e 3] - set nlc [lindex $e 4] - if {![info exists delta($pnum)]} { - set delta($pnum) [expr {$olc - $nlc}] - lappend active $pnum + $ctext insert end "$pad $fname $pad\n" filesep + } elseif {[regexp {^@@} $line]} { + $ctext insert end "$line\n" hunksep + } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} { + # do nothing + } else { + # parse the prefix - one ' ', '-' or '+' for each parent + set spaces {} + set minuses {} + set pluses {} + set isbad 0 + for {set j 0} {$j < $np} {incr j} { + set c [string range $line $j $j] + if {$c == " "} { + lappend spaces $j + } elseif {$c == "-"} { + lappend minuses $j + } elseif {$c == "+"} { + lappend pluses $j } else { - incr delta($pnum) [expr {$olc - $nlc}] - } - if {[incr j] >= $nevents} break - set e [lindex $events $j] - if {[lindex $e 0] >= $enl} break - if {[lindex $e 1] > $enl} { - set enl [lindex $e 1] - } - } - set nlc [expr {$enl - $l}] - set ncol mresult - set bestpn -1 - if {[llength $active] == $nmerge - 1} { - # no diff for one of the parents, i.e. it's identical - for {set pnum 0} {$pnum < $nmerge} {incr pnum} { - if {![info exists delta($pnum)]} { - if {$pnum < $mergemax} { - lappend ncol m$pnum - } else { - lappend ncol mmax - } - break - } - } - } elseif {[llength $active] == $nmerge} { - # all parents are different, see if one is very similar - set bestsim 30 - for {set pnum 0} {$pnum < $nmerge} {incr pnum} { - set sim [similarity $pnum $l $nlc $f \ - [lrange $events $i [expr {$j-1}]]] - if {$sim > $bestsim} { - set bestsim $sim - set bestpn $pnum - } - } - if {$bestpn >= 0} { - lappend ncol m$bestpn - } - } - set pnum -1 - foreach p $parents($id) { - incr pnum - if {![info exists delta($pnum)] || $pnum == $bestpn} continue - set olc [expr {$nlc + $delta($pnum)}] - set ol [expr {$l + $diffoffset($p)}] - incr diffoffset($p) $delta($pnum) - unset delta($pnum) - for {} {$olc > 0} {incr olc -1} { - $ctext insert end "-$filelines($p,$f,$ol)\n" m$pnum - incr ol - } - } - set endl [expr {$l + $nlc}] - if {$bestpn >= 0} { - # show this pretty much as a normal diff - set p [lindex $parents($id) $bestpn] - set ol [expr {$l + $diffoffset($p)}] - incr diffoffset($p) $delta($bestpn) - unset delta($bestpn) - for {set k $i} {$k < $j} {incr k} { - set e [lindex $events $k] - if {[lindex $e 2] != $bestpn} continue - set nl [lindex $e 0] - set ol [expr {$ol + $nl - $l}] - for {} {$l < $nl} {incr l} { - $ctext insert end "+$filelines($id,$f,$l)\n" $ncol - } - set c [lindex $e 3] - for {} {$c > 0} {incr c -1} { - $ctext insert end "-$filelines($p,$f,$ol)\n" m$bestpn - incr ol - } - set nl [lindex $e 1] - for {} {$l < $nl} {incr l} { - $ctext insert end "+$filelines($id,$f,$l)\n" mresult - } + set isbad 1 + break } } - for {} {$l < $endl} {incr l} { - $ctext insert end "+$filelines($id,$f,$l)\n" $ncol - } - } - while {$l < $grouplineend} { - $ctext insert end " $filelines($id,$f,$l)\n" - incr l - } - $ctext conf -state disabled -} - -proc similarity {pnum l nlc f events} { - global diffmergeid parents diffoffset filelines - - set id $diffmergeid - set p [lindex $parents($id) $pnum] - set ol [expr {$l + $diffoffset($p)}] - set endl [expr {$l + $nlc}] - set same 0 - set diff 0 - foreach e $events { - if {[lindex $e 2] != $pnum} continue - set nl [lindex $e 0] - set ol [expr {$ol + $nl - $l}] - for {} {$l < $nl} {incr l} { - incr same [string length $filelines($id,$f,$l)] - incr same - } - set oc [lindex $e 3] - for {} {$oc > 0} {incr oc -1} { - incr diff [string length $filelines($p,$f,$ol)] - incr diff - incr ol + set tags {} + set num {} + if {!$isbad && $minuses ne {} && $pluses eq {}} { + # line doesn't appear in result, parents in $minuses have the line + set num [lindex $minuses 0] + } elseif {!$isbad && $pluses ne {} && $minuses eq {}} { + # line appears in result, parents in $pluses don't have the line + lappend tags mresult + set num [lindex $spaces 0] } - set nl [lindex $e 1] - for {} {$l < $nl} {incr l} { - incr diff [string length $filelines($id,$f,$l)] - incr diff + if {$num ne {}} { + if {$num >= $mergemax} { + set num "max" + } + lappend tags m$num } + $ctext insert end "$line\n" $tags } - for {} {$l < $endl} {incr l} { - incr same [string length $filelines($id,$f,$l)] - incr same - } - if {$same == 0} { - return 0 + $ctext conf -state disabled + if {[clock clicks -milliseconds] >= $nextupdate} { + incr nextupdate 100 + fileevent $mdf readable {} + update + fileevent $mdf readable [list getmergediffline $mdf $id $np] } - return [expr {200 * $same / (2 * $same + $diff)}] } proc startdiff {ids} { @@ -2781,10 +2728,12 @@ proc addtocflist {ids} { } proc gettreediffs {ids} { - global treediff parents treepending + global treediff treepending set treepending $ids set treediff {} - if [catch {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]}] return + if {[catch \ + {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \ + ]} return fconfigure $gdtf -blocking 0 fileevent $gdtf readable [list gettreediffline $gdtf $ids] } @@ -2799,13 +2748,11 @@ proc gettreediffline {gdtf ids} { set treediffs($ids) $treediff unset treepending if {$ids != $diffids} { - gettreediffs $diffids - } else { - if {[info exists diffmergeid]} { - contmergediff $ids - } else { - addtocflist $ids + if {![info exists diffmergeid]} { + gettreediffs $diffids } + } else { + addtocflist $ids } return } @@ -2881,7 +2828,9 @@ proc getblobdiffline {bdf ids} { set pad [string range "----------------------------------------" 1 $l] $ctext insert end "$pad $header $pad\n" filesep set diffinhdr 1 - } elseif {[regexp {^(---|\+\+\+)} $line]} { + } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} { + # do nothing + } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} { set diffinhdr 0 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \ $line match f1l f1c f2l f2c rest]} { @@ -2948,22 +2897,26 @@ proc setcoords {} { set linespc [font metrics $mainfont -linespace] set charspc [font measure $mainfont "m"] - set canvy0 [expr {3 + 0.5 * $linespc}] - set canvx0 [expr {3 + 0.5 * $linespc}] + set canvy0 [expr {int(3 + 0.5 * $linespc)}] + set canvx0 [expr {int(3 + 0.5 * $linespc)}] set lthickness [expr {int($linespc / 9) + 1}] set xspc1(0) $linespc set xspc2 $linespc } proc redisplay {} { - global stopped redisplaying phase - if {$stopped > 1} return - if {$phase == "getcommits"} return - set redisplaying 1 - if {$phase == "drawgraph" || $phase == "incrdraw"} { - set stopped 1 - } else { - drawgraph + global canv + global selectedline + + set ymax [lindex [$canv cget -scrollregion] 3] + if {$ymax eq {} || $ymax == 0} return + set span [$canv yview] + clear_display + setcanvscroll + allcanvs yview moveto [lindex $span 0] + drawvisible + if {[info exists selectedline]} { + selectline $selectedline 0 } } @@ -3010,20 +2963,22 @@ proc sha1change {n1 n2 op} { } proc gotocommit {} { - global sha1string currentid idline tagids - global lineid numcommits + global sha1string currentid commitrow tagids headids + global displayorder numcommits if {$sha1string == {} || ([info exists currentid] && $sha1string == $currentid)} return if {[info exists tagids($sha1string)]} { set id $tagids($sha1string) + } elseif {[info exists headids($sha1string)]} { + set id $headids($sha1string) } else { set id [string tolower $sha1string] if {[regexp {^[0-9a-f]{4,39}$} $id]} { set matches {} - for {set l 0} {$l < $numcommits} {incr l} { - if {[string match $id* $lineid($l)]} { - lappend matches $lineid($l) + foreach i $displayorder { + if {[string match $id* $i]} { + lappend matches $i } } if {$matches ne {}} { @@ -3035,14 +2990,14 @@ proc gotocommit {} { } } } - if {[info exists idline($id)]} { - selectline $idline($id) 1 + if {[info exists commitrow($id)]} { + selectline $commitrow($id) 1 return } 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" } @@ -3051,7 +3006,7 @@ proc lineenter {x y id} { global hoverx hovery hoverid hovertimer global commitinfo canv - if {![info exists commitinfo($id)]} return + if {![info exists commitinfo($id)] && ![getcommit $id]} return set hoverx $x set hovery $y set hoverid $id @@ -3111,65 +3066,26 @@ proc linehover {} { } proc clickisonarrow {id y} { - global mainline mainlinearrow sidelines lthickness + global lthickness idrowranges set thresh [expr {2 * $lthickness + 6}] - if {[info exists mainline($id)]} { - if {$mainlinearrow($id) ne "none"} { - if {abs([lindex $mainline($id) 1] - $y) < $thresh} { - return "up" - } - } - } - if {[info exists sidelines($id)]} { - foreach ls $sidelines($id) { - set coords [lindex $ls 0] - set arrow [lindex $ls 2] - if {$arrow eq "first" || $arrow eq "both"} { - if {abs([lindex $coords 1] - $y) < $thresh} { - return "up" - } - } - if {$arrow eq "last" || $arrow eq "both"} { - if {abs([lindex $coords end] - $y) < $thresh} { - return "down" - } - } + set n [expr {[llength $idrowranges($id)] - 1}] + for {set i 1} {$i < $n} {incr i} { + set row [lindex $idrowranges($id) $i] + if {abs([yc $row] - $y) < $thresh} { + return $i } } return {} } -proc arrowjump {id dirn y} { - global mainline sidelines canv canv2 canv3 +proc arrowjump {id n y} { + global idrowranges canv - set yt {} - if {$dirn eq "down"} { - if {[info exists mainline($id)]} { - set y1 [lindex $mainline($id) 1] - if {$y1 > $y} { - set yt $y1 - } - } - if {[info exists sidelines($id)]} { - foreach ls $sidelines($id) { - set y1 [lindex $ls 0 1] - if {$y1 > $y && ($yt eq {} || $y1 < $yt)} { - set yt $y1 - } - } - } - } else { - if {[info exists sidelines($id)]} { - foreach ls $sidelines($id) { - set y1 [lindex $ls 0 end] - if {$y1 < $y && ($yt eq {} || $y1 > $yt)} { - set yt $y1 - } - } - } - } - if {$yt eq {}} return + # 1 <-> 2, 3 <-> 4, etc... + set n [expr {(($n - 1) ^ 1) + 1}] + set row [lindex $idrowranges($id) $n] + set yt [yc $row] set ymax [lindex [$canv cget -scrollregion] 3] if {$ymax eq {} || $ymax <= 0} return set view [$canv yview] @@ -3178,21 +3094,20 @@ proc arrowjump {id dirn y} { if {$yfrac < 0} { set yfrac 0 } - $canv yview moveto $yfrac - $canv2 yview moveto $yfrac - $canv3 yview moveto $yfrac + allcanvs yview moveto $yfrac } proc lineclick {x y id isnew} { - global ctext commitinfo children cflist canv thickerline + global ctext commitinfo childlist commitrow cflist canv thickerline + if {![info exists commitinfo($id)] && ![getcommit $id]} return unmarkmatches unselectline normalline $canv delete hover # draw this line thicker than normal - drawlines $id 1 1 set thickerline $id + drawlines $id if {$isnew} { set ymax [lindex [$canv cget -scrollregion] 3] if {$ymax eq {}} return @@ -3222,11 +3137,13 @@ proc lineclick {x y id isnew} { $ctext insert end "\tAuthor:\t[lindex $info 1]\n" set date [formatdate [lindex $info 2]] $ctext insert end "\tDate:\t$date\n" - if {[info exists children($id)]} { + set kids [lindex $childlist $commitrow($id)] + if {$kids ne {}} { $ctext insert end "\nChildren:" set i 0 - foreach child $children($id) { + foreach child $kids { incr i + if {![info exists commitinfo($child)] && ![getcommit $child]} continue set info $commitinfo($child) $ctext insert end "\n\t" $ctext insert end $child [list link link$i] @@ -3245,15 +3162,16 @@ proc lineclick {x y id isnew} { proc normalline {} { global thickerline if {[info exists thickerline]} { - drawlines $thickerline 0 1 + set id $thickerline unset thickerline + drawlines $id } } proc selbyid {id} { - global idline - if {[info exists idline($id)]} { - selectline $idline($id) 1 + global commitrow + if {[info exists commitrow($id)]} { + selectline $commitrow($id) 1 } } @@ -3266,9 +3184,9 @@ proc mstime {} { } proc rowmenu {x y id} { - global rowctxmenu idline selectedline rowmenuid + global rowctxmenu commitrow selectedline rowmenuid - if {![info exists selectedline] || $idline($id) eq $selectedline} { + if {![info exists selectedline] || $commitrow($id) eq $selectedline} { set state disabled } else { set state normal @@ -3281,15 +3199,15 @@ proc rowmenu {x y id} { } proc diffvssel {dirn} { - global rowmenuid selectedline lineid + global rowmenuid selectedline displayorder if {![info exists selectedline]} return if {$dirn} { - set oldid $lineid($selectedline) + set oldid [lindex $displayorder $selectedline] set newid $rowmenuid } else { set oldid $rowmenuid - set newid $lineid($selectedline) + set newid [lindex $displayorder $selectedline] } addtohistory [list doseldiff $oldid $newid] doseldiff $oldid $newid @@ -3471,13 +3389,14 @@ proc domktag {} { } proc redrawtags {id} { - global canv linehtag idline idpos selectedline + global canv linehtag commitrow idpos selectedline - if {![info exists idline($id)]} return + if {![info exists commitrow($id)]} return + drawcmitrow $commitrow($id) $canv delete tag.$id set xt [eval drawtags $id $idpos($id)] - $canv coords $linehtag($idline($id)) $xt [lindex $idpos($id) 2] - if {[info exists selectedline] && $selectedline == $idline($id)} { + $canv coords $linehtag($commitrow($id)) $xt [lindex $idpos($id) 2] + if {[info exists selectedline] && $selectedline == $commitrow($id)} { selectline $selectedline 0 } } @@ -3569,7 +3488,6 @@ proc listrefs {id} { proc rereadrefs {} { global idtags idheads idotherrefs - global tagids headids otherrefids set refids [concat [array names idtags] \ [array names idheads] [array names idotherrefs]] @@ -3578,9 +3496,6 @@ proc rereadrefs {} { set ref($id) [listrefs $id] } } - foreach v {tagids idtags headids idheads otherrefids idotherrefs} { - catch {unset $v} - } readrefs set refids [lsort -unique [concat $refids [array names idtags] \ [array names idheads] [array names idotherrefs]]] @@ -3689,26 +3604,307 @@ proc formatdate {d} { return [clock format $d -format "%Y-%m-%d %H:%M:%S"] } +# This list of encoding names and aliases is distilled from +# http://www.iana.org/assignments/character-sets. +# Not all of them are supported by Tcl. +set encoding_aliases { + { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII + ISO646-US US-ASCII us IBM367 cp367 csASCII } + { ISO-10646-UTF-1 csISO10646UTF1 } + { ISO_646.basic:1983 ref csISO646basic1983 } + { INVARIANT csINVARIANT } + { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion } + { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom } + { NATS-SEFI iso-ir-8-1 csNATSSEFI } + { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD } + { NATS-DANO iso-ir-9-1 csNATSDANO } + { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD } + { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish } + { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames } + { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 } + { ISO-2022-KR csISO2022KR } + { EUC-KR csEUCKR } + { ISO-2022-JP csISO2022JP } + { ISO-2022-JP-2 csISO2022JP2 } + { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7 + csISO13JISC6220jp } + { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro } + { IT iso-ir-15 ISO646-IT csISO15Italian } + { PT iso-ir-16 ISO646-PT csISO16Portuguese } + { ES iso-ir-17 ISO646-ES csISO17Spanish } + { greek7-old iso-ir-18 csISO18Greek7Old } + { latin-greek iso-ir-19 csISO19LatinGreek } + { DIN_66003 iso-ir-21 de ISO646-DE csISO21German } + { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French } + { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 } + { ISO_5427 iso-ir-37 csISO5427Cyrillic } + { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 } + { BS_viewdata iso-ir-47 csISO47BSViewdata } + { INIS iso-ir-49 csISO49INIS } + { INIS-8 iso-ir-50 csISO50INIS8 } + { INIS-cyrillic iso-ir-51 csISO51INISCyrillic } + { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 } + { ISO_5428:1980 iso-ir-55 csISO5428Greek } + { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 } + { GB_2312-80 iso-ir-58 chinese csISO58GB231280 } + { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian + csISO60Norwegian1 } + { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 } + { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French } + { videotex-suppl iso-ir-70 csISO70VideotexSupp1 } + { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 } + { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 } + { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian } + { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 } + { greek7 iso-ir-88 csISO88Greek7 } + { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 } + { iso-ir-90 csISO90 } + { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a } + { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b + csISO92JISC62991984b } + { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd } + { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand } + { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add + csISO95JIS62291984handadd } + { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana } + { ISO_2033-1983 iso-ir-98 e13b csISO2033 } + { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS } + { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819 + CP819 csISOLatin1 } + { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 } + { T.61-7bit iso-ir-102 csISO102T617bit } + { T.61-8bit T.61 iso-ir-103 csISO103T618bit } + { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 } + { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 } + { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic } + { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 } + { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 } + { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr } + { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708 + arabic csISOLatinArabic } + { ISO_8859-6-E csISO88596E ISO-8859-6-E } + { ISO_8859-6-I csISO88596I ISO-8859-6-I } + { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118 + greek greek8 csISOLatinGreek } + { T.101-G2 iso-ir-128 csISO128T101G2 } + { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew + csISOLatinHebrew } + { ISO_8859-8-E csISO88598E ISO-8859-8-E } + { ISO_8859-8-I csISO88598I ISO-8859-8-I } + { CSN_369103 iso-ir-139 csISO139CSN369103 } + { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 } + { ISO_6937-2-add iso-ir-142 csISOTextComm } + { IEC_P27-1 iso-ir-143 csISO143IECP271 } + { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic + csISOLatinCyrillic } + { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian } + { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian } + { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 } + { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT } + { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba } + { ISO_6937-2-25 iso-ir-152 csISO6937Add } + { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 } + { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp } + { ISO_10367-box iso-ir-155 csISO10367Box } + { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 } + { latin-lap lap iso-ir-158 csISO158Lap } + { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 } + { DS_2089 DS2089 ISO646-DK dk csISO646Danish } + { us-dk csUSDK } + { dk-us csDKUS } + { JIS_X0201 X0201 csHalfWidthKatakana } + { KSC5636 ISO646-KR csKSC5636 } + { ISO-10646-UCS-2 csUnicode } + { ISO-10646-UCS-4 csUCS4 } + { DEC-MCS dec csDECMCS } + { hp-roman8 roman8 r8 csHPRoman8 } + { macintosh mac csMacintosh } + { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl + csIBM037 } + { IBM038 EBCDIC-INT cp038 csIBM038 } + { IBM273 CP273 csIBM273 } + { IBM274 EBCDIC-BE CP274 csIBM274 } + { IBM275 EBCDIC-BR cp275 csIBM275 } + { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 } + { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 } + { IBM280 CP280 ebcdic-cp-it csIBM280 } + { IBM281 EBCDIC-JP-E cp281 csIBM281 } + { IBM284 CP284 ebcdic-cp-es csIBM284 } + { IBM285 CP285 ebcdic-cp-gb csIBM285 } + { IBM290 cp290 EBCDIC-JP-kana csIBM290 } + { IBM297 cp297 ebcdic-cp-fr csIBM297 } + { IBM420 cp420 ebcdic-cp-ar1 csIBM420 } + { IBM423 cp423 ebcdic-cp-gr csIBM423 } + { IBM424 cp424 ebcdic-cp-he csIBM424 } + { IBM437 cp437 437 csPC8CodePage437 } + { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 } + { IBM775 cp775 csPC775Baltic } + { IBM850 cp850 850 csPC850Multilingual } + { IBM851 cp851 851 csIBM851 } + { IBM852 cp852 852 csPCp852 } + { IBM855 cp855 855 csIBM855 } + { IBM857 cp857 857 csIBM857 } + { IBM860 cp860 860 csIBM860 } + { IBM861 cp861 861 cp-is csIBM861 } + { IBM862 cp862 862 csPC862LatinHebrew } + { IBM863 cp863 863 csIBM863 } + { IBM864 cp864 csIBM864 } + { IBM865 cp865 865 csIBM865 } + { IBM866 cp866 866 csIBM866 } + { IBM868 CP868 cp-ar csIBM868 } + { IBM869 cp869 869 cp-gr csIBM869 } + { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 } + { IBM871 CP871 ebcdic-cp-is csIBM871 } + { IBM880 cp880 EBCDIC-Cyrillic csIBM880 } + { IBM891 cp891 csIBM891 } + { IBM903 cp903 csIBM903 } + { IBM904 cp904 904 csIBBM904 } + { IBM905 CP905 ebcdic-cp-tr csIBM905 } + { IBM918 CP918 ebcdic-cp-ar2 csIBM918 } + { IBM1026 CP1026 csIBM1026 } + { EBCDIC-AT-DE csIBMEBCDICATDE } + { EBCDIC-AT-DE-A csEBCDICATDEA } + { EBCDIC-CA-FR csEBCDICCAFR } + { EBCDIC-DK-NO csEBCDICDKNO } + { EBCDIC-DK-NO-A csEBCDICDKNOA } + { EBCDIC-FI-SE csEBCDICFISE } + { EBCDIC-FI-SE-A csEBCDICFISEA } + { EBCDIC-FR csEBCDICFR } + { EBCDIC-IT csEBCDICIT } + { EBCDIC-PT csEBCDICPT } + { EBCDIC-ES csEBCDICES } + { EBCDIC-ES-A csEBCDICESA } + { EBCDIC-ES-S csEBCDICESS } + { EBCDIC-UK csEBCDICUK } + { EBCDIC-US csEBCDICUS } + { UNKNOWN-8BIT csUnknown8BiT } + { MNEMONIC csMnemonic } + { MNEM csMnem } + { VISCII csVISCII } + { VIQR csVIQR } + { KOI8-R csKOI8R } + { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro } + { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro } + { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro } + { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro } + { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro } + { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro } + { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro } + { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro } + { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro } + { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro } + { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro } + { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro } + { IBM1047 IBM-1047 } + { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian } + { Amiga-1251 Ami1251 Amiga1251 Ami-1251 } + { UNICODE-1-1 csUnicode11 } + { CESU-8 csCESU-8 } + { BOCU-1 csBOCU-1 } + { UNICODE-1-1-UTF-7 csUnicode11UTF7 } + { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic + l8 } + { ISO-8859-15 ISO_8859-15 Latin-9 } + { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 } + { GBK CP936 MS936 windows-936 } + { JIS_Encoding csJISEncoding } + { Shift_JIS MS_Kanji csShiftJIS } + { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese + EUC-JP } + { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese } + { ISO-10646-UCS-Basic csUnicodeASCII } + { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 } + { ISO-Unicode-IBM-1261 csUnicodeIBM1261 } + { ISO-Unicode-IBM-1268 csUnicodeIBM1268 } + { ISO-Unicode-IBM-1276 csUnicodeIBM1276 } + { ISO-Unicode-IBM-1264 csUnicodeIBM1264 } + { ISO-Unicode-IBM-1265 csUnicodeIBM1265 } + { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 } + { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 } + { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 } + { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 } + { Adobe-Standard-Encoding csAdobeStandardEncoding } + { Ventura-US csVenturaUS } + { Ventura-International csVenturaInternational } + { PC8-Danish-Norwegian csPC8DanishNorwegian } + { PC8-Turkish csPC8Turkish } + { IBM-Symbols csIBMSymbols } + { IBM-Thai csIBMThai } + { HP-Legal csHPLegal } + { HP-Pi-font csHPPiFont } + { HP-Math8 csHPMath8 } + { Adobe-Symbol-Encoding csHPPSMath } + { HP-DeskTop csHPDesktop } + { Ventura-Math csVenturaMath } + { Microsoft-Publishing csMicrosoftPublishing } + { Windows-31J csWindows31J } + { GB2312 csGB2312 } + { Big5 csBig5 } +} + +proc tcl_encoding {enc} { + global encoding_aliases + set names [encoding names] + set lcnames [string tolower $names] + set enc [string tolower $enc] + set i [lsearch -exact $lcnames $enc] + if {$i < 0} { + # look for "isonnn" instead of "iso-nnn" or "iso_nnn" + if {[regsub {^iso[-_]} $enc iso encx]} { + set i [lsearch -exact $lcnames $encx] + } + } + if {$i < 0} { + foreach l $encoding_aliases { + set ll [string tolower $l] + if {[lsearch -exact $ll $enc] < 0} continue + # look through the aliases for one that tcl knows about + foreach e $ll { + set i [lsearch -exact $lcnames $e] + if {$i < 0} { + if {[regsub {^iso[-_]} $e iso ex]} { + set i [lsearch -exact $lcnames $ex] + } + } + if {$i >= 0} break + } + break + } + } + if {$i >= 0} { + return [lindex $names $i] + } + return {} +} + # defaults... set datemode 0 set diffopts "-U 5 -p" set wrcomcmd "git-diff-tree --stdin -p --pretty" -set gitencoding "" +set gitencoding {} catch { set gitencoding [exec git-repo-config --get i18n.commitencoding] } if {$gitencoding == ""} { - set gitencoding "utf-8" + set gitencoding "utf-8" +} +set tclencoding [tcl_encoding $gitencoding] +if {$tclencoding == {}} { + puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk" } set mainfont {Helvetica 9} set textfont {Courier 9} +set uifont {Helvetica 9 bold} set findmergefiles 0 set maxgraphpct 50 set maxwidth 16 set revlistorder 0 set fastdate 0 +set uparrowlen 7 +set downarrowlen 7 +set mingaplen 30 set colors {green red blue magenta darkgrey brown orange} @@ -3723,21 +3919,28 @@ foreach arg $argv { switch -regexp -- $arg { "^$" { } "^-d" { set datemode 1 } - "^-r" { set revlistorder 1 } default { lappend revtreeargs $arg } } } +# check that we can find a .git directory somewhere... +set gitdir [gitdir] +if {![file isdirectory $gitdir]} { + error_popup "Cannot find the git directory \"$gitdir\"." + exit 1 +} + set history {} set historyindex 0 +set optim_delay 16 + set stopped 0 -set redisplaying 0 set stuffsaved 0 set patchnum 0 setcoords -makewindow +makewindow $revtreeargs readrefs getcommits $revtreeargs