X-Git-Url: https://git.verplant.org/?a=blobdiff_plain;f=gitk;h=b53a5c56c1f0d951c0f1503b978852f8bf56e9ba;hb=4e72dcec89c7cda7022d4ec2dd686e77deb5376e;hp=a904bab34c38bb49c90a07a6ed146e057868c934;hpb=106288cb023cff311ca499fe41b128afbdf82997;p=git.git diff --git a/gitk b/gitk index a904bab3..b53a5c56 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 @@ -19,7 +19,7 @@ proc gitdir {} { proc getcommits {rargs} { global commits commfd phase canv mainfont env global startmsecs nextupdate ncmupdate - global ctext maincursor textcursor leftover + global ctext maincursor textcursor leftover gitencoding # check that we can find a .git directory somewhere... set gitdir [gitdir] @@ -30,7 +30,7 @@ proc getcommits {rargs} { set commits {} set phase getcommits set startmsecs [clock clicks -milliseconds] - set nextupdate [expr $startmsecs + 100] + set nextupdate [expr {$startmsecs + 100}] set ncmupdate 1 if [catch { set parse_args [concat --default HEAD $rargs] @@ -49,7 +49,7 @@ proc getcommits {rargs} { exit 1 } set leftover {} - fconfigure $commfd -blocking 0 -translation lf + fconfigure $commfd -blocking 0 -translation lf -encoding $gitencoding fileevent $commfd readable [list getcommitlines $commfd] $canv delete all $canv create text 3 3 -anchor nw -text "Reading commits..." \ @@ -60,7 +60,7 @@ proc getcommits {rargs} { proc getcommitlines {commfd} { global commits parents cdate children - global commitlisted phase commitinfo nextupdate + global commitlisted phase nextupdate global stopped redisplaying leftover set stuff [read $commfd] @@ -74,9 +74,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" } @@ -196,42 +196,44 @@ proc parsecommit {id contents listed olds} { incr ncleft($p) } } - foreach line [split $contents "\n"] { - if {$inhdr} { - if {$line == {}} { - set inhdr 0 - } else { - set tag [lindex $line 0] - if {$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 + 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] @@ -239,77 +241,43 @@ proc parsecommit {id contents listed olds} { proc readrefs {} { global tagids idtags headids idheads tagcontents - - 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 tagblob [exec git-cat-file tag $id] - set contents [split $tagblob "\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 - set tagcontents($tag) $tagblob - } - } - 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 - } - } - readotherrefs refs {} {tags heads} -} - -proc readotherrefs {base dname excl} { global otherrefids idotherrefs - set git [gitdir] - set files [glob -nocomplain -types f [file join $git $base *]] - foreach f $files { - catch { - set fd [open $f r] - set line [read $fd 40] - if {[regexp {^[0-9a-f]{40}} $line id]} { - set name "$dname[file tail $f]" - set otherrefids($name) $id - lappend idotherrefs($id) $name + 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 + } elseif { $type == "heads" } { + set headids($name) $id + lappend idheads($id) $name + } else { + set otherrefids($name) $id + lappend idotherrefs($id) $name } } - set dirs [glob -nocomplain -types d [file join $git $base *]] - foreach d $dirs { - set dir [file tail $d] - if {[lsearch -exact $excl $dir] >= 0} continue - readotherrefs [file join $base $dir] "$dname$dir/" {} - } + close $refd } proc error_popup msg { @@ -342,10 +310,10 @@ proc makewindow {} { . 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 @@ -486,6 +454,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" @@ -493,6 +463,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" @@ -572,10 +548,10 @@ proc savestuff {w} { 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" @@ -604,12 +580,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}] } } } @@ -632,7 +608,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] @@ -675,7 +651,7 @@ 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 @@ -775,6 +751,34 @@ proc bindline {t id} { $canv bind $t "lineclick %x %y $id 1" } +proc drawlines {id xtra delold} { + global mainline mainlinearrow sidelines lthickness colormap canv + + if {$delold} { + $canv delete lines.$id + } + if {[info exists mainline($id)]} { + set t [$canv create line $mainline($id) \ + -width [expr {($xtra + 1) * $lthickness}] \ + -fill $colormap($id) -tags lines.$id \ + -arrow $mainlinearrow($id)] + $canv lower $t + bindline $t $id + } + if {[info exists sidelines($id)]} { + foreach ls $sidelines($id) { + set coords [lindex $ls 0] + set thick [lindex $ls 1] + set arrow [lindex $ls 2] + set t [$canv create line $coords -fill $colormap($id) \ + -width [expr {($thick + $xtra) * $lthickness}] \ + -arrow $arrow -tags lines.$id] + $canv lower $t + bindline $t $id + } + } +} + # level here is an index in displist proc drawcommitline {level} { global parents children nparents displist @@ -815,34 +819,19 @@ 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 if {$mainlinearrow($id) ne "none"} { set mainline($id) [trimdiagstart $mainline($id)] } - set t [$canv create line $mainline($id) \ - -width $lthickness -fill $colormap($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 * $lthickness}] -arrow $arrow] - $canv lower $t - bindline $t $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} @@ -859,6 +848,7 @@ proc drawcommitline {level} { 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" @@ -896,8 +886,8 @@ proc drawtags {id x xt y1} { } 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 { @@ -910,12 +900,12 @@ 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 - set t [$canv create polygon $x [expr $yt + $delta] $xl $yt \ - $xr $yt $xr $yb $xl $yb $x [expr $yb - $delta] \ + 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}] @@ -926,7 +916,7 @@ proc drawtags {id x xt y1} { } else { set col "#ddddff" } - set xl [expr $xl - $delta/2] + set xl [expr {$xl - $delta/2}] $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \ -width 1 -outline black -fill $col -tags tag.$id } @@ -1427,8 +1417,8 @@ proc decidenext {{noread 0}} { } proc drawcommit {id} { - global phase todo nchildren datemode nextupdate - global numcommits ncmupdate displayorder todo onscreen + global phase todo nchildren datemode nextupdate revlistorder + global numcommits ncmupdate displayorder todo onscreen parents if {$phase != "incrdraw"} { set phase incrdraw @@ -1440,19 +1430,29 @@ proc drawcommit {id} { lappend todo $id set onscreen($id) 0 } - set level [decidenext 1] - if {$level == {} || $id != [lindex $todo $level]} { - return - } - while 1 { - lappend displayorder [lindex $todo $level] - if {[updatetodo $level $datemode]} { - set level [decidenext 1] - if {$level == {}} break + if {$revlistorder} { + set level [lsearch -exact $todo $id] + if {$level < 0} { + error_popup "oops, $id isn't in todo" + return + } + lappend displayorder $id + updatetodo $level 0 + } else { + set level [decidenext 1] + if {$level == {} || $id != [lindex $todo $level]} { + return } - set id [lindex $todo $level] - if {![info exists commitlisted($id)]} { - break + while 1 { + lappend displayorder [lindex $todo $level] + if {[updatetodo $level $datemode]} { + set level [decidenext 1] + if {$level == {}} break + } + set id [lindex $todo $level] + if {![info exists commitlisted($id)]} { + break + } } } drawmore 1 @@ -1491,7 +1491,7 @@ proc drawgraph {} { if {$displayorder == {}} return set startmsecs [clock clicks -milliseconds] - set nextupdate [expr $startmsecs + 100] + set nextupdate [expr {$startmsecs + 100}] set ncmupdate 1 initgraph foreach id $displayorder { @@ -1504,7 +1504,7 @@ proc drawrest {} { global phase stopped redisplaying selectedline global datemode todo displayorder global numcommits ncmupdate - global nextupdate startmsecs + global nextupdate startmsecs revlistorder set level [decidenext] if {$level >= 0} { @@ -1517,10 +1517,10 @@ proc drawrest {} { if {$level < 0} break } } - drawmore 0 } + 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]} { @@ -1548,8 +1548,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 @@ -1630,7 +1630,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" } } @@ -1984,9 +1984,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 } @@ -2059,6 +2060,7 @@ proc selectline {l isnew} { global commentend idtags idline linknum $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 {{}} \ @@ -2077,8 +2079,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} { @@ -2104,7 +2106,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} { @@ -2126,8 +2128,10 @@ proc selectline {l isnew} { $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) { @@ -2161,16 +2165,16 @@ proc selectline {l isnew} { $cflist delete 0 end $cflist insert end "Comments" if {$nparents($id) == 1} { - startdiff [concat $id $parents($id)] + startdiff [concat $id $parents($id)] 1 } elseif {$nparents($id) > 1} { - mergediff $id + mergediff $id 1 } } proc selnextline {dir} { global selectedline if {![info exists selectedline]} return - set l [expr $selectedline + $dir] + set l [expr {$selectedline + $dir}] unmarkmatches selectline $l 1 } @@ -2232,7 +2236,7 @@ proc goforw {} { } } -proc mergediff {id} { +proc mergediff {id singlecommit} { global parents diffmergeid diffmergegca mergefilelist diffpindex set diffmergeid $id @@ -2243,7 +2247,7 @@ proc mergediff {id} { showmergediff } } else { - contmergediff {} + contmergediff {} $singlecommit } } @@ -2263,7 +2267,7 @@ proc findgca {ids} { return $gca } -proc contmergediff {ids} { +proc contmergediff {ids singlecommit} { global diffmergeid diffpindex parents nparents diffmergegca global treediffs mergefilelist diffids treepending @@ -2280,7 +2284,7 @@ proc contmergediff {ids} { if {![info exists treediffs($ids)]} { set diffids $ids if {![info exists treepending]} { - gettreediffs $ids + gettreediffs $ids $singlecommit } return } @@ -2758,40 +2762,45 @@ proc similarity {pnum l nlc f events} { return [expr {200 * $same / (2 * $same + $diff)}] } -proc startdiff {ids} { +proc startdiff {ids singlecommit} { global treediffs diffids treepending diffmergeid set diffids $ids catch {unset diffmergeid} if {![info exists treediffs($ids)]} { if {![info exists treepending]} { - gettreediffs $ids + gettreediffs $ids $singlecommit } } else { - addtocflist $ids + addtocflist $ids $singlecommit } } -proc addtocflist {ids} { +proc addtocflist {ids singlecommit} { global treediffs cflist foreach f $treediffs($ids) { $cflist insert end $f } - getblobdiffs $ids + getblobdiffs $ids $singlecommit } -proc gettreediffs {ids} { +proc gettreediffs {ids singlecommit} { 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 {$singlecommit == 1} { + set range "$id" + } else { + set p [lindex $ids 1] + set range "$p $id" + } + if [catch {set gdtf [open "|git-diff-tree --no-commit-id -r $range" r]}] return fconfigure $gdtf -blocking 0 - fileevent $gdtf readable [list gettreediffline $gdtf $ids] + fileevent $gdtf readable [list gettreediffline $gdtf $ids $singlecommit] } -proc gettreediffline {gdtf ids} { +proc gettreediffline {gdtf ids singlecommit} { global treediff treediffs treepending diffids diffmergeid set n [gets $gdtf line] @@ -2801,12 +2810,12 @@ proc gettreediffline {gdtf ids} { set treediffs($ids) $treediff unset treepending if {$ids != $diffids} { - gettreediffs $diffids + gettreediffs $diffids $singlecommit } else { if {[info exists diffmergeid]} { - contmergediff $ids + contmergediff $ids $singlecommit } else { - addtocflist $ids + addtocflist $ids $singlecommit } } return @@ -2815,14 +2824,18 @@ proc gettreediffline {gdtf ids} { lappend treediff $file } -proc getblobdiffs {ids} { +proc getblobdiffs {ids singlecommit} { 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] + if {$singlecommit == 1} { + set cmd [list | git-diff-tree --no-commit-id -r -p -C $id] + } else { + set p [lindex $ids 1] + set cmd [list | git-diff-tree --no-commit-id -r -p -C $p $id] + } if {[catch {set bdf [open $cmd r]} err]} { puts "error getting diffs: $err" return @@ -2965,8 +2978,8 @@ proc setcoords {} { set linespc [font metrics $mainfont -linespace] set charspc [font measure $mainfont "m"] - set canvy0 [expr 3 + 0.5 * $linespc] - set canvx0 [expr 3 + 0.5 * $linespc] + set canvy0 [expr {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 @@ -3123,19 +3136,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} { + 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 $x $id 0] + 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 @@ -3148,7 +3250,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 @@ -3160,7 +3263,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 @@ -3168,6 +3272,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)]} { @@ -3240,7 +3352,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 $newid $oldid] 0 } proc mkpatch {} { @@ -3535,11 +3647,29 @@ proc doquit {} { destroy . } +proc formatdate {d} { + global hours nhours tfd fastdate + + if {!$fastdate} { + return [clock format $d -format "%Y-%m-%d %H:%M:%S"] + } + set hr [expr {$d / 3600}] + set ms [expr {$d % 3600}] + if {![info exists hours($hr)]} { + set hours($hr) [clock format $d -format "%Y-%m-%d %H"] + set nhours($hr) 0 + } + incr nhours($hr) + set minsec [format "%.2d:%.2d" [expr {$ms/60}] [expr {$ms%60}]] + return "$hours($hr):$minsec" +} + # defaults... set datemode 0 set boldnames 0 set diffopts "-U 5 -p" set wrcomcmd "git-diff-tree --stdin -p --pretty" +set gitencoding "utf-8" set mainfont {Helvetica 9} set textfont {Courier 9} @@ -3547,6 +3677,8 @@ 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} @@ -3563,6 +3695,7 @@ foreach arg $argv { "^$" { } "^-b" { set boldnames 1 } "^-d" { set datemode 1 } + "^-r" { set revlistorder 1 } default { lappend revtreeargs $arg }