X-Git-Url: https://git.octo.it/?a=blobdiff_plain;f=gitk;h=e1c3954754f7daba1dee00114e74ca111ee5581a;hb=d327244a8435539b62d73ab151bd6c46324cbeb6;hp=1c6b3822c1218c7243c52e80aba13b4cfb1fc288;hpb=04c13d38772c77997d8789ee2067cc351b66e2aa;p=git.git diff --git a/gitk b/gitk index 1c6b3822..e1c39547 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,91 +196,88 @@ 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] } 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 + + 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 { @@ -305,6 +302,7 @@ proc makewindow {} { menu .bar .bar add cascade -label "File" -menu .bar.file menu .bar.file + .bar.file add command -label "Reread references" -command rereadrefs .bar.file add command -label "Quit" -command doquit menu .bar.help .bar add cascade -label "Help" -menu .bar.help @@ -312,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 @@ -456,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" @@ -463,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" @@ -542,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" @@ -574,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}] } } } @@ -602,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] @@ -645,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 @@ -745,13 +751,41 @@ proc bindline {t id} { $canv bind $t "lineclick %x %y $id 1" } +proc drawlines {id xtra delold} { + global mainline mainlinearrow sidelines lthickness colormap canv + + if {$delold} { + $canv delete lines.$id + } + if {[info exists mainline($id)]} { + set t [$canv create line $mainline($id) \ + -width [expr {($xtra + 1) * $lthickness}] \ + -fill $colormap($id) -tags lines.$id \ + -arrow $mainlinearrow($id)] + $canv lower $t + bindline $t $id + } + if {[info exists sidelines($id)]} { + foreach ls $sidelines($id) { + set coords [lindex $ls 0] + set thick [lindex $ls 1] + set arrow [lindex $ls 2] + set t [$canv create line $coords -fill $colormap($id) \ + -width [expr {($thick + $xtra) * $lthickness}] \ + -arrow $arrow -tags lines.$id] + $canv lower $t + bindline $t $id + } + } +} + # level here is an index in displist proc drawcommitline {level} { global parents children nparents displist global canv canv2 canv3 mainfont namefont canvy linespc global lineid linehtag linentag linedtag commitinfo global colormap numcommits currentparents dupparents - global idtags idline idheads + global idtags idline idheads idotherrefs global lineno lthickness mainline mainlinearrow sidelines global commitlisted rowtextx idpos lastuse displist global oldnlines olddlevel olddisplist @@ -785,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} @@ -822,12 +841,14 @@ proc drawcommitline {level} { } 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" @@ -842,26 +863,31 @@ proc drawcommitline {level} { } 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 { @@ -874,21 +900,31 @@ 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 + -width 1 -outline black -fill $col -tags tag.$id + } + 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] } - $canv create text $xl $y1 -anchor w -text $tag \ - -font $mainfont -tags tag.$id } return $xt } @@ -1381,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 @@ -1394,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 } - set id [lindex $todo $level] - if {![info exists commitlisted($id)]} { - break + lappend displayorder $id + updatetodo $level 0 + } else { + set level [decidenext 1] + if {$level == {} || $id != [lindex $todo $level]} { + return + } + while 1 { + lappend displayorder [lindex $todo $level] + if {[updatetodo $level $datemode]} { + set level [decidenext 1] + if {$level == {}} break + } + set id [lindex $todo $level] + if {![info exists commitlisted($id)]} { + break + } } } drawmore 1 @@ -1445,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 { @@ -1458,7 +1504,7 @@ proc drawrest {} { global phase stopped redisplaying selectedline global datemode todo displayorder global numcommits ncmupdate - global nextupdate startmsecs idline + global nextupdate startmsecs revlistorder set level [decidenext] if {$level >= 0} { @@ -1471,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]} { @@ -1502,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 @@ -1584,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" } } @@ -1938,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 } @@ -1980,14 +2027,40 @@ 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 global cflist currentid sha1entry - global commentend idtags idline + 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 {{}} \ @@ -2006,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} { @@ -2033,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} { @@ -2051,11 +2124,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) { @@ -2064,7 +2140,6 @@ proc selectline {l isnew} { $ctext insert end "\n" } - set commentstart [$ctext index "end - 1c"] set comment {} if {[info exists parents($id)]} { foreach p $parents($id) { @@ -2078,26 +2153,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 @@ -2107,7 +2165,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 } @@ -2116,7 +2174,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 } @@ -2216,12 +2274,12 @@ proc contmergediff {ids} { # 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] + if {[lindex $ids 1] == $diffmergeid && $diffmergegca ne {}} { + set ids [list $diffmergegca [lindex $ids 0]] } else { if {[incr diffpindex] >= $nparents($diffmergeid)} break set p [lindex $parents($diffmergeid) $diffpindex] - set ids [list $diffmergeid $p] + set ids [list $p $diffmergeid] } if {![info exists treediffs($ids)]} { set diffids $ids @@ -2239,8 +2297,8 @@ proc contmergediff {ids} { if {$diffmergegca ne {}} { set files {} foreach p $parents($diffmergeid) { - set gcadiffs $treediffs([list $p $diffmergegca]) - foreach f $treediffs([list $diffmergeid $p]) { + set gcadiffs $treediffs([list $diffmergegca $p]) + foreach f $treediffs([list $p $diffmergeid]) { if {[lsearch -exact $files $f] < 0 && [lsearch -exact $gcadiffs $f] >= 0} { lappend files $f @@ -2253,7 +2311,7 @@ proc contmergediff {ids} { 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 df $treediffs([list $p $diffmergeid]) set nf {} foreach f $files { if {[lsearch -exact $df $f] >= 0} { @@ -2730,9 +2788,7 @@ 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] } @@ -2765,10 +2821,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 @@ -2911,8 +2965,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 @@ -3069,19 +3123,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 @@ -3094,7 +3237,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 @@ -3106,7 +3250,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 @@ -3114,6 +3259,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)]} { @@ -3186,7 +3339,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 {} { @@ -3307,7 +3460,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] @@ -3332,6 +3484,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] @@ -3407,17 +3566,97 @@ 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] + } + } + foreach v {tagids idtags headids idheads otherrefids idotherrefs} { + catch {unset $v} + } + readrefs + set refids [lsort -unique [concat $refids [array names idtags] \ + [array names idheads] [array names idotherrefs]]] + 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 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} @@ -3425,6 +3664,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} @@ -3441,6 +3682,7 @@ foreach arg $argv { "^$" { } "^-b" { set boldnames 1 } "^-d" { set datemode 1 } + "^-r" { set revlistorder 1 } default { lappend revtreeargs $arg }