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]
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]
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..." \
}
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"
}
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;
foreach line [split $comment "\n"] {
append newcomment " "
append newcomment $line
+ append newcomment "\n"
}
set comment $newcomment
}
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 {
. 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
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"
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}]
}
}
}
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]
}
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"} {
}
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}
}
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 {
-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
- set t [$canv create polygon $x [expr $yt + $delta] $xl $yt \
- $xr $yt $xr $yb $xl $yb $x [expr $yb - $delta] \
+ 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 {
set col "#ddddff"
}
- set xl [expr $xl - $delta/2]
+ set xl [expr {$xl - $delta/2}]
$canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
-width 1 -outline black -fill $col -tags tag.$id
}
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 {
global numcommits ncmupdate
global nextupdate startmsecs revlistorder
- if {!$revlistorder} {
- set level [decidenext]
- if {$level >= 0} {
- set phase drawgraph
- while 1 {
- lappend displayorder [lindex $todo $level]
- set hard [updatetodo $level $datemode]
- if {$hard} {
- set level [decidenext]
- if {$level < 0} break
- }
+ set level [decidenext]
+ if {$level >= 0} {
+ set phase drawgraph
+ while 1 {
+ lappend displayorder [lindex $todo $level]
+ set hard [updatetodo $level $datemode]
+ if {$hard} {
+ set level [decidenext]
+ if {$level < 0} break
}
}
}
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]} {
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
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"
}
}
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
}
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} {
if {$newtop < 0} {
set newtop 0
}
- allcanvs yview moveto [expr $newtop * 1.0 / $ymax]
+ allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
}
if {$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
}
proc selnextline {dir} {
global selectedline
if {![info exists selectedline]} return
- set l [expr $selectedline + $dir]
+ set l [expr {$selectedline + $dir}]
unmarkmatches
selectline $l 1
}
# 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
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
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} {
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 $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]
}
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 $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
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
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 arrowjump {id dirn y} {
- global mainline sidelines canv
+ global mainline sidelines canv canv2 canv3
set yt {}
if {$dirn eq "down"} {
set yfrac 0
}
$canv yview moveto $yfrac
+ $canv2 yview moveto $yfrac
+ $canv3 yview moveto $yfrac
}
proc lineclick {x y id isnew} {
$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 {} {
}
proc formatdate {d} {
- global hours nhours tfd
+ 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 diffopts "-U 5 -p"
set wrcomcmd "git-diff-tree --stdin -p --pretty"
+set gitencoding ""
+catch {
+ set gitencoding [exec git-repo-config --get i18n.commitencoding]
+}
+if {$gitencoding == ""} {
+ set gitencoding "utf-8"
+}
+
set mainfont {Helvetica 9}
set textfont {Courier 9}
set findmergefiles 0
set maxgraphpct 50
set maxwidth 16
set revlistorder 0
+set fastdate 0
set colors {green red blue magenta darkgrey brown orange}