# run before X event handlers, so reading from a fast source can
# make the GUI completely unresponsive.
proc run args {
- global isonrunq runq
+ global isonrunq runq currunq
set script $args
if {[info exists isonrunq($script)]} return
- if {$runq eq {}} {
+ if {$runq eq {} && ![info exists currunq]} {
after idle dorunq
}
lappend runq [list {} $script]
}
proc filereadable {fd script} {
- global runq
+ global runq currunq
fileevent $fd readable {}
- if {$runq eq {}} {
+ if {$runq eq {} && ![info exists currunq]} {
after idle dorunq
}
lappend runq [list $fd $script]
}
proc dorunq {} {
- global isonrunq runq
+ global isonrunq runq currunq
set tstart [clock clicks -milliseconds]
set t0 $tstart
while {[llength $runq] > 0} {
set fd [lindex $runq 0 0]
set script [lindex $runq 0 1]
+ set currunq [lindex $runq 0]
+ set runq [lrange $runq 1 end]
set repeat [eval $script]
+ unset currunq
set t1 [clock clicks -milliseconds]
set t [expr {$t1 - $t0}]
- set runq [lrange $runq 1 end]
if {$repeat ne {} && $repeat} {
if {$fd eq {} || $repeat == 2} {
# script returns 1 if it wants to be readded
}
}
+proc reg_instance {fd} {
+ global commfd leftover loginstance
+
+ set i [incr loginstance]
+ set commfd($i) $fd
+ set leftover($i) {}
+ return $i
+}
+
proc unmerged_files {files} {
global nr_unmerged
lappend badrev $line
}
}
- error_popup "Error parsing revisions: $err"
+ error_popup "[mc "Error parsing revisions:"] $err"
return {}
}
set ret {}
# Start off a git log process and arrange to read its output
proc start_rev_list {view} {
- global startmsecs commitidx viewcomplete
- global commfd leftover tclencoding
+ global startmsecs commitidx viewcomplete curview
+ global tclencoding
global viewargs viewargscmd viewfiles vfilelimit
- global showlocalchanges commitinterest mainheadid
- global progressdirn progresscoords proglastnc curview
- global viewactive loginstance viewinstances vmergeonly
- global pending_select mainheadid
+ global showlocalchanges commitinterest
+ global viewactive viewinstances vmergeonly
+ global mainheadid
global vcanopt vflags vrevs vorigargs
set startmsecs [clock clicks -milliseconds]
if {[catch {
set str [exec sh -c $viewargscmd($view)]
} err]} {
- error_popup "Error executing --argscmd command: $err"
+ error_popup "[mc "Error executing --argscmd command:"] $err"
return 0
}
set args [concat $args [split $str "\n"]]
error_popup "[mc "Error executing git log:"] $err"
return 0
}
- set i [incr loginstance]
+ set i [reg_instance $fd]
set viewinstances($view) [list $i]
- set commfd($i) $fd
- set leftover($i) {}
- if {$showlocalchanges} {
+ if {$showlocalchanges && $mainheadid ne {}} {
lappend commitinterest($mainheadid) {dodiffindex}
}
fconfigure $fd -blocking 0 -translation lf -eofchar {}
}
filerun $fd [list getcommitlines $fd $i $view 0]
nowbusy $view [mc "Reading"]
- if {$view == $curview} {
- set progressdirn 1
- set progresscoords {0 0}
- set proglastnc 0
- set pending_select $mainheadid
- }
set viewcomplete($view) 0
set viewactive($view) 1
return 1
}
-proc stop_rev_list {view} {
- global commfd viewinstances leftover
+proc stop_instance {inst} {
+ global commfd leftover
- foreach inst $viewinstances($view) {
- set fd $commfd($inst)
- catch {
- set pid [pid $fd]
+ set fd $commfd($inst)
+ catch {
+ set pid [pid $fd]
+
+ if {$::tcl_platform(platform) eq {windows}} {
+ exec kill -f $pid
+ } else {
exec kill $pid
}
- catch {close $fd}
- nukefile $fd
- unset commfd($inst)
- unset leftover($inst)
+ }
+ catch {close $fd}
+ nukefile $fd
+ unset commfd($inst)
+ unset leftover($inst)
+}
+
+proc stop_backends {} {
+ global commfd
+
+ foreach inst [array names commfd] {
+ stop_instance $inst
+ }
+}
+
+proc stop_rev_list {view} {
+ global viewinstances
+
+ foreach inst $viewinstances($view) {
+ stop_instance $inst
}
set viewinstances($view) {}
}
-proc getcommits {} {
+proc reset_pending_select {selid} {
+ global pending_select mainheadid selectheadid
+
+ if {$selid ne {}} {
+ set pending_select $selid
+ } elseif {$selectheadid ne {}} {
+ set pending_select $selectheadid
+ } else {
+ set pending_select $mainheadid
+ }
+}
+
+proc getcommits {selid} {
global canv curview need_redisplay viewactive
initlayout
if {[start_rev_list $curview]} {
+ reset_pending_select $selid
show_status [mc "Reading commits..."]
set need_redisplay 1
} else {
proc updatecommits {} {
global curview vcanopt vorigargs vfilelimit viewinstances
- global viewactive viewcomplete loginstance tclencoding mainheadid
- global startmsecs commfd showneartags showlocalchanges leftover
+ global viewactive viewcomplete tclencoding
+ global startmsecs showneartags showlocalchanges
global mainheadid pending_select
global isworktree
global varcid vposids vnegids vflags vrevs
set fd [open [concat | git log --no-color -z --pretty=raw --parents \
--boundary $args "--" $vfilelimit($view)] r]
} err]} {
- error_popup "Error executing git log: $err"
+ error_popup "[mc "Error executing git log:"] $err"
return
}
if {$viewactive($view) == 0} {
set startmsecs [clock clicks -milliseconds]
}
- set i [incr loginstance]
+ set i [reg_instance $fd]
lappend viewinstances($view) $i
- set commfd($i) $fd
- set leftover($i) {}
fconfigure $fd -blocking 0 -translation lf -eofchar {}
if {$tclencoding != {}} {
fconfigure $fd -encoding $tclencoding
filerun $fd [list getcommitlines $fd $i $view 1]
incr viewactive($view)
set viewcomplete($view) 0
- set pending_select $mainheadid
+ reset_pending_select {}
nowbusy $view "Reading"
if {$showneartags} {
getallcommits
proc reloadcommits {} {
global curview viewcomplete selectedline currentid thickerline
global showneartags treediffs commitinterest cached_commitrow
- global progresscoords targetid
+ global targetid
+
+ set selid {}
+ if {$selectedline ne {}} {
+ set selid $currentid
+ }
if {!$viewcomplete($curview)} {
stop_rev_list $curview
- set progresscoords {0 0}
- adjustprogress
}
resetvarcs $curview
- catch {unset selectedline}
+ set selectedline {}
catch {unset currentid}
catch {unset thickerline}
catch {unset treediffs}
catch {unset cached_commitrow}
catch {unset targetid}
setcanvscroll
- getcommits
+ getcommits $selid
return 0
}
modify_arc $v $a $i
if {[info exist currentid] && $id eq $currentid} {
unset currentid
- unset selectedline
+ set selectedline {}
}
if {[info exists targetid] && $targetid eq $id} {
set targetid $p
if {![eof $fd]} {
return 1
}
- global commfd viewcomplete viewactive viewname progresscoords
+ global commfd viewcomplete viewactive viewname
global viewinstances
unset commfd($inst)
set i [lsearch -exact $viewinstances($view) $inst]
# appeared in the list
closevarcs $view
notbusy $view
- set progresscoords {0 0}
- adjustprogress
}
if {$view == $curview} {
run chewcommits
foreach s $scripts {
eval $s
}
- if {$view == $curview} {
- # update progress bar
- global progressdirn progresscoords proglastnc
- set inc [expr {($commitidx($view) - $proglastnc) * 0.0002}]
- set proglastnc $commitidx($view)
- set l [lindex $progresscoords 0]
- set r [lindex $progresscoords 1]
- if {$progressdirn} {
- set r [expr {$r + $inc}]
- if {$r >= 1.0} {
- set r 1.0
- set progressdirn 0
- }
- if {$r > 0.2} {
- set l [expr {$r - 0.2}]
- }
- } else {
- set l [expr {$l - $inc}]
- if {$l <= 0.0} {
- set l 0.0
- set progressdirn 1
- }
- set r [expr {$l + 0.2}]
- }
- set progresscoords [list $l $r]
- adjustprogress
- }
}
return 2
}
if {$viewcomplete($curview)} {
global commitidx varctok
global numcommits startmsecs
- global mainheadid nullid
if {[info exists pending_select]} {
- set row [first_real_row]
- selectline $row 1
+ update
+ reset_pending_select {}
+
+ if {[commitinview $pending_select $curview]} {
+ selectline [rowofcommit $pending_select] 1
+ } else {
+ set row [first_real_row]
+ selectline $row 1
+ }
}
if {$commitidx($curview) > 0} {
#set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
proc readrefs {} {
global tagids idtags headids idheads tagobjid
global otherrefids idotherrefs mainhead mainheadid
+ global selecthead selectheadid
foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
catch {unset $v}
set mainhead {}
set mainheadid {}
catch {
+ set mainheadid [exec git rev-parse HEAD]
set thehead [exec git symbolic-ref HEAD]
if {[string match "refs/heads/*" $thehead]} {
set mainhead [string range $thehead 11 end]
- if {[info exists headids($mainhead)]} {
- set mainheadid $headids($mainhead)
- }
+ }
+ }
+ set selectheadid {}
+ if {$selecthead ne {}} {
+ catch {
+ set selectheadid [exec git rev-parse --verify $selecthead]
}
}
}
global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
global headctxmenu progresscanv progressitem progresscoords statusw
global fprogitem fprogcoord lastprogupdate progupdatepending
- global rprogitem rprogcoord
+ global rprogitem rprogcoord rownumsel numcommits
global have_tk85
menu .bar
-state disabled -width 26
pack .tf.bar.rightbut -side left -fill y
+ label .tf.bar.rowlabel -text [mc "Row"]
+ set rownumsel {}
+ label .tf.bar.rownum -width 7 -font textfont -textvariable rownumsel \
+ -relief sunken -anchor e
+ label .tf.bar.rowlabel2 -text "/"
+ label .tf.bar.numcommits -width 7 -font textfont -textvariable numcommits \
+ -relief sunken -anchor e
+ pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
+ -side left
+ global selectedline
+ trace add variable selectedline write selectedline_change
+
# Status label and progress bar
set statusw .tf.bar.status
label $statusw -width 15 -relief sunken
bind . <$M1B-minus> {incrfont -1}
bind . <$M1B-KP_Subtract> {incrfont -1}
wm protocol . WM_DELETE_WINDOW doquit
+ bind . <Destroy> {stop_backends}
bind . <Button-1> "click %W"
bind $fstring <Key-Return> {dofind 1 1}
- bind $sha1entry <Key-Return> gotocommit
+ bind $sha1entry <Key-Return> {gotocommit; break}
bind $sha1entry <<PasteSelection>> clearsha1
bind $cflist <1> {sel_flist %W %x %y; break}
bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
- bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
+ global ctxbut
+ bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
set maincursor [. cget -cursor]
set textcursor [$ctext cget -cursor]
-command {flist_hl 1}
$flist_menu add command -label [mc "External diff"] \
-command {external_diff}
+ $flist_menu add command -label [mc "Blame parent commit"] \
+ -command {external_blame 1}
}
# Windows sends all mouse wheel events to the current focused window, not
}
}
+# Update row number label when selectedline changes
+proc selectedline_change {n1 n2 op} {
+ global selectedline rownumsel
+
+ if {$selectedline eq {}} {
+ set rownumsel {}
+ } else {
+ set rownumsel [expr {$selectedline + 1}]
+ }
+}
+
# mouse-2 makes all windows scan vertically, but only the one
# the cursor is in scans horizontally
proc canvscan {op w x y} {
global viewname viewfiles viewargs viewargscmd viewperm nextviewnum
global cmitmode wrapcomment datetimeformat limitdiffs
global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
- global autoselect extdifftool
+ global autoselect extdifftool perfile_attrs
if {$stuffsaved} return
if {![winfo viewable .]} return
puts $f [list set diffcontext $diffcontext]
puts $f [list set selectbgcolor $selectbgcolor]
puts $f [list set extdifftool $extdifftool]
+ puts $f [list set perfile_attrs $perfile_attrs]
puts $f "set geometry(main) [wm geometry .]"
puts $f "set geometry(topwidth) [winfo width .tf]"
$w insert e:$ix $e [highlight_tag $de]
}
}
- $w mark gravity e:$ix left
+ $w mark gravity e:$ix right
$w conf -state disabled
set treediropen($dir) 1
set top [lindex [split [$w index @0,0] .] 0]
if {[string match "fatal: bad revision *" $err]} {
return $nullfile
}
- error_popup "Error getting \"$filename\" from $what: $err"
+ error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
return {}
}
return $output
set gitktmpdir [file join [file dirname $gitdir] \
[format ".gitk-tmp.%s" [pid]]]
if {[catch {file mkdir $gitktmpdir} err]} {
- error_popup "Error creating temporary directory $gitktmpdir: $err"
+ error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
unset gitktmpdir
return
}
incr diffnum
set diffdir [file join $gitktmpdir $diffnum]
if {[catch {file mkdir $diffdir} err]} {
- error_popup "Error creating temporary directory $diffdir: $err"
+ error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
return
}
[list $difffromfile $difftofile]]
if {[catch {set fl [open $cmd r]} err]} {
file delete -force $diffdir
- error_popup [mc "$extdifftool: command failed: $err"]
+ error_popup "$extdifftool: [mc "command failed:"] $err"
} else {
fconfigure $fl -blocking 0
filerun $fl [list delete_at_eof $fl $diffdir]
}
}
+proc external_blame {parent_idx} {
+ global flist_menu_file
+ global nullid nullid2
+ global parentlist selectedline currentid
+
+ if {$parent_idx > 0} {
+ set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
+ } else {
+ set base_commit $currentid
+ }
+
+ if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
+ error_popup [mc "No such commit"]
+ return
+ }
+
+ if {[catch {exec git gui blame $base_commit $flist_menu_file &} err]} {
+ error_popup "[mc "git gui blame: command failed:"] $err"
+ }
+}
+
# delete $dir when we see eof on $f (presumably because the child has exited)
proc delete_at_eof {f dir} {
while {[gets $f line] >= 0} {}
if {[eof $f]} {
if {[catch {close $f} err]} {
- error_popup "External diff viewer failed: $err"
+ error_popup "[mc "External diff viewer failed:"] $err"
}
file delete -force $dir
return 0
set ytop [expr {[lindex $span 0] * $ymax}]
set ybot [expr {[lindex $span 1] * $ymax}]
set yscreen [expr {($ybot - $ytop) / 2}]
- if {[info exists selectedline]} {
+ if {$selectedline ne {}} {
set selid $currentid
set y [yc $selectedline]
if {$ytop < $y && $y < $ybot} {
run refill_reflist
if {![info exists viewcomplete($n)]} {
- if {$selid ne {}} {
- set pending_select $selid
- }
- getcommits
+ getcommits $selid
return
}
drawvisible
if {$row ne {}} {
selectline $row 0
- } elseif {$mainheadid ne {} && [commitinview $mainheadid $curview]} {
- selectline [rowofcommit $mainheadid] 1
} elseif {!$viewcomplete($n)} {
- if {$selid ne {}} {
- set pending_select $selid
- } else {
- set pending_select $mainheadid
- }
+ reset_pending_select $selid
} else {
- set row [first_real_row]
- if {$row < $numcommits} {
- selectline $row 0
+ reset_pending_select {}
+
+ if {[commitinview $pending_select $curview]} {
+ selectline [rowofcommit $pending_select] 1
+ } else {
+ set row [first_real_row]
+ if {$row < $numcommits} {
+ selectline $row 0
+ }
}
}
if {!$viewcomplete($n)} {
lappend boldrows $row
$canv itemconf $linehtag($row) -font $font
- if {[info exists selectedline] && $row == $selectedline} {
+ if {$row == $selectedline} {
$canv delete secsel
set t [eval $canv create rect [$canv bbox $linehtag($row)] \
-outline {{}} -tags secsel \
lappend boldnamerows $row
$canv2 itemconf $linentag($row) -font $font
- if {[info exists selectedline] && $row == $selectedline} {
+ if {$row == $selectedline} {
$canv2 delete secsel
set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
-outline {{}} -tags secsel \
global descendent highlight_related iddrawn rhighlights
global selectedline ancestor
- if {![info exists selectedline]} return
+ if {$selectedline eq {}} return
set isbold 0
if {$highlight_related eq [mc "Descendant"] ||
$highlight_related eq [mc "Not descendant"]} {
proc layoutmore {} {
global commitidx viewcomplete curview
- global numcommits pending_select selectedline curview
+ global numcommits pending_select curview
global lastscrollset lastscrollrows commitinterest
if {$lastscrollrows < 100 || $viewcomplete($curview) ||
}
if {[info exists pending_select] &&
[commitinview $pending_select $curview]} {
+ update
selectline [rowofcommit $pending_select] 1
}
drawvisible
proc doshowlocalchanges {} {
global curview mainheadid
+ if {$mainheadid eq {}} return
if {[commitinview $mainheadid $curview]} {
dodiffindex
} else {
incr lserial
set fd [open "|git diff-index --cached HEAD" r]
fconfigure $fd -blocking 0
- filerun $fd [list readdiffindex $fd $lserial]
+ set i [reg_instance $fd]
+ filerun $fd [list readdiffindex $fd $lserial $i]
}
-proc readdiffindex {fd serial} {
+proc readdiffindex {fd serial inst} {
global mainheadid nullid nullid2 curview commitinfo commitdata lserial
set isdiff 1
set isdiff 0
}
# we only need to see one line and we don't really care what it says...
- close $fd
+ stop_instance $inst
if {$serial != $lserial} {
return 0
# now see if there are any local changes not checked in to the index
set fd [open "|git diff-files" r]
fconfigure $fd -blocking 0
- filerun $fd [list readdifffiles $fd $serial]
+ set i [reg_instance $fd]
+ filerun $fd [list readdifffiles $fd $serial $i]
if {$isdiff && ![commitinview $nullid2 $curview]} {
# add the line for the changes in the index to the graph
return 0
}
-proc readdifffiles {fd serial} {
+proc readdifffiles {fd serial inst} {
global mainheadid nullid nullid2 curview
global commitinfo commitdata lserial
set isdiff 0
}
# we only need to see one line and we don't really care what it says...
- close $fd
+ stop_instance $inst
if {$serial != $lserial} {
return 0
global cmitlisted commitinfo rowidlist parentlist
global rowtextx idpos idtags idheads idotherrefs
global linehtag linentag linedtag selectedline
- global canvxmax boldrows boldnamerows fgcolor nullid nullid2
+ global canvxmax boldrows boldnamerows fgcolor
+ global mainheadid nullid nullid2 circleitem circlecolors ctxbut
# listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
set listed $cmitlisted($curview,$id)
set ofill red
} elseif {$id eq $nullid2} {
set ofill green
+ } elseif {$id eq $mainheadid} {
+ set ofill yellow
} else {
- set ofill [expr {$listed != 0 ? $listed == 2 ? "gray" : "blue" : "white"}]
+ set ofill [lindex $circlecolors $listed]
}
set x [xc $row $col]
set y [yc $row]
[expr {$x - $orad}] [expr {$y + $orad - 1}] \
-fill $ofill -outline $fgcolor -width 1 -tags circle]
}
+ set circleitem($row) $t
$canv raise $t
$canv bind $t <1> {selcanvline {} %x %y}
set rmx [llength [lindex $rowidlist $row]]
}
set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
-text $headline -font $font -tags text]
- $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
+ $canv bind $linehtag($row) $ctxbut "rowmenu %X %Y $id"
set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
-text $name -font $nfont -tags text]
set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
-text $date -font mainfont -tags text]
- if {[info exists selectedline] && $selectedline == $row} {
+ if {$selectedline == $row} {
make_secsel $row
}
set xr [expr {$xt + [font measure $font $headline]}]
if {$endrow >= $vrowmod($curview)} {
update_arcrows $curview
}
- if {[info exists selectedline] &&
+ if {$selectedline ne {} &&
$row <= $selectedline && $selectedline <= $endrow} {
set targetrow $selectedline
} elseif {[info exists targetid]} {
proc clear_display {} {
global iddrawn linesegs need_redisplay nrows_drawn
global vhighlights fhighlights nhighlights rhighlights
+ global linehtag linentag linedtag boldrows boldnamerows
allcanvs delete all
catch {unset iddrawn}
catch {unset linesegs}
+ catch {unset linehtag}
+ catch {unset linentag}
+ catch {unset linedtag}
+ set boldrows {}
+ set boldnamerows {}
catch {unset vhighlights}
catch {unset fhighlights}
catch {unset nhighlights}
proc drawtags {id x xt y1} {
global idtags idheads idotherrefs mainhead
global linespc lthickness
- global canv rowtextx curview fgcolor bgcolor
+ global canv rowtextx curview fgcolor bgcolor ctxbut
set marks {}
set ntags 0
if {$ntags >= 0} {
$canv bind $t <1> [list showtag $tag 1]
} elseif {$nheads >= 0} {
- $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
+ $canv bind $t $ctxbut [list headmenu %X %Y $id $tag]
}
}
return $xt
}
focus .
if {$findstring eq {} || $numcommits == 0} return
- if {![info exists selectedline]} {
+ if {$selectedline eq {}} {
set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
} else {
set findstartline $selectedline
[expr {$x0+$xlen+2}] $y1 \
-outline {} -tags [list match$l matches] -fill yellow]
$canv lower $t
- if {[info exists selectedline] && $row == $selectedline} {
+ if {$row == $selectedline} {
$canv raise $t secsel
}
}
proc dispneartags {delay} {
global selectedline currentid showneartags tagphase
- if {![info exists selectedline] || !$showneartags} return
+ if {$selectedline eq {} || !$showneartags} return
after cancel dispnexttag
if {$delay} {
after 200 dispnexttag
proc dispnexttag {} {
global selectedline currentid showneartags tagphase ctext
- if {![info exists selectedline] || !$showneartags} return
+ if {$selectedline eq {} || !$showneartags} return
switch -- $tagphase {
0 {
set dtags [desctags $currentid]
proc selnextline {dir} {
global selectedline
focus .
- if {![info exists selectedline]} return
+ if {$selectedline eq {}} return
set l [expr {$selectedline + $dir}]
unmarkmatches
selectline $l 1
}
allcanvs yview scroll [expr {$dir * $lpp}] units
drawvisible
- if {![info exists selectedline]} return
+ if {$selectedline eq {}} return
set l [expr {$selectedline + $dir * $lpp}]
if {$l < 0} {
set l 0
proc unselectline {} {
global selectedline currentid
- catch {unset selectedline}
+ set selectedline {}
catch {unset currentid}
allcanvs delete secsel
rhighlight_none
proc reselectline {} {
global selectedline
- if {[info exists selectedline]} {
+ if {$selectedline ne {}} {
selectline $selectedline 0
}
}
set treepending $id
set treefilelist($id) {}
set treeidlist($id) {}
- fconfigure $gtf -blocking 0
+ fconfigure $gtf -blocking 0 -encoding binary
filerun $gtf [list gettreeline $gtf $id]
}
} else {
set line [string range $line 0 [expr {$i-1}]]
if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
set sha1 [lindex $line 2]
- if {[string index $fname 0] eq "\""} {
- set fname [lindex $fname 0]
- }
lappend treeidlist($id) $sha1
}
+ if {[string index $fname 0] eq "\""} {
+ set fname [lindex $fname 0]
+ }
+ set fname [encoding convertfrom $fname]
lappend treefilelist($id) $fname
}
if {![eof $gtf]} {
return
}
}
- fconfigure $bf -blocking 0
+ fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
filerun $bf [list getblobline $bf $diffids]
$ctext config -state normal
clear_ctext $commentend
global diffids
global parents
global diffcontext
+ global diffencoding
global limitdiffs vfilelimit curview
set diffmergeid $id
error_popup "[mc "Error getting merge diffs:"] $err"
return
}
- fconfigure $mdf -blocking 0
+ fconfigure $mdf -blocking 0 -encoding binary
set mdifffd($id) $mdf
set np [llength $parents($curview,$id)]
+ set diffencoding [get_path_encoding {}]
settabs $np
filerun $mdf [list getmergediffline $mdf $id $np]
}
proc getmergediffline {mdf id np} {
global diffmergeid ctext cflist mergemax
global difffilestart mdifffd
+ global diffencoding
$ctext conf -state normal
set nr 0
}
if {[regexp {^diff --cc (.*)} $line match fname]} {
# start of a new file
+ set fname [encoding convertfrom $fname]
$ctext insert end "\n"
set here [$ctext index "end - 1c"]
lappend difffilestart $here
add_flist [list $fname]
+ set diffencoding [get_path_encoding $fname]
set l [expr {(78 - [string length $fname]) / 2}]
set pad [string range "----------------------------------------" 1 $l]
$ctext insert end "$pad $fname $pad\n" filesep
} elseif {[regexp {^@@} $line]} {
+ set line [encoding convertfrom $diffencoding $line]
$ctext insert end "$line\n" hunksep
} elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
# do nothing
} else {
+ set line [encoding convertfrom $diffencoding $line]
# parse the prefix - one ' ', '-' or '+' for each parent
set spaces {}
set minuses {}
proc gettreediffs {ids} {
global treediff treepending
+ if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
+
set treepending $ids
set treediff {}
- if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
- fconfigure $gdtf -blocking 0
+ fconfigure $gdtf -blocking 0 -encoding binary
filerun $gdtf [list gettreediffline $gdtf $ids]
}
proc gettreediffline {gdtf ids} {
global treediff treediffs treepending diffids diffmergeid
- global cmitmode vfilelimit curview limitdiffs
+ global cmitmode vfilelimit curview limitdiffs perfile_attrs
set nr 0
- while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
+ set sublist {}
+ set max 1000
+ if {$perfile_attrs} {
+ # cache_gitattr is slow, and even slower on win32 where we
+ # have to invoke it for only about 30 paths at a time
+ set max 500
+ if {[tk windowingsystem] == "win32"} {
+ set max 120
+ }
+ }
+ while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
set i [string first "\t" $line]
if {$i >= 0} {
set file [string range $line [expr {$i+1}] end]
if {[string index $file 0] eq "\""} {
set file [lindex $file 0]
}
+ set file [encoding convertfrom $file]
lappend treediff $file
+ lappend sublist $file
}
}
+ if {$perfile_attrs} {
+ cache_gitattr encoding $sublist
+ }
if {![eof $gdtf]} {
- return [expr {$nr >= 1000? 2: 1}]
+ return [expr {$nr >= $max? 2: 1}]
}
close $gdtf
if {$limitdiffs && $vfilelimit($curview) ne {}} {
global diffcontext
global ignorespace
global limitdiffs vfilelimit curview
+ global diffencoding
set cmd [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"]
if {$ignorespace} {
return
}
set diffinhdr 0
- fconfigure $bdf -blocking 0
+ set diffencoding [get_path_encoding {}]
+ fconfigure $bdf -blocking 0 -encoding binary
set blobdifffd($ids) $bdf
filerun $bdf [list getblobdiffline $bdf $diffids]
}
global diffids blobdifffd ctext curdiffstart
global diffnexthead diffnextnote difffilestart
global diffinhdr treediffs
+ global diffencoding
set nr 0
$ctext conf -state normal
} else {
set fname [string range $line 2 [expr {$i - 1}]]
}
+ set fname [encoding convertfrom $fname]
+ set diffencoding [get_path_encoding $fname]
makediffhdr $fname $ids
} elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
$line match f1l f1c f2l f2c rest]} {
+ set line [encoding convertfrom $diffencoding $line]
$ctext insert end "$line\n" hunksep
set diffinhdr 0
if {[string index $fname 0] eq "\""} {
set fname [lindex $fname 0]
}
+ set fname [encoding convertfrom $fname]
set i [lsearch -exact $treediffs($ids) $fname]
if {$i >= 0} {
setinlist difffilestart $i $curdiffstart
if {[string index $fname 0] eq "\""} {
set fname [lindex $fname 0]
}
+ set fname [encoding convertfrom $fname]
+ set diffencoding [get_path_encoding $fname]
makediffhdr $fname $ids
} elseif {[string compare -length 3 $line "---"] == 0} {
# do nothing
$ctext insert end "$line\n" filesep
} else {
+ set line [encoding convertfrom $diffencoding $line]
set x [string range $line 0 0]
if {$x == "-" || $x == "+"} {
set tag [expr {$x == "+"}]
setcanvscroll
allcanvs yview moveto [lindex $span 0]
drawvisible
- if {[info exists selectedline]} {
+ if {$selectedline ne {}} {
selectline $selectedline 0
allcanvs yview moveto [lindex $span 0]
}
stopfinding
set rowmenuid $id
- if {![info exists selectedline]
- || [rowofcommit $id] eq $selectedline} {
+ if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
set state disabled
} else {
set state normal
proc diffvssel {dirn} {
global rowmenuid selectedline
- if {![info exists selectedline]} return
+ if {$selectedline eq {}} return
if {$dirn} {
set oldid [commitonrow $selectedline]
set newid $rowmenuid
}
proc redrawtags {id} {
- global canv linehtag idpos currentid curview
- global canvxmax iddrawn
+ global canv linehtag idpos currentid curview cmitlisted
+ global canvxmax iddrawn circleitem mainheadid circlecolors
if {![commitinview $id $curview]} return
if {![info exists iddrawn($id)]} return
set row [rowofcommit $id]
+ if {$id eq $mainheadid} {
+ set ofill yellow
+ } else {
+ set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
+ }
+ $canv itemconf $circleitem($row) -fill $ofill
$canv delete tag.$id
set xt [eval drawtags $id $idpos($id)]
$canv coords $linehtag($row) $xt [lindex $idpos($id) 2]
if {$mainhead ne {}} {
movehead $newhead $mainhead
movedhead $newhead $mainhead
- set mainheadid $newhead
}
+ set mainheadid $newhead
redrawtags $oldhead
redrawtags $newhead
selbyid $newhead
tkwait window $w
if {!$confirm_ok} return
if {[catch {set fd [open \
- [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
+ [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
error_popup $err
} else {
dohidelocalchanges
}
proc cobranch {} {
- global headmenuid headmenuhead mainhead headids
+ global headmenuid headmenuhead headids
global showlocalchanges mainheadid
# check the tree is clean first??
- set oldmainhead $mainhead
nowbusy checkout [mc "Checking out"]
update
dohidelocalchanges
if {[catch {
- exec git checkout -q $headmenuhead
+ set fd [open [list | git checkout $headmenuhead 2>@1] r]
} err]} {
notbusy checkout
error_popup $err
+ if {$showlocalchanges} {
+ dodiffindex
+ }
} else {
- notbusy checkout
- set mainhead $headmenuhead
- set mainheadid $headmenuid
- if {[info exists headids($oldmainhead)]} {
- redrawtags $headids($oldmainhead)
+ filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
+ }
+}
+
+proc readcheckoutstat {fd newhead newheadid} {
+ global mainhead mainheadid headids showlocalchanges progresscoords
+
+ if {[gets $fd line] >= 0} {
+ if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
+ set progresscoords [list 0 [expr {1.0 * $m / $n}]]
+ adjustprogress
}
- redrawtags $headmenuid
- selbyid $headmenuid
+ return 1
}
+ set progresscoords {0 0}
+ adjustprogress
+ notbusy checkout
+ if {[catch {close $fd} err]} {
+ error_popup $err
+ }
+ set oldmainid $mainheadid
+ set mainhead $newhead
+ set mainheadid $newheadid
+ redrawtags $oldmainid
+ redrawtags $newheadid
+ selbyid $newheadid
if {$showlocalchanges} {
dodiffindex
}
[array names idheads] [array names idotherrefs]]]
foreach id $refids {
set v [listrefs $id]
- if {![info exists ref($id)] || $ref($id) != $v ||
- ($id eq $oldmainhead && $id ne $mainheadid) ||
- ($id eq $mainheadid && $id ne $oldmainhead)} {
+ if {![info exists ref($id)] || $ref($id) != $v} {
redrawtags $id
}
}
+ if {$oldmainhead ne $mainheadid} {
+ redrawtags $oldmainhead
+ redrawtags $mainheadid
+ }
run refill_reflist
}
global maxwidth maxgraphpct
global oldprefs prefstop showneartags showlocalchanges
global bgcolor fgcolor ctext diffcolors selectbgcolor
- global tabstop limitdiffs autoselect extdifftool
+ global tabstop limitdiffs autoselect extdifftool perfile_attrs
set top .gitkprefs
set prefstop $top
return
}
foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
- limitdiffs tabstop} {
+ limitdiffs tabstop perfile_attrs} {
set oldprefs($v) [set $v]
}
toplevel $top
checkbutton $top.ldiff.b -variable limitdiffs
pack $top.ldiff.b $top.ldiff.l -side left
grid x $top.ldiff -sticky w
+ frame $top.lattr
+ label $top.lattr.l -text [mc "Support per-file encodings"] -font optionfont
+ checkbutton $top.lattr.b -variable perfile_attrs
+ pack $top.lattr.b $top.lattr.l -side left
+ grid x $top.lattr -sticky w
entry $top.extdifft -textvariable extdifftool
frame $top.extdifff
global oldprefs prefstop
foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
- limitdiffs tabstop} {
+ limitdiffs tabstop perfile_attrs} {
global $v
set $v $oldprefs($v)
}
global maxwidth maxgraphpct
global oldprefs prefstop showneartags showlocalchanges
global fontpref mainfont textfont uifont
- global limitdiffs treediffs
+ global limitdiffs treediffs perfile_attrs
catch {destroy $prefstop}
unset prefstop
dohidelocalchanges
}
}
- if {$limitdiffs != $oldprefs(limitdiffs)} {
- # treediffs elements are limited by path
+ if {$limitdiffs != $oldprefs(limitdiffs) ||
+ ($perfile_attrs && !$oldprefs(perfile_attrs))} {
+ # treediffs elements are limited by path;
+ # won't have encodings cached if perfile_attrs was just turned on
catch {unset treediffs}
}
if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
{ ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
{ GBK CP936 MS936 windows-936 }
{ JIS_Encoding csJISEncoding }
- { Shift_JIS MS_Kanji csShiftJIS }
+ { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
{ Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
EUC-JP }
{ Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
}
proc tcl_encoding {enc} {
- global encoding_aliases
+ global encoding_aliases tcl_encoding_cache
+ if {[info exists tcl_encoding_cache($enc)]} {
+ return $tcl_encoding_cache($enc)
+ }
set names [encoding names]
set lcnames [string tolower $names]
set enc [string tolower $enc]
set i [lsearch -exact $lcnames $enc]
if {$i < 0} {
# look for "isonnn" instead of "iso-nnn" or "iso_nnn"
- if {[regsub {^iso[-_]} $enc iso encx]} {
+ if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
set i [lsearch -exact $lcnames $encx]
}
}
foreach e $ll {
set i [lsearch -exact $lcnames $e]
if {$i < 0} {
- if {[regsub {^iso[-_]} $e iso ex]} {
+ if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
set i [lsearch -exact $lcnames $ex]
}
}
break
}
}
+ set tclenc {}
if {$i >= 0} {
- return [lindex $names $i]
+ set tclenc [lindex $names $i]
}
- return {}
+ set tcl_encoding_cache($enc) $tclenc
+ return $tclenc
+}
+
+proc gitattr {path attr default} {
+ global path_attr_cache
+ if {[info exists path_attr_cache($attr,$path)]} {
+ set r $path_attr_cache($attr,$path)
+ } else {
+ set r "unspecified"
+ if {![catch {set line [exec git check-attr $attr -- $path]}]} {
+ regexp "(.*): encoding: (.*)" $line m f r
+ }
+ set path_attr_cache($attr,$path) $r
+ }
+ if {$r eq "unspecified"} {
+ return $default
+ }
+ return $r
+}
+
+proc cache_gitattr {attr pathlist} {
+ global path_attr_cache
+ set newlist {}
+ foreach path $pathlist {
+ if {![info exists path_attr_cache($attr,$path)]} {
+ lappend newlist $path
+ }
+ }
+ set lim 1000
+ if {[tk windowingsystem] == "win32"} {
+ # windows has a 32k limit on the arguments to a command...
+ set lim 30
+ }
+ while {$newlist ne {}} {
+ set head [lrange $newlist 0 [expr {$lim - 1}]]
+ set newlist [lrange $newlist $lim end]
+ if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
+ foreach row [split $rlist "\n"] {
+ if {[regexp "(.*): encoding: (.*)" $row m path value]} {
+ if {[string index $path 0] eq "\""} {
+ set path [encoding convertfrom [lindex $path 0]]
+ }
+ set path_attr_cache($attr,$path) $value
+ }
+ }
+ }
+ }
+}
+
+proc get_path_encoding {path} {
+ global gui_encoding perfile_attrs
+ set tcl_enc $gui_encoding
+ if {$path ne {} && $perfile_attrs} {
+ set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
+ if {$enc2 ne {}} {
+ set tcl_enc $enc2
+ }
+ }
+ return $tcl_enc
}
# First check that Tcl/Tk is recent enough
puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
}
+set gui_encoding [encoding system]
+catch {
+ set enc [exec git config --get gui.encoding]
+ if {$enc ne {}} {
+ set tclenc [tcl_encoding $enc]
+ if {$tclenc ne {}} {
+ set gui_encoding $tclenc
+ } else {
+ puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
+ }
+ }
+}
+
set mainfont {Helvetica 9}
set textfont {Courier 9}
set uifont {Helvetica 9 bold}
set limitdiffs 1
set datetimeformat "%Y-%m-%d %H:%M:%S"
set autoselect 1
+set perfile_attrs 0
set extdifftool "meld"
set ignorespace 0
set selectbgcolor gray85
+set circlecolors {white blue gray blue blue}
+
+# button for popping up context menus
+if {[tk windowingsystem] eq "aqua"} {
+ set ctxbut <Button-2>
+} else {
+ set ctxbut <Button-3>
+}
+
## For msgcat loading, first locate the installation location.
if { [info exists ::env(GITK_MSGSDIR)] } {
## Msgsdir was manually set in the environment.
exit 1
}
+set selecthead {}
+set selectheadid {}
+
set revtreeargs {}
set cmdline_files {}
set i 0
set cmdline_files [lrange $argv [expr {$i + 1}] end]
break
}
+ "--select-commit=*" {
+ set selecthead [string range $arg 16 end]
+ }
"--argscmd=*" {
set revtreeargscmd [string range $arg 10 end]
}
incr i
}
+if {$selecthead eq "HEAD"} {
+ set selecthead {}
+}
+
if {$i >= [llength $argv] && $revtreeargs ne {}} {
# no -- on command line, but some arguments (other than --argscmd)
if {[catch {
set viewargs(0) {}
set viewargscmd(0) {}
+set selectedline {}
+set numcommits 0
set loginstance 0
set cmdlineok 0
set stopped 0
addviewmenu $n
}
}
-getcommits
+getcommits {}