}
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 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 {}
if {$obj != {} && $type == "commit" && $tag != {}} {
set tagids($tag) $obj
lappend idtags($obj) $tag
+ set tagcontents($tag) $tagblob
}
}
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 {
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
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
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]"
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
}
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]
}
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 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
}
}
if {$onscreen($id) == 0} {
lappend displist $id
+ set onscreen($id) 1
}
# remove the null entry if present
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
}
}
}
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} {
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
- global commentend idtags idline
+ global commentend idtags idline linknum
$canv delete hover
if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
$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 "\n"
}
- set commentstart [$ctext index "end - 1c"]
set comment {}
if {[info exists parents($id)]} {
foreach p $parents($id) {
}
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 <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
proc domktag {} {
global mktagtop env tagids idtags
- global idpos idline linehtag canv selectedline
set id [$mktagtop.sha1 get]
set tag [$mktagtop.tag get]
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]
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
projects / git.git / commitdiff