X-Git-Url: https://git.octo.it/?a=blobdiff_plain;f=gitk;h=a904bab34c38bb49c90a07a6ed146e057868c934;hb=debb9d84445239ffbc630611548af630fb8e1e7a;hp=f54b4c460766b6ad94624e0e821fae8e5369fcb4;hpb=f6075ebadb1fce2bd75f2dd68b8aeae40a69158a;p=git.git diff --git a/gitk b/gitk index f54b4c46..a904bab3 100755 --- a/gitk +++ b/gitk @@ -43,7 +43,7 @@ proc getcommits {rargs} { set parsed_args $rargs } if [catch { - set commfd [open "|git-rev-list --header --topo-order $parsed_args" r] + set commfd [open "|git-rev-list --header --topo-order --parents $parsed_args" r] } err] { puts stderr "Error executing git-rev-list: $err" exit 1 @@ -96,7 +96,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]..." @@ -104,10 +116,12 @@ 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 + parsecommit $id $cmit 1 [lrange $ids 1 end] drawcommit $id if {[clock clicks -milliseconds] >= $nextupdate} { doupdate 1 @@ -151,12 +165,11 @@ proc doupdate {reading} { proc readcommit {id} { if [catch {set contents [exec git-cat-file commit $id]}] return - parsecommit $id $contents 0 + parsecommit $id $contents 0 {} } -proc parsecommit {id contents listed} { +proc parsecommit {id contents listed olds} { global commitinfo children nchildren parents nparents cdate ncleft - global grafts set inhdr 1 set comment {} @@ -170,25 +183,17 @@ proc parsecommit {id contents listed} { set nchildren($id) 0 set ncleft($id) 0 } - set parents($id) {} - set nparents($id) 0 - set grafted 0 - if {[info exists grafts($id)]} { - set grafted 1 - set parents($id) $grafts($id) - set nparents($id) [llength $grafts($id)] - if {$listed} { - foreach p $grafts($id) { - if {![info exists nchildren($p)]} { - set children($p) [list $id] - set nchildren($p) 1 - set ncleft($p) 1 - } elseif {[lsearch -exact $children($p) $id] < 0} { - lappend children($p) $id - incr nchildren($p) - incr ncleft($p) - } - } + set 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) } } foreach line [split $contents "\n"] { @@ -197,22 +202,7 @@ proc parsecommit {id contents listed} { set inhdr 0 } else { set tag [lindex $line 0] - if {$tag == "parent" && !$grafted} { - 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"} { + if {$tag == "author"} { set x [expr {[llength $line] - 2}] set audate [lindex $line $x] set auname [lrange $line 1 [expr {$x - 1}]] @@ -248,7 +238,8 @@ proc parsecommit {id contents listed} { } proc readrefs {} { - global tagids idtags headids idheads + global tagids idtags headids idheads tagcontents + set tags [glob -nocomplain -types f [gitdir]/refs/tags/*] foreach f $tags { catch { @@ -258,7 +249,8 @@ proc readrefs {} { set direct [file tail $f] set tagids($direct) $id lappend idtags($id) $direct - set contents [split [exec git-cat-file tag $id] "\n"] + set tagblob [exec git-cat-file tag $id] + set contents [split $tagblob "\n"] set obj {} set type {} set tag {} @@ -273,6 +265,7 @@ proc readrefs {} { if {$obj != {} && $type == "commit" && $tag != {}} { set tagids($tag) $obj lappend idtags($obj) $tag + set tagcontents($tag) $tagblob } } close $fd @@ -291,31 +284,31 @@ proc readrefs {} { close $fd } } + readotherrefs refs {} {tags heads} } -proc readgrafts {} { - global grafts env - catch { - set graftfile info/grafts - if {[info exists env(GIT_GRAFT_FILE)]} { - set graftfile $env(GIT_GRAFT_FILE) - } - set fd [open [gitdir]/$graftfile r] - while {[gets $fd line] >= 0} { - if {[string match "#*" $line]} continue - set ok 1 - foreach x $line { - if {![regexp {^[0-9a-f]{40}$} $x]} { - set ok 0 - break - } - } - if {$ok} { - set id [lindex $line 0] - set grafts($id) [lrange $line 1 end] +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 } + close $fd } - close $fd + } + 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/" {} } } @@ -341,6 +334,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 @@ -564,6 +558,7 @@ proc click {w} { proc savestuff {w} { global canv canv2 canv3 ctext cflist mainfont textfont global stuffsaved findmergefiles gaudydiff maxgraphpct + global maxwidth if {$stuffsaved} return if {![winfo viewable .]} return @@ -574,6 +569,7 @@ proc savestuff {w} { 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]" @@ -785,7 +781,7 @@ proc drawcommitline {level} { 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 @@ -856,7 +852,8 @@ 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] @@ -876,18 +873,23 @@ 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 @@ -912,17 +914,27 @@ proc drawtags {id x xt y1} { 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 + # 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 } @@ -1055,6 +1067,7 @@ proc drawslants {id needonscreen nohs} { } if {$onscreen($id) == 0} { lappend displist $id + set onscreen($id) 1 } # remove the null entry if present @@ -1222,15 +1235,10 @@ proc drawslants {id needonscreen nohs} { set j [lsearch -exact $displist $id] } if {$j != $i || $xspc1($lineno) != $xspc1($lj) - || ($olddlevel <= $i && $i <= $dlevel) - || ($dlevel <= $i && $i <= $olddlevel)} { + || ($olddlevel < $i && $i < $dlevel) + || ($dlevel < $i && $i < $olddlevel)} { set xj [xcoord $j $dlevel $lj] - set dx [expr {abs($xi - $xj)}] - set yb $y2 - if {0 && $dx < $linespc} { - set yb [expr {$y1 + $dx}] - } - lappend mainline($id) $xi $y1 $xj $yb + lappend mainline($id) $xi $y1 $xj $y2 } } } @@ -1496,7 +1504,7 @@ proc drawrest {} { global phase stopped redisplaying selectedline global datemode todo displayorder global numcommits ncmupdate - global nextupdate startmsecs idline + global nextupdate startmsecs set level [decidenext] if {$level >= 0} { @@ -2018,12 +2026,37 @@ 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 if {![info exists lineid($l)] || ![info exists linehtag($l)]} return @@ -2089,6 +2122,7 @@ 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) @@ -2102,7 +2136,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) { @@ -2116,26 +2149,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 @@ -3345,7 +3361,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] @@ -3370,6 +3385,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] @@ -3445,6 +3467,68 @@ 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 @@ -3495,5 +3579,4 @@ set patchnum 0 setcoords makewindow readrefs -readgrafts getcommits $revtreeargs