X-Git-Url: https://git.octo.it/?a=blobdiff_plain;f=gitk;h=f4c662423c916dfaabfe14f45a90104944c0dd5c;hb=ac5a85181ac18b0119705f46cfa825389643df33;hp=6a6d4b243593147eaf9d10b23e78a2c1d0c520aa;hpb=df6a6f0e87c44ff6daab7de3fde2237555ae95ac;p=git.git diff --git a/gitk b/gitk index 6a6d4b24..f4c66242 100755 --- a/gitk +++ b/gitk @@ -1,6 +1,6 @@ #!/bin/sh # Tcl ignores the next line -*- tcl -*- \ -exec wish "$0" -- "${1+$@}" +exec wish "$0" -- "$@" # Copyright (C) 2005 Paul Mackerras. All rights reserved. # This program is free software; it may be used, copied, modified @@ -16,53 +16,69 @@ proc gitdir {} { } } -proc getcommits {rargs} { - global commits commfd phase canv mainfont env - global startmsecs nextupdate ncmupdate - global ctext maincursor textcursor leftover +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 0 - 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 $parsed_args" r] - } err] { + return $parsed_args +} + +proc start_rev_list {rlargs} { + global startmsecs nextupdate ncmupdate + global commfd leftover tclencoding + + set startmsecs [clock clicks -milliseconds] + set nextupdate [expr {$startmsecs + 100}] + set ncmupdate 1 + if {[catch { + set commfd [open [concat | git-rev-list --header --topo-order \ + --parents $rlargs] r] + } err]} { puts stderr "Error executing git-rev-list: $err" exit 1 } set leftover {} 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 oldcommits commits phase canv mainfont env + + # 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 oldcommits {} + set commits {} + 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 nchildren - global commitlisted phase commitinfo nextupdate + global oldcommits commits parents cdate children nchildren + global commitlisted phase nextupdate global stopped redisplaying leftover - global numcommits ncmupdate + global canv set stuff [read $commfd] if {$stuff == {}} { @@ -75,9 +91,9 @@ proc getcommitlines {commfd} { } if {[string range $err 0 4] == "usage"} { set err \ -{Gitk: error reading commits: bad arguments to git-rev-list. -(Note: arguments to gitk are passed to git-rev-list -to allow selection of commits to be displayed.)} + "Gitk: error reading commits: bad arguments to git-rev-list.\ + (Note: arguments to gitk are passed to git-rev-list\ + to allow selection of commits to be displayed.)" } else { set err "Error reading commits: $err" } @@ -97,7 +113,19 @@ to allow selection of commits to be displayed.)} set leftover {} } set start [expr {$i + 1}] - if {![regexp {^([0-9a-f]{40})\n} $cmit match id]} { + set j [string first "\n" $cmit] + set ok 0 + if {$j >= 0} { + set ids [string range $cmit 0 [expr {$j - 1}]] + set ok 1 + foreach id $ids { + if {![regexp {^[0-9a-f]{40}$} $id]} { + set ok 0 + break + } + } + } + if {!$ok} { set shortcmit $cmit if {[string length $shortcmit] > 80} { set shortcmit "[string range $shortcmit 0 80]..." @@ -105,15 +133,15 @@ to allow selection of commits to be displayed.)} error_popup "Can't parse git-rev-list output: {$shortcmit}" exit 1 } - set cmit [string range $cmit 41 end] + 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 - drawcommit $id - if {[clock clicks -milliseconds] >= $nextupdate - && $numcommits >= $ncmupdate + 100} { - doupdate - set ncmupdate $numcommits + parsecommit $id $cmit 1 [lrange $ids 1 end] + drawcommit $id 1 + if {[clock clicks -milliseconds] >= $nextupdate} { + doupdate 1 } while {$redisplaying} { set redisplaying 0 @@ -121,12 +149,10 @@ to allow selection of commits to be displayed.)} set stopped 0 set phase "getcommits" foreach id $commits { - drawcommit $id + drawcommit $id 1 if {$stopped} break - if {[clock clicks -milliseconds] >= $nextupdate - && $numcommits >= $ncmupdate + 100} { - doupdate - set ncmupdate $numcommits + if {[clock clicks -milliseconds] >= $nextupdate} { + doupdate 1 } } } @@ -134,22 +160,146 @@ to allow selection of commits to be displayed.)} } } -proc doupdate {} { - global commfd nextupdate +proc doupdate {reading} { + global commfd nextupdate numcommits ncmupdate - incr nextupdate 100 - fileevent $commfd readable {} + if {$reading} { + fileevent $commfd readable {} + } update - fileevent $commfd readable [list getcommitlines $commfd] + set nextupdate [expr {[clock clicks -milliseconds] + 100}] + if {$numcommits < 100} { + set ncmupdate [expr {$numcommits + 1}] + } elseif {$numcommits < 10000} { + set ncmupdate [expr {$numcommits + 10}] + } else { + set ncmupdate [expr {$numcommits + 100}] + } + if {$reading} { + fileevent $commfd readable [list getcommitlines $commfd] + } } 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 updatecommits {rargs} { + global commitlisted commfd phase + global startmsecs nextupdate ncmupdate + global idtags idheads idotherrefs + global leftover + global parsed_args + global canv mainfont + global oldcommits commits + global parents nchildren children ncleft + + set old_args $parsed_args + parse_args $rargs + + if {$phase == "getcommits" || $phase == "incrdraw"} { + # havent read all the old commits, just start again from scratch + stopfindproc + set oldcommits {} + set commits {} + foreach v {children nchildren parents commitlisted commitinfo + selectedline matchinglines treediffs + mergefilelist currentid rowtextx} { + global $v + catch {unset $v} + } + readrefs + if {$phase == "incrdraw"} { + allcanvs delete all + $canv create text 3 3 -anchor nw -text "Reading commits..." \ + -font $mainfont -tags textitems + set phase getcommits + } + start_rev_list $parsed_args + return + } + + foreach id $old_args { + if {![regexp {^[0-9a-f]{40}$} $id]} continue + if {[info exists oldref($id)]} continue + set oldref($id) $id + lappend ignoreold "^$id" + } + foreach id $parsed_args { + if {![regexp {^[0-9a-f]{40}$} $id]} continue + if {[info exists ref($id)]} continue + set ref($id) $id + lappend ignorenew "^$id" + } + + foreach a $old_args { + if {![info exists ref($a)]} { + lappend ignorenew $a + } + } + + set phase updatecommits + set oldcommits $commits + set commits {} + set removed_commits [split [eval exec git-rev-list $ignorenew] "\n" ] + if {[llength $removed_commits] > 0} { + allcanvs delete all + foreach c $removed_commits { + set i [lsearch -exact $oldcommits $c] + if {$i >= 0} { + set oldcommits [lreplace $oldcommits $i $i] + unset commitlisted($c) + foreach p $parents($c) { + if {[info exists nchildren($p)]} { + set j [lsearch -exact $children($p) $c] + if {$j >= 0} { + set children($p) [lreplace $children($p) $j $j] + incr nchildren($p) -1 + } + } + } + } + } + set phase removecommits + } + + set args {} + foreach a $parsed_args { + if {![info exists oldref($a)]} { + lappend args $a + } + } + + readrefs + start_rev_list [concat $ignoreold $args] } -proc parsecommit {id contents listed} { - global commitinfo children nchildren parents nparents cdate ncleft +proc updatechildren {id olds} { + global children nchildren parents nparents ncleft + + 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) + } + } +} + +proc parsecommit {id contents listed olds} { + global commitinfo cdate set inhdr 1 set comment {} @@ -158,113 +308,92 @@ proc parsecommit {id contents listed} { 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) {} - set nparents($id) 0 - foreach line [split $contents "\n"] { - if {$inhdr} { - if {$line == {}} { - set inhdr 0 - } else { - set tag [lindex $line 0] - if {$tag == "parent"} { - set p [lindex $line 1] - if {![info exists nchildren($p)]} { - set children($p) {} - set nchildren($p) 0 - set ncleft($p) 0 - } - lappend parents($id) $p - incr nparents($id) - # sometimes we get a commit that lists a parent twice... - if {$listed && [lsearch -exact $children($p) $id] < 0} { - lappend children($p) $id - incr nchildren($p) - incr ncleft($p) - } - } elseif {$tag == "author"} { - set x [expr {[llength $line] - 2}] - set audate [lindex $line $x] - set auname [lrange $line 1 [expr {$x - 1}]] - } elseif {$tag == "committer"} { - set x [expr {[llength $line] - 2}] - set comdate [lindex $line $x] - set comname [lrange $line 1 [expr {$x - 1}]] - } - } - } else { - if {$comment == {}} { - set headline [string trim $line] - } else { - append comment "\n" - } - if {!$listed} { - # git-rev-list indents the comment by 4 spaces; - # if we got this via git-cat-file, add the indentation - append comment " " - } - append comment $line + updatechildren $id $olds + set hdrend [string first "\n\n" $contents] + if {$hdrend < 0} { + # should never happen... + set hdrend [string length $contents] + } + set header [string range $contents 0 [expr {$hdrend - 1}]] + set comment [string range $contents [expr {$hdrend + 2}] end] + foreach line [split $header "\n"] { + set tag [lindex $line 0] + if {$tag == "author"} { + set audate [lindex $line end-1] + set auname [lrange $line 1 end-2] + } elseif {$tag == "committer"} { + set comdate [lindex $line end-1] + set comname [lrange $line 1 end-2] } } - if {$audate != {}} { - set audate [clock format $audate -format "%Y-%m-%d %H:%M:%S"] + set headline {} + # take the first line of the comment as the headline + set i [string first "\n" $comment] + if {$i >= 0} { + set headline [string trim [string range $comment 0 $i]] + } else { + set headline $comment + } + if {!$listed} { + # git-rev-list indents the comment by 4 spaces; + # if we got this via git-cat-file, add the indentation + set newcomment {} + foreach line [split $comment "\n"] { + append newcomment " " + append newcomment $line + append newcomment "\n" + } + set comment $newcomment } if {$comdate != {}} { set cdate($id) $comdate - set comdate [clock format $comdate -format "%Y-%m-%d %H:%M:%S"] } set commitinfo($id) [list $headline $auname $audate \ $comname $comdate $comment] } proc readrefs {} { - global tagids idtags headids idheads - set tags [glob -nocomplain -types f [gitdir]/refs/tags/*] - foreach f $tags { - catch { - set fd [open $f r] - set line [read $fd] - if {[regexp {^[0-9a-f]{40}} $line id]} { - set direct [file tail $f] - set tagids($direct) $id - lappend idtags($id) $direct - set contents [split [exec git-cat-file tag $id] "\n"] - set obj {} - set type {} - set tag {} - foreach l $contents { - if {$l == {}} break - switch -- [lindex $l 0] { - "object" {set obj [lindex $l 1]} - "type" {set type [lindex $l 1]} - "tag" {set tag [string range $l 4 end]} - } - } - if {$obj != {} && $type == "commit" && $tag != {}} { - set tagids($tag) $obj - lappend idtags($obj) $tag + global tagids idtags headids idheads tagcontents + global otherrefids idotherrefs + + foreach v {tagids idtags headids idheads otherrefids idotherrefs} { + catch {unset $v} + } + set refd [open [list | git-ls-remote [gitdir]] r] + while {0 <= [set n [gets $refd line]]} { + if {![regexp {^([0-9a-f]{40}) refs/([^^]*)$} $line \ + match id path]} { + continue + } + if {![regexp {^(tags|heads)/(.*)$} $path match type name]} { + set type others + set name $path + } + if {$type == "tags"} { + set tagids($name) $id + lappend idtags($id) $name + set obj {} + set type {} + set tag {} + catch { + set commit [exec git-rev-parse "$id^0"] + if {"$commit" != "$id"} { + set tagids($name) $commit + lappend idtags($commit) $name } + } + catch { + set tagcontents($name) [exec git-cat-file tag "$id"] } - close $fd - } - } - set heads [glob -nocomplain -types f [gitdir]/refs/heads/*] - foreach f $heads { - catch { - set fd [open $f r] - set line [read $fd 40] - if {[regexp {^[0-9a-f]{40}} $line id]} { - set head [file tail $f] - set headids($head) $line - lappend idheads($line) $head - } - close $fd + } elseif { $type == "heads" } { + set headids($name) $id + lappend idheads($id) $name + } else { + set otherrefids($name) $id + lappend idotherrefs($id) $name } } + close $refd } proc error_popup msg { @@ -279,27 +408,32 @@ proc error_popup msg { tkwait window $w } -proc makewindow {} { +proc makewindow {rargs} { global canv canv2 canv3 linespc charspc ctext cflist textfont global findtype findtypemenu findloc findstring fstring geometry global entries sha1entry sha1string sha1but global maincursor textcursor curtextcursor - global rowctxmenu gaudydiff mergemax + global rowctxmenu mergemax menu .bar .bar add cascade -label "File" -menu .bar.file 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 + menu .bar.edit + .bar add cascade -label "Edit" -menu .bar.edit + .bar.edit add command -label "Preferences" -command doprefs menu .bar.help .bar add cascade -label "Help" -menu .bar.help .bar.help add command -label "About gitk" -command about . configure -menu .bar if {![info exists geometry(canv1)]} { - set geometry(canv1) [expr 45 * $charspc] - set geometry(canv2) [expr 30 * $charspc] - set geometry(canv3) [expr 15 * $charspc] - set geometry(canvh) [expr 25 * $linespc + 4] + set geometry(canv1) [expr {45 * $charspc}] + set geometry(canv2) [expr {30 * $charspc}] + set geometry(canv3) [expr {15 * $charspc}] + set geometry(canvh) [expr {25 * $linespc + 4}] set geometry(ctextw) 80 set geometry(ctexth) 30 set geometry(cflistw) 30 @@ -400,25 +534,30 @@ proc makewindow {} { .ctop.cdet add .ctop.cdet.left $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa" - if {$gaudydiff} { - $ctext tag conf hunksep -back blue -fore white - $ctext tag conf d0 -back "#ff8080" - $ctext tag conf d1 -back green - } else { - $ctext tag conf hunksep -fore blue - $ctext tag conf d0 -fore red - $ctext tag conf d1 -fore "#00a000" - $ctext tag conf m0 -fore red - $ctext tag conf m1 -fore blue - $ctext tag conf m2 -fore green - $ctext tag conf m3 -fore purple - $ctext tag conf m4 -fore brown - $ctext tag conf mmax -fore darkgrey - set mergemax 5 - $ctext tag conf mresult -font [concat $textfont bold] - $ctext tag conf msep -font [concat $textfont bold] - $ctext tag conf found -back yellow - } + $ctext tag conf hunksep -fore blue + $ctext tag conf d0 -fore red + $ctext tag conf d1 -fore "#00a000" + $ctext tag conf m0 -fore red + $ctext tag conf m1 -fore blue + $ctext tag conf m2 -fore green + $ctext tag conf m3 -fore purple + $ctext tag conf m4 -fore brown + $ctext tag conf m5 -fore "#009090" + $ctext tag conf m6 -fore magenta + $ctext tag conf m7 -fore "#808000" + $ctext tag conf m8 -fore "#009000" + $ctext tag conf m9 -fore "#ff0080" + $ctext tag conf m10 -fore cyan + $ctext tag conf m11 -fore "#b07070" + $ctext tag conf m12 -fore "#70b0f0" + $ctext tag conf m13 -fore "#70f0b0" + $ctext tag conf m14 -fore "#f0b070" + $ctext tag conf m15 -fore "#ff70b0" + $ctext tag conf mmax -fore darkgrey + set mergemax 16 + $ctext tag conf mresult -font [concat $textfont bold] + $ctext tag conf msep -font [concat $textfont bold] + $ctext tag conf found -back yellow frame .ctop.cdet.right set cflist .ctop.cdet.right.cfiles @@ -440,6 +579,8 @@ proc makewindow {} { bindall "allcanvs scan dragto 0 %y" bind . "selnextline -1" bind . "selnextline 1" + bind . "goforw" + bind . "goback" bind . "allcanvs yview scroll -1 pages" bind . "allcanvs yview scroll 1 pages" bindkey "$ctext yview scroll -1 pages" @@ -447,6 +588,12 @@ proc makewindow {} { bindkey "$ctext yview scroll 1 pages" bindkey p "selnextline -1" bindkey n "selnextline 1" + bindkey z "goback" + bindkey x "goforw" + bindkey i "selnextline -1" + bindkey k "selnextline 1" + bindkey j "goback" + bindkey l "goforw" bindkey b "$ctext yview scroll -1 pages" bindkey d "$ctext yview scroll 18 units" bindkey u "$ctext yview scroll -18 units" @@ -511,7 +658,8 @@ proc click {w} { proc savestuff {w} { global canv canv2 canv3 ctext cflist mainfont textfont - global stuffsaved findmergefiles gaudydiff maxgraphpct + global stuffsaved findmergefiles maxgraphpct + global maxwidth if {$stuffsaved} return if {![winfo viewable .]} return @@ -520,14 +668,14 @@ proc savestuff {w} { puts $f [list set mainfont $mainfont] puts $f [list set textfont $textfont] puts $f [list set findmergefiles $findmergefiles] - puts $f [list set gaudydiff $gaudydiff] puts $f [list set maxgraphpct $maxgraphpct] + puts $f [list set maxwidth $maxwidth] puts $f "set geometry(width) [winfo width .ctop]" puts $f "set geometry(height) [winfo height .ctop]" - puts $f "set geometry(canv1) [expr [winfo width $canv]-2]" - puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]" - puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]" - puts $f "set geometry(canvh) [expr [winfo height $canv]-2]" + puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]" + puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]" + puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]" + puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]" set wid [expr {([winfo width $ctext] - 8) \ / [font measure $textfont "0"]}] puts $f "set geometry(ctextw) $wid" @@ -542,7 +690,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} { @@ -556,12 +704,12 @@ proc resizeclistpanes {win w} { set sash0 30 } if {$sash1 < $sash0 + 20} { - set sash1 [expr $sash0 + 20] + set sash1 [expr {$sash0 + 20}] } if {$sash1 > $w - 10} { - set sash1 [expr $w - 10] + set sash1 [expr {$w - 10}] if {$sash0 > $sash1 - 20} { - set sash0 [expr $sash1 - 20] + set sash0 [expr {$sash1 - 20}] } } } @@ -573,7 +721,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)}] @@ -584,7 +732,7 @@ proc resizecdetpanes {win w} { set sash0 45 } if {$sash0 > $w - 15} { - set sash0 [expr $w - 15] + set sash0 [expr {$w - 15}] } } $win sash place 0 $sash0 [lindex $s0 1] @@ -627,11 +775,11 @@ Use and redistribute under the terms of the GNU General Public License} \ } proc assigncolor {id} { - global commitinfo colormap commcolors colors nextcolor + global colormap commcolors colors nextcolor global parents nparents children nchildren 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] @@ -698,21 +846,25 @@ proc assigncolor {id} { } proc initgraph {} { - global canvy canvy0 lineno numcommits lthickness nextcolor linespc - global mainline sidelines + global canvy canvy0 lineno numcommits nextcolor linespc global nchildren ncleft + global displist nhyperspace allcanvs delete all set nextcolor 0 set canvy $canvy0 set lineno -1 set numcommits 0 - set lthickness [expr {int($linespc / 9) + 1}] - catch {unset mainline} - catch {unset sidelines} + foreach v {mainline mainlinearrow sidelines colormap cornercrossings + crossings idline lineid} { + global $v + catch {unset $v} + } foreach id [array names nchildren] { set ncleft($id) $nchildren($id) } + set displist {} + set nhyperspace 0 } proc bindline {t id} { @@ -724,19 +876,49 @@ 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 nchildren todo + 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 oldlevel oldnlines oldtodo - global idtags idline idheads - global lineno lthickness mainline sidelines - global commitlisted rowtextx idpos + 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 $todo $level] + 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"}] @@ -762,44 +944,36 @@ proc drawcommitline {level} { } set x [xcoord $level $level $lineno] set y1 $canvy - set canvy [expr $canvy + $linespc] + set canvy [expr {$canvy + $linespc}] allcanvs conf -scrollregion \ - [list 0 0 0 [expr $y1 + 0.5 * $linespc + 2]] + [list 0 0 0 [expr {$y1 + 0.5 * $linespc + 2}]] if {[info exists mainline($id)]} { lappend mainline($id) $x $y1 - set t [$canv create line $mainline($id) \ - -width $lthickness -fill $colormap($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 t [$canv create line $coords -fill $colormap($id) \ - -width [expr {$thick * $lthickness}]] - $canv lower $t - bindline $t $id + 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] \ + 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 $todo] $level $lineno] + 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)]} { + 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" @@ -807,29 +981,38 @@ proc drawcommitline {level} { -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 + global idtags idheads idotherrefs global linespc lthickness - global canv mainfont + global canv mainfont idline rowtextx set marks {} set ntags 0 + set nheads 0 if {[info exists idtags($id)]} { set marks $idtags($id) set ntags [llength $marks] } if {[info exists idheads($id)]} { set marks [concat $marks $idheads($id)] + set nheads [llength $idheads($id)] + } + if {[info exists idotherrefs($id)]} { + set marks [concat $marks $idotherrefs($id)] } if {$marks eq {}} { return $xt } set delta [expr {int(0.5 * ($linespc - $lthickness))}] - set yt [expr $y1 - 0.5 * $linespc] - set yb [expr $yt + $linespc - 1] + set yt [expr {$y1 - 0.5 * $linespc}] + set yb [expr {$yt + $linespc - 1}] set xvals {} set wvals {} foreach tag $marks { @@ -842,65 +1025,40 @@ proc drawtags {id x xt y1} { -width $lthickness -fill black -tags tag.$id] $canv lower $t foreach tag $marks x $xvals wid $wvals { - set xl [expr $x + $delta] - set xr [expr $x + $delta + $wid + $lthickness] + set xl [expr {$x + $delta}] + set xr [expr {$x + $delta + $wid + $lthickness}] if {[incr ntags -1] >= 0} { # draw a tag - $canv create polygon $x [expr $yt + $delta] $xl $yt\ - $xr $yt $xr $yb $xl $yb $x [expr $yb - $delta] \ - -width 1 -outline black -fill yellow -tags tag.$id + set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \ + $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}] } else { - # draw a head - set xl [expr $xl - $delta/2] + # draw a head or other ref + if {[incr nheads -1] >= 0} { + set col green + } else { + set col "#ddddff" + } + set xl [expr {$xl - $delta/2}] $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \ - -width 1 -outline black -fill green -tags tag.$id - } - $canv create text $xl $y1 -anchor w -text $tag \ - -font $mainfont -tags tag.$id - } - return $xt -} - -proc updatetodo {level noshortcut} { - global currentparents ncleft todo - global mainline oldlevel oldtodo oldnlines - global canvy linespc mainline - global commitinfo lineno xspc1 - - set oldlevel $level - set oldtodo $todo - set oldnlines [llength $todo] - if {!$noshortcut && [llength $currentparents] == 1} { - set p [lindex $currentparents 0] - if {$ncleft($p) == 1 && [lsearch -exact $todo $p] < 0} { - set ncleft($p) 0 - set x [xcoord $level $level $lineno] - set y [expr $canvy - $linespc] - set mainline($p) [list $x $y] - set todo [lreplace $todo $level $level $p] - set xspc1([expr {$lineno + 1}]) $xspc1($lineno) - return 0 + -width 1 -outline black -fill $col -tags tag.$id } - } - - set todo [lreplace $todo $level $level] - set i $level - foreach p $currentparents { - incr ncleft($p) -1 - set k [lsearch -exact $todo $p] - if {$k < 0} { - set todo [linsert $todo $i $p] - incr i + set t [$canv create text $xl $y1 -anchor w -text $tag \ + -font $mainfont -tags tag.$id] + if {$ntags >= 0} { + $canv bind $t <1> [list showtag $tag 1] } } - return 1 + return $xt } proc notecrossings {id lo hi corner} { - global oldtodo crossings cornercrossings + global olddisplist crossings cornercrossings for {set i $lo} {[incr i] < $hi} {} { - set p [lindex $oldtodo $i] + set p [lindex $olddisplist $i] if {$p == {}} continue if {$i == $corner} { if {![info exists cornercrossings($id)] @@ -936,37 +1094,219 @@ proc xcoord {i level ln} { return $x } -proc drawslants {level} { - global canv mainline sidelines canvx0 canvy xspc1 xspc2 lthickness - global oldlevel oldtodo todo currentparents dupparents +# 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 + 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}] - set n [llength $todo] - if {$n <= 1 || $canvx0 + $n * $xspc2 <= $maxw} { + if {$displ <= 1 || $canvx0 + $displ * $xspc2 <= $maxw} { set xspc1($lj) $xspc2 } else { - set xspc1($lj) [expr {($maxw - $canvx0 - $xspc2) / ($n - 1)}] + set xspc1($lj) [expr {($maxw - $canvx0 - $xspc2) / ($displ - 1)}] if {$xspc1($lj) < $lthickness} { set xspc1($lj) $lthickness } } - - set y1 [expr $canvy - $linespc] - set y2 $canvy + + 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 $oldtodo { + foreach id $olddisplist { incr i if {$id == {}} continue - set xi [xcoord $i $oldlevel $lineno] - if {$i == $oldlevel} { + if {$onscreen($id) <= 0} continue + set xi [xcoord $i $olddlevel $lineno] + if {$i == $olddlevel} { foreach p $currentparents { - set j [lsearch -exact $todo $p] + set j [lsearch -exact $displist $p] set coords [list $xi $y1] - set xj [xcoord $j $level $lj] + set xj [xcoord $j $dlevel $lj] if {$xj < $xi - $linespc} { lappend coords [expr {$xj + $linespc}] $y1 notecrossings $p $j $i [expr {$j + 1}] @@ -977,9 +1317,10 @@ proc drawslants {level} { 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] + 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 @@ -993,48 +1334,175 @@ proc drawslants {level} { 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] + lappend sidelines($p) [list $coords 1 none] } } } } else { set j $i - if {[lindex $todo $i] != $id} { - set j [lsearch -exact $todo $id] + if {[lindex $displist $i] != $id} { + set j [lsearch -exact $displist $id] } if {$j != $i || $xspc1($lineno) != $xspc1($lj) - || ($oldlevel <= $i && $i <= $level) - || ($level <= $i && $i <= $oldlevel)} { - set xj [xcoord $j $level $lj] - set dx [expr {abs($xi - $xj)}] - set yb $y2 - if {0 && $dx < $linespc} { - set yb [expr {$y1 + $dx}] + || ($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 } - lappend mainline($id) $xi $y1 $xj $yb } } + + 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 parents children nchildren ncleft todo - global canv canv2 canv3 mainfont namefont canvy linespc + global ncleft todo global datemode cdate global commitinfo - global currentparents oldlevel oldnlines oldtodo - global lineno lthickness - - # remove the null entry if present - set nullentry [lsearch -exact $todo {}] - if {$nullentry >= 0} { - set todo [lreplace $todo $nullentry $nullentry] - } # choose which one to do next time around set todol [llength $todo] @@ -1060,95 +1528,75 @@ proc decidenext {{noread 0}} { } } } - 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 - } - # If we are reducing, put in a null entry - if {$todol < $oldnlines} { - if {$nullentry >= 0} { - set i $nullentry - while {$i < $todol - && [lindex $oldtodo $i] == [lindex $todo $i]} { - incr i - } - } else { - set i $oldlevel - if {$level >= $i} { - incr i - } - } - if {$i < $todol} { - set todo [linsert $todo $i {}] - if {$level >= $i} { - incr level - } - } - } return $level } -proc drawcommit {id} { - global phase todo nchildren datemode nextupdate - global startcommits numcommits ncmupdate +proc drawcommit {id reading} { + global phase todo nchildren datemode nextupdate revlistorder ncleft + global numcommits ncmupdate displayorder todo onscreen parents + global commitlisted commitordered if {$phase != "incrdraw"} { set phase incrdraw - set todo $id - set startcommits $id + set displayorder {} + set todo {} initgraph - drawcommitline 0 - updatetodo 0 $datemode - } else { - if {$nchildren($id) == 0} { - lappend todo $id - lappend startcommits $id - } - set level [decidenext 1] - if {$level == {} || $id != [lindex $todo $level]} { + catch {unset commitordered} + } + set commitordered($id) 1 + 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 == {} || $level < 0} return while 1 { - drawslants $level - drawcommitline $level - if {[updatetodo $level $datemode]} { - set level [decidenext 1] - if {$level == {}} break - } set id [lindex $todo $level] - if {![info exists commitlisted($id)]} { + if {![info exists commitordered($id)]} { break } - if {[clock clicks -milliseconds] >= $nextupdate - && $numcommits >= $ncmupdate} { - doupdate - set ncmupdate $numcommits - if {$stopped} break + lappend displayorder [lindex $todo $level] + if {[updatetodo $level $datemode]} { + set level [decidenext 1] + if {$level == {} || $level < 0} break } } } + drawmore $reading } proc finishcommits {} { - global phase - global startcommits + global phase oldcommits commits global canv mainfont ctext maincursor textcursor - - if {$phase != "incrdraw"} { + global parents displayorder todo + + if {$phase == "incrdraw" || $phase == "removecommits"} { + foreach id $oldcommits { + lappend commits $id + drawcommit $id 0 + } + set oldcommits {} + drawrest + } elseif {$phase == "updatecommits"} { + # there were no new commits, in fact + set commits $oldcommits + set oldcommits {} + set phase {} + } else { $canv delete all $canv create text 3 3 -anchor nw -text "No commits selected" \ -font $mainfont -tags textitems set phase {} - } else { - set level [decidenext] - drawslants $level - drawrest $level [llength $startcommits] } . config -cursor $maincursor settextcursor $textcursor @@ -1166,59 +1614,48 @@ proc settextcursor {c} { } proc drawgraph {} { - global nextupdate startmsecs startcommits todo ncmupdate + global nextupdate startmsecs ncmupdate + global displayorder onscreen - if {$startcommits == {}} return + if {$displayorder == {}} return set startmsecs [clock clicks -milliseconds] - set nextupdate [expr $startmsecs + 100] - set ncmupdate 0 + set nextupdate [expr {$startmsecs + 100}] + set ncmupdate 1 initgraph - set todo [lindex $startcommits 0] - drawrest 0 1 + foreach id $displayorder { + set onscreen($id) 0 + } + drawmore 0 } -proc drawrest {level startix} { +proc drawrest {} { global phase stopped redisplaying selectedline - global datemode currentparents todo + global datemode todo displayorder ncleft global numcommits ncmupdate - global nextupdate startmsecs startcommits idline + global nextupdate startmsecs revlistorder + set level [decidenext] if {$level >= 0} { set phase drawgraph - set startid [lindex $startcommits $startix] - set startline -1 - if {$startid != {}} { - set startline $idline($startid) - } while 1 { - if {$stopped} break - drawcommitline $level + lappend displayorder [lindex $todo $level] set hard [updatetodo $level $datemode] - if {$numcommits == $startline} { - lappend todo $startid - set hard 1 - incr startix - set startid [lindex $startcommits $startix] - set startline -1 - if {$startid != {}} { - set startline $idline($startid) - } - } if {$hard} { set level [decidenext] if {$level < 0} break - drawslants $level - } - if {[clock clicks -milliseconds] >= $nextupdate - && $numcommits >= $ncmupdate + 100} { - update - incr nextupdate 100 - set ncmupdate $numcommits } } } + if {$todo != {}} { + puts "ERROR: none of the pending commits can be done yet:" + foreach p $todo { + puts " $p ($ncleft($p))" + } + } + + drawmore 0 set phase {} - set drawmsecs [expr [clock clicks -milliseconds] - $startmsecs] + set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}] #puts "overall $drawmsecs ms for $numcommits commits" if {$redisplaying} { if {$stopped == 0 && [info exists selectedline]} { @@ -1246,8 +1683,8 @@ proc findmatches {f} { set matches {} set i 0 while {[set j [string first $foundstring $str $i]] >= 0} { - lappend matches [list $j [expr $j+$foundstrlen-1]] - set i [expr $j + $foundstrlen] + lappend matches [list $j [expr {$j+$foundstrlen-1}]] + set i [expr {$j + $foundstrlen}] } } return $matches @@ -1328,7 +1765,7 @@ proc findselectline {l} { set matches [findmatches $f] foreach match $matches { set start [lindex $match 0] - set end [expr [lindex $match 1] + 1] + set end [expr {[lindex $match 1] + 1}] $ctext tag add found "1.0 + $start c" "1.0 + $end c" } } @@ -1499,7 +1936,7 @@ proc findfiles {} { global selectedline numcommits lineid ctext global ffileline finddidsel parents nparents global findinprogress findstartline findinsertpos - global treediffs fdiffids fdiffsneeded fdiffpos + global treediffs fdiffid fdiffsneeded fdiffpos global findmergefiles if {$numcommits == 0} return @@ -1515,12 +1952,10 @@ proc findfiles {} { 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] - } + if {$findmergefiles || $nparents($id) == 1} { + if {![info exists treediffs($id)]} { + append diffsneeded "$id\n" + lappend fdiffsneeded $id } } if {[incr l] >= $numcommits} { @@ -1537,7 +1972,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] @@ -1546,16 +1981,15 @@ proc findfiles {} { set finddidsel 0 set findinsertpos end set id $lineid($l) - set p [lindex $parents($id) 0] . config -cursor watch settextcursor watch set findinprogress 1 - findcont [list $id $p] + findcont $id update } proc readfilediffs {df} { - global findids fdiffids fdiffs + global findid fdiffid fdiffs set n [gets $df line] if {$n < 0} { @@ -1565,19 +1999,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] @@ -1585,53 +2019,50 @@ 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 $nullid } 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 $fdiffid } } } -proc findcont {ids} { - global findids treediffs parents nparents +proc findcont {id} { + global findid treediffs parents nparents global ffileline findstartline finddidsel global lineid 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 + 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 @@ -1640,21 +2071,13 @@ 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 + set id $lineid($l) } stopfindproc if {!$finddidsel} { @@ -1682,9 +2105,10 @@ proc markmatches {canv l str tag matches font} { set start [lindex $match 0] set end [lindex $match 1] if {$start > $end} continue - set xoff [font measure $font [string range $str 0 [expr $start-1]]] - set xlen [font measure $font [string range $str 0 [expr $end]]] - set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \ + set xoff [font measure $font [string range $str 0 [expr {$start-1}]]] + set xlen [font measure $font [string range $str 0 [expr {$end}]]] + set t [$canv create rect [expr {$x0+$xoff}] $y0 \ + [expr {$x0+$xlen+2}] $y1 \ -outline {} -tags matches -fill yellow] $canv lower $t } @@ -1724,14 +2148,41 @@ proc commit_descriptor {p} { return "$p ($l)" } +# 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 + + set start [$ctext index "end - 1c"] + $ctext insert end $text + $ctext insert end "\n" + set links [regexp -indices -all -inline {[0-9a-f]{40}} $text] + foreach l $links { + set s [lindex $l 0] + set e [lindex $l 1] + set linkid [string range $text $s $e] + if {![info exists idline($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] + incr linknum + } + $ctext tag conf link -foreground blue -underline 1 + $ctext tag bind link { %W configure -cursor hand2 } + $ctext tag bind link { %W configure -cursor $curtextcursor } +} + proc selectline {l isnew} { global canv canv2 canv3 ctext commitinfo selectedline global lineid linehtag linentag linedtag - global canvy0 linespc parents nparents children nchildren + global canvy0 linespc parents nparents children global cflist currentid sha1entry - global commentend idtags idline + global commentend idtags idline linknum + global mergemax $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 {{}} \ @@ -1750,8 +2201,8 @@ proc selectline {l isnew} { set ytop [expr {$y - $linespc - 1}] set ybot [expr {$y + $linespc + 1}] set wnow [$canv yview] - set wtop [expr [lindex $wnow 0] * $ymax] - set wbot [expr [lindex $wnow 1] * $ymax] + set wtop [expr {[lindex $wnow 0] * $ymax}] + set wbot [expr {[lindex $wnow 1] * $ymax}] set wh [expr {$wbot - $wtop}] set newtop $wtop if {$ytop < $wtop} { @@ -1777,7 +2228,7 @@ proc selectline {l isnew} { if {$newtop < 0} { set newtop 0 } - allcanvs yview moveto [expr $newtop * 1.0 / $ymax] + allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}] } if {$isnew} { @@ -1795,11 +2246,14 @@ proc selectline {l isnew} { $ctext conf -state normal $ctext delete 0.0 end + set linknum 0 $ctext mark set fmark.0 0.0 $ctext mark gravity fmark.0 left set info $commitinfo($id) - $ctext insert end "Author: [lindex $info 1] [lindex $info 2]\n" - $ctext insert end "Committer: [lindex $info 3] [lindex $info 4]\n" + set date [formatdate [lindex $info 2]] + $ctext insert end "Author: [lindex $info 1] $date\n" + set date [formatdate [lindex $info 4]] + $ctext insert end "Committer: [lindex $info 3] $date\n" if {[info exists idtags($id)]} { $ctext insert end "Tags:" foreach tag $idtags($id) { @@ -1808,13 +2262,27 @@ proc selectline {l isnew} { $ctext insert end "\n" } - set commentstart [$ctext index "end - 1c"] set comment {} - if {[info exists parents($id)]} { + if {$nparents($id) > 1} { + set np 0 foreach p $parents($id) { - append comment "Parent: [commit_descriptor $p]\n" + if {$np >= $mergemax} { + set tag mmax + } else { + set tag m$np + } + $ctext insert end "Parent: " $tag + appendwithlinks [commit_descriptor $p] + incr np + } + } else { + if {[info exists parents($id)]} { + foreach p $parents($id) { + append comment "Parent: [commit_descriptor $p]\n" + } } } + if {[info exists children($id)]} { foreach c $children($id) { append comment "Child: [commit_descriptor $c]\n" @@ -1822,26 +2290,9 @@ proc selectline {l isnew} { } append comment "\n" append comment [lindex $info 5] - $ctext insert end $comment - $ctext insert end "\n" # make anything that looks like a SHA1 ID be a clickable link - set links [regexp -indices -all -inline {[0-9a-f]{40}} $comment] - set i 0 - foreach l $links { - set s [lindex $l 0] - set e [lindex $l 1] - set linkid [string range $comment $s $e] - if {![info exists idline($linkid)]} continue - incr e - $ctext tag add link "$commentstart + $s c" "$commentstart + $e c" - $ctext tag add link$i "$commentstart + $s c" "$commentstart + $e c" - $ctext tag bind link$i <1> [list selectline $idline($linkid) 1] - incr i - } - $ctext tag conf link -foreground blue -underline 1 - $ctext tag bind link { %W configure -cursor hand2 } - $ctext tag bind link { %W configure -cursor $curtextcursor } + appendwithlinks $comment $ctext tag delete Comments $ctext tag remove found 1.0 end @@ -1851,7 +2302,7 @@ proc selectline {l isnew} { $cflist delete 0 end $cflist insert end "Comments" if {$nparents($id) == 1} { - startdiff [concat $id $parents($id)] + startdiff $id } elseif {$nparents($id) > 1} { mergediff $id } @@ -1860,7 +2311,7 @@ proc selectline {l isnew} { proc selnextline {dir} { global selectedline if {![info exists selectedline]} return - set l [expr $selectedline + $dir] + set l [expr {$selectedline + $dir}] unmarkmatches selectline $l 1 } @@ -1923,529 +2374,100 @@ proc goforw {} { } proc mergediff {id} { - global parents diffmergeid diffmergegca mergefilelist diffpindex + global parents diffmergeid diffopts mdifffd + global difffilestart 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 0] == $diffmergeid && $diffmergegca ne {}} { - set ids [list [lindex $ids 1] $diffmergegca] - } else { - if {[incr diffpindex] >= $nparents($diffmergeid)} break - set p [lindex $parents($diffmergeid) $diffpindex] - set ids [list $diffmergeid $p] - } - 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 $p $diffmergegca]) - foreach f $treediffs([list $diffmergeid $p]) { - 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 $diffmergeid $p]) - 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 - } + 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 + fileevent $mdf readable [list getmergediffline $mdf $id] + 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} { + global diffmergeid ctext cflist nextupdate nparents mergemax + global difffilestart - 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} { + 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 np $nparents($id) + 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 isbad 1 + break } } - 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 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] } - for {} {$l < $endl} {incr l} { - $ctext insert end "+$filelines($id,$f,$l)\n" $ncol + if {$num ne {}} { + if {$num >= $mergemax} { + set num "max" + } + lappend tags m$num } - } - while {$l < $grouplineend} { - $ctext insert end " $filelines($id,$f,$l)\n" - incr l + $ctext insert end "$line\n" $tags } $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 nl [lindex $e 1] - for {} {$l < $nl} {incr l} { - incr diff [string length $filelines($id,$f,$l)] - incr diff - } - } - for {} {$l < $endl} {incr l} { - incr same [string length $filelines($id,$f,$l)] - incr same - } - if {$same == 0} { - return 0 + if {[clock clicks -milliseconds] >= $nextupdate} { + incr nextupdate 100 + fileevent $mdf readable {} + update + fileevent $mdf readable [list getmergediffline $mdf $id] } - return [expr {200 * $same / (2 * $same + $diff)}] } proc startdiff {ids} { @@ -2474,9 +2496,9 @@ proc gettreediffs {ids} { global treediff parents treepending set treepending $ids set treediff {} - set id [lindex $ids 0] - set p [lindex $ids 1] - if [catch {set gdtf [open "|git-diff-tree -r $p $id" 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] } @@ -2509,10 +2531,8 @@ proc getblobdiffs {ids} { global diffopts blobdifffd diffids env curdifftag curtagstart global difffilestart nextupdate diffinhdr treediffs - set id [lindex $ids 0] - set p [lindex $ids 1] set env(GIT_DIFF_OPTS) $diffopts - set cmd [list | git-diff-tree -r -p -C $p $id] + set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids] if {[catch {set bdf [open $cmd r]} err]} { puts "error getting diffs: $err" return @@ -2531,7 +2551,6 @@ proc getblobdiffline {bdf ids} { global diffids blobdifffd ctext curdifftag curtagstart global diffnexthead diffnextnote difffilestart global nextupdate diffinhdr treediffs - global gaudydiff set n [gets $bdf line] if {$n < 0} { @@ -2580,26 +2599,14 @@ proc getblobdiffline {bdf ids} { set diffinhdr 0 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \ $line match f1l f1c f2l f2c rest]} { - if {$gaudydiff} { - $ctext insert end "\t" hunksep - $ctext insert end " $f1l " d0 " $f2l " d1 - $ctext insert end " $rest \n" hunksep - } else { - $ctext insert end "$line\n" hunksep - } + $ctext insert end "$line\n" hunksep set diffinhdr 0 } else { set x [string range $line 0 0] if {$x == "-" || $x == "+"} { set tag [expr {$x == "+"}] - if {$gaudydiff} { - set line [string range $line 1 end] - } $ctext insert end "$line\n" d$tag } elseif {$x == " "} { - if {$gaudydiff} { - set line [string range $line 1 end] - } $ctext insert end "$line\n" } elseif {$diffinhdr || $x == "\\"} { # e.g. "\ No newline at end of file" @@ -2651,12 +2658,13 @@ proc listboxsel {} { proc setcoords {} { global linespc charspc canvx0 canvy0 mainfont - global xspc1 xspc2 + global xspc1 xspc2 lthickness 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 {3 + 0.5 * $linespc}] + set canvx0 [expr {3 + 0.5 * $linespc}] + set lthickness [expr {int($linespc / 9) + 1}] set xspc1(0) $linespc set xspc2 $linespc } @@ -2812,19 +2820,108 @@ proc linehover {} { set t [$canv create rectangle $x0 $y0 $x1 $y1 \ -fill \#ffff80 -outline black -width 1 -tags hover] $canv raise $t - set t [$canv create text $x $y -anchor nw -text $text -tags hover] + set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont] $canv raise $t } +proc clickisonarrow {id y} { + global mainline mainlinearrow sidelines lthickness + + 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" + } + } + } + } + return {} +} + +proc arrowjump {id dirn y} { + global mainline sidelines canv canv2 canv3 + + 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 + set ymax [lindex [$canv cget -scrollregion] 3] + if {$ymax eq {} || $ymax <= 0} return + set view [$canv yview] + set yspan [expr {[lindex $view 1] - [lindex $view 0]}] + set yfrac [expr {$yt / $ymax - $yspan / 2}] + if {$yfrac < 0} { + set yfrac 0 + } + $canv yview moveto $yfrac + $canv2 yview moveto $yfrac + $canv3 yview moveto $yfrac +} + proc lineclick {x y id isnew} { - global ctext commitinfo children cflist canv + global ctext commitinfo children cflist canv thickerline unmarkmatches unselectline + normalline + $canv delete hover + # draw this line thicker than normal + drawlines $id 1 1 + set thickerline $id if {$isnew} { - addtohistory [list lineclick $x $x $id 0] + set ymax [lindex [$canv cget -scrollregion] 3] + if {$ymax eq {}} return + set yfrac [lindex [$canv yview] 0] + set y [expr {$y + $yfrac * $ymax}] + } + set dirn [clickisonarrow $id $y] + if {$dirn ne {}} { + arrowjump $id $dirn $y + return + } + + if {$isnew} { + addtohistory [list lineclick $x $y $id 0] } - $canv delete hover # fill the details pane with info about this line $ctext conf -state normal $ctext delete 0.0 end @@ -2837,7 +2934,8 @@ proc lineclick {x y id isnew} { set info $commitinfo($id) $ctext insert end "\n\t[lindex $info 0]\n" $ctext insert end "\tAuthor:\t[lindex $info 1]\n" - $ctext insert end "\tDate:\t[lindex $info 2]\n" + set date [formatdate [lindex $info 2]] + $ctext insert end "\tDate:\t$date\n" if {[info exists children($id)]} { $ctext insert end "\nChildren:" set i 0 @@ -2849,7 +2947,8 @@ proc lineclick {x y id isnew} { $ctext tag bind link$i <1> [list selbyid $child] $ctext insert end "\n\t[lindex $info 0]" $ctext insert end "\n\tAuthor:\t[lindex $info 1]" - $ctext insert end "\n\tDate:\t[lindex $info 2]\n" + set date [formatdate [lindex $info 2]] + $ctext insert end "\n\tDate:\t$date\n" } } $ctext conf -state disabled @@ -2857,6 +2956,14 @@ proc lineclick {x y id isnew} { $cflist delete 0 end } +proc normalline {} { + global thickerline + if {[info exists thickerline]} { + drawlines $thickerline 0 1 + unset thickerline + } +} + proc selbyid {id} { global idline if {[info exists idline($id)]} { @@ -2929,7 +3036,7 @@ proc doseldiff {oldid newid} { $ctext conf -state disabled $ctext tag delete Comments $ctext tag remove found 1.0 end - startdiff [list $newid $oldid] + startdiff [list $oldid $newid] } proc mkpatch {} { @@ -3050,7 +3157,6 @@ proc mktag {} { proc domktag {} { global mktagtop env tagids idtags - global idpos idline linehtag canv selectedline set id [$mktagtop.sha1 get] set tag [$mktagtop.tag get] @@ -3075,6 +3181,13 @@ proc domktag {} { set tagids($tag) $id lappend idtags($id) $tag + redrawtags $id +} + +proc redrawtags {id} { + global canv linehtag idline idpos selectedline + + if {![info exists idline($id)]} return $canv delete tag.$id set xt [eval drawtags $id $idpos($id)] $canv coords $linehtag($idline($id)) $xt [lindex $idpos($id) 2] @@ -3150,39 +3263,455 @@ proc wrcomcan {} { unset wrcomtop } +proc listrefs {id} { + global idtags idheads idotherrefs + + set x {} + if {[info exists idtags($id)]} { + set x $idtags($id) + } + set y {} + if {[info exists idheads($id)]} { + set y $idheads($id) + } + set z {} + if {[info exists idotherrefs($id)]} { + set z $idotherrefs($id) + } + return [list $x $y $z] +} + +proc rereadrefs {} { + global idtags idheads idotherrefs + global tagids headids otherrefids + + set refids [concat [array names idtags] \ + [array names idheads] [array names idotherrefs]] + foreach id $refids { + if {![info exists ref($id)]} { + set ref($id) [listrefs $id] + } + } + readrefs + set refids [lsort -unique [concat $refids [array names idtags] \ + [array names idheads] [array names idotherrefs]]] + foreach id $refids { + set v [listrefs $id] + if {![info exists ref($id)] || $ref($id) != $v} { + redrawtags $id + } + } +} + +proc showtag {tag isnew} { + global ctext cflist tagcontents tagids linknum + + if {$isnew} { + addtohistory [list showtag $tag 0] + } + $ctext conf -state normal + $ctext delete 0.0 end + set linknum 0 + if {[info exists tagcontents($tag)]} { + set text $tagcontents($tag) + } else { + set text "Tag: $tag\nId: $tagids($tag)" + } + appendwithlinks $text + $ctext conf -state disabled + $cflist delete 0 end +} + proc doquit {} { global stopped set stopped 100 destroy . } +proc doprefs {} { + global maxwidth maxgraphpct diffopts findmergefiles + global oldprefs prefstop + + set top .gitkprefs + set prefstop $top + if {[winfo exists $top]} { + raise $top + return + } + foreach v {maxwidth maxgraphpct diffopts findmergefiles} { + set oldprefs($v) [set $v] + } + toplevel $top + wm title $top "Gitk preferences" + label $top.ldisp -text "Commit list display options" + grid $top.ldisp - -sticky w -pady 10 + label $top.spacer -text " " + label $top.maxwidthl -text "Maximum graph width (lines)" \ + -font optionfont + spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth + grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w + label $top.maxpctl -text "Maximum graph width (% of pane)" \ + -font optionfont + spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct + grid x $top.maxpctl $top.maxpct -sticky w + checkbutton $top.findm -variable findmergefiles + label $top.findml -text "Include merges for \"Find\" in \"Files\"" \ + -font optionfont + grid $top.findm $top.findml - -sticky w + label $top.ddisp -text "Diff display options" + grid $top.ddisp - -sticky w -pady 10 + label $top.diffoptl -text "Options for diff program" \ + -font optionfont + entry $top.diffopt -width 20 -textvariable diffopts + grid x $top.diffoptl $top.diffopt -sticky w + frame $top.buts + button $top.buts.ok -text "OK" -command prefsok + button $top.buts.can -text "Cancel" -command prefscan + grid $top.buts.ok $top.buts.can + grid columnconfigure $top.buts 0 -weight 1 -uniform a + grid columnconfigure $top.buts 1 -weight 1 -uniform a + grid $top.buts - - -pady 10 -sticky ew +} + +proc prefscan {} { + global maxwidth maxgraphpct diffopts findmergefiles + global oldprefs prefstop + + foreach v {maxwidth maxgraphpct diffopts findmergefiles} { + set $v $oldprefs($v) + } + catch {destroy $prefstop} + unset prefstop +} + +proc prefsok {} { + global maxwidth maxgraphpct + global oldprefs prefstop + + catch {destroy $prefstop} + unset prefstop + if {$maxwidth != $oldprefs(maxwidth) + || $maxgraphpct != $oldprefs(maxgraphpct)} { + redisplay + } +} + +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 boldnames 0 set diffopts "-U 5 -p" set wrcomcmd "git-diff-tree --stdin -p --pretty" +set gitencoding {} +catch { + set gitencoding [exec git-repo-config --get i18n.commitencoding] +} +if {$gitencoding == ""} { + 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 findmergefiles 0 -set gaudydiff 0 set maxgraphpct 50 +set maxwidth 16 +set revlistorder 0 +set fastdate 0 set colors {green red blue magenta darkgrey brown orange} catch {source ~/.gitk} set namefont $mainfont -if {$boldnames} { - lappend namefont bold -} + +font create optionfont -family sans-serif -size -12 set revtreeargs {} foreach arg $argv { switch -regexp -- $arg { "^$" { } - "^-b" { set boldnames 1 } "^-d" { set datemode 1 } + "^-r" { set revlistorder 1 } default { lappend revtreeargs $arg } @@ -3197,6 +3726,6 @@ set redisplaying 0 set stuffsaved 0 set patchnum 0 setcoords -makewindow +makewindow $revtreeargs readrefs getcommits $revtreeargs