#!/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
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]
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 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 {
bindall <B2-Motion> "allcanvs scan dragto 0 %y"
bind . <Key-Up> "selnextline -1"
bind . <Key-Down> "selnextline 1"
+ bind . <Key-Right> "goforw"
+ bind . <Key-Left> "goback"
bind . <Key-Prior> "allcanvs yview scroll -1 pages"
bind . <Key-Next> "allcanvs yview scroll 1 pages"
bindkey <Key-Delete> "$ctext yview scroll -1 pages"
bindkey <Key-space> "$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"
}
proc assigncolor {id} {
- global commitinfo colormap commcolors colors nextcolor
+ global colormap commcolors colors nextcolor
global parents nparents children nchildren
global cornercrossings crossings
$canv bind $t <Button-1> "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
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 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) <Button-3> "rowmenu %X %Y $id"
}
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
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
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} {
if {$level < 0} break
}
}
- drawmore 0
}
+ drawmore 0
set phase {}
set drawmsecs [expr [clock clicks -milliseconds] - $startmsecs]
#puts "overall $drawmsecs ms for $numcommits commits"
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 {{}} \
$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) {
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 "|git-diff-tree --no-commit-id -r $id" r]}] return
fconfigure $gdtf -blocking 0
fileevent $gdtf readable [list gettreediffline $gdtf $ids]
}
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 [list | git-diff-tree --no-commit-id -r -p -C $id]
if {[catch {set bdf [open $cmd r]} err]} {
puts "error getting diffs: $err"
return
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
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
$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
$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)]} {
destroy .
}
+proc formatdate {d} {
+ global hours nhours tfd
+
+ 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 gaudydiff 0
set maxgraphpct 50
set maxwidth 16
+set revlistorder 0
set colors {green red blue magenta darkgrey brown orange}
"^$" { }
"^-b" { set boldnames 1 }
"^-d" { set datemode 1 }
+ "^-r" { set revlistorder 1 }
default {
lappend revtreeargs $arg
}
projects / git.git / blobdiff