Display the contents of a tag when the user clicks on it.

[git.git] / gitk

diff --git a/gitk b/gitk
index 0767695..a904bab 100755 (executable)
--- a/gitk
+++ b/gitk
@@ -238,7 +238,8 @@ proc parsecommit {id contents listed olds} {
 }
 
 proc readrefs {} {
 }
 
 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 {
     set tags [glob -nocomplain -types f [gitdir]/refs/tags/*]
     foreach f $tags {
        catch {


@@ -248,7 +249,8 @@ proc readrefs {} {
                set direct [file tail $f]
                set tagids($direct) $id
                lappend idtags($id) $direct
                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 {}
                set obj {}
                set type {}
                set tag {}


@@ -263,6 +265,7 @@ proc readrefs {} {
                if {$obj != {} && $type == "commit" && $tag != {}} {
                    set tagids($tag) $obj
                    lappend idtags($obj) $tag
                if {$obj != {} && $type == "commit" && $tag != {}} {
                    set tagids($tag) $obj
                    lappend idtags($obj) $tag

+                   set tagcontents($tag) $tagblob

                }
            }
            close $fd
                }
            }
            close $fd


@@ -281,6 +284,32 @@ proc readrefs {} {
            close $fd
        }
     }
            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
+           }
+           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/" {}
+    }

 }
 
 proc error_popup msg {
 }
 
 proc error_popup msg {


@@ -305,6 +334,7 @@ proc makewindow {} {
     menu .bar
     .bar add cascade -label "File" -menu .bar.file
     menu .bar.file
     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
     .bar.file add command -label "Quit" -command doquit
     menu .bar.help
     .bar add cascade -label "Help" -menu .bar.help


@@ -528,6 +558,7 @@ proc click {w} {
 proc savestuff {w} {
     global canv canv2 canv3 ctext cflist mainfont textfont
     global stuffsaved findmergefiles gaudydiff maxgraphpct
 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
 
     if {$stuffsaved} return
     if {![winfo viewable .]} return


@@ -538,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 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(width) [winfo width .ctop]"
        puts $f "set geometry(height) [winfo height .ctop]"
        puts $f "set geometry(canv1) [expr [winfo width $canv]-2]"


@@ -749,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 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
     global lineno lthickness mainline mainlinearrow sidelines
     global commitlisted rowtextx idpos lastuse displist
     global oldnlines olddlevel olddisplist


@@ -820,7 +852,8 @@ proc drawcommitline {level} {
     }
     set rowtextx($lineno) $xt
     set idpos($id) [list $x $xt $y1]
     }
     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 xt [drawtags $id $x $xt $y1]
     }
     set headline [lindex $commitinfo($id) 0]


@@ -840,18 +873,23 @@ proc drawcommitline {level} {
 }
 
 proc drawtags {id x xt y1} {
 }
 
 proc drawtags {id x xt y1} {

-    global idtags idheads
+    global idtags idheads idotherrefs

     global linespc lthickness
     global linespc lthickness

-    global canv mainfont
+    global canv mainfont idline rowtextx

 
     set marks {}
     set ntags 0
 
     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)]
     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
     }
     if {$marks eq {}} {
        return $xt


@@ -876,17 +914,27 @@ proc drawtags {id x xt y1} {
        set xr [expr $x + $delta + $wid + $lthickness]
        if {[incr ntags -1] >= 0} {
            # draw a tag
        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 {
        } 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 \
            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
 }
     }
     return $xt
 }


@@ -1456,7 +1504,7 @@ proc drawrest {} {
     global phase stopped redisplaying selectedline
     global datemode todo displayorder
     global numcommits ncmupdate
     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} {
 
     set level [decidenext]
     if {$level >= 0} {


@@ -1978,12 +2026,37 @@ proc commit_descriptor {p} {
     return "$p ($l)"
 }
 
     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 <Enter> { %W configure -cursor hand2 }
+    $ctext tag bind link <Leave> { %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
 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
 
     $canv delete hover
     if {![info exists lineid($l)] || ![info exists linehtag($l)]} return


@@ -2049,6 +2122,7 @@ proc selectline {l isnew} {
 
     $ctext conf -state normal
     $ctext delete 0.0 end
 
     $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 mark set fmark.0 0.0
     $ctext mark gravity fmark.0 left
     set info $commitinfo($id)


@@ -2062,7 +2136,6 @@ proc selectline {l isnew} {
        $ctext insert end "\n"
     }
  
        $ctext insert end "\n"
     }
  

-    set commentstart [$ctext index "end - 1c"]

     set comment {}
     if {[info exists parents($id)]} {
        foreach p $parents($id) {
     set comment {}
     if {[info exists parents($id)]} {
        foreach p $parents($id) {


@@ -2076,26 +2149,9 @@ proc selectline {l isnew} {
     }
     append comment "\n"
     append comment [lindex $info 5]
     }
     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
 
     # 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 <Enter> { %W configure -cursor hand2 }
-    $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
+    appendwithlinks $comment

 
     $ctext tag delete Comments
     $ctext tag remove found 1.0 end
 
     $ctext tag delete Comments
     $ctext tag remove found 1.0 end


@@ -3305,7 +3361,6 @@ proc mktag {} {
 
 proc domktag {} {
     global mktagtop env tagids idtags
 
 proc domktag {} {
     global mktagtop env tagids idtags

-    global idpos idline linehtag canv selectedline

 
     set id [$mktagtop.sha1 get]
     set tag [$mktagtop.tag get]
 
     set id [$mktagtop.sha1 get]
     set tag [$mktagtop.tag get]


@@ -3330,6 +3385,13 @@ proc domktag {} {
 
     set tagids($tag) $id
     lappend idtags($id) $tag
 
     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]
     $canv delete tag.$id
     set xt [eval drawtags $id $idpos($id)]
     $canv coords $linehtag($idline($id)) $xt [lindex $idpos($id) 2]


@@ -3405,6 +3467,68 @@ proc wrcomcan {} {
     unset wrcomtop
 }
 
     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
 proc doquit {} {
     global stopped
     set stopped 100