proc start_rev_list {view} {
global startmsecs nextupdate ncmupdate
global commfd leftover tclencoding datemode
- global revtreeargs viewfiles commitidx
+ global viewargs viewfiles commitidx
set startmsecs [clock clicks -milliseconds]
set nextupdate [expr {$startmsecs + 100}]
set ncmupdate 1
set commitidx($view) 0
- set args $revtreeargs
+ set args $viewargs($view)
if {$viewfiles($view) ne {}} {
set args [concat $args "--" $viewfiles($view)]
}
set order "--date-order"
}
if {[catch {
- set fd [open [concat | git-rev-list --header $order \
+ set fd [open [concat | git rev-list --header $order \
--parents --boundary --default HEAD $args] r]
} err]} {
- puts stderr "Error executing git-rev-list: $err"
+ puts stderr "Error executing git rev-list: $err"
exit 1
}
set commfd($view) $fd
set phase getcommits
initlayout
start_rev_list $curview
- $canv delete all
- $canv create text 3 3 -anchor nw -text "Reading commits..." \
- -font $mainfont -tags textitems
+ show_status "Reading commits..."
}
proc getcommitlines {fd view} {
set stuff [read $fd]
if {$stuff == {}} {
if {![eof $fd]} return
+ global viewname
unset commfd($view)
+ notbusy $view
# set it blocking so we wait for the process to terminate
fconfigure $fd -blocking 1
- if {![catch {close $fd} err]} {
- notbusy $view
- if {$view == $curview} {
- after idle finishcommits
+ if {[catch {close $fd} err]} {
+ set fv {}
+ if {$view != $curview} {
+ set fv " for the \"$viewname($view)\" view"
}
- return
+ if {[string range $err 0 4] == "usage"} {
+ set err "Gitk: error reading commits$fv:\
+ bad arguments to git rev-list."
+ if {$viewname($view) eq "Command line"} {
+ append err \
+ " (Note: arguments to gitk are passed to git rev-list\
+ to allow selection of commits to be displayed.)"
+ }
+ } else {
+ set err "Error reading commits$fv: $err"
+ }
+ error_popup $err
}
- 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.)"
- } else {
- set err "Error reading commits: $err"
+ if {$view == $curview} {
+ after idle finishcommits
}
- error_popup $err
- exit 1
+ return
}
set start 0
set gotsome 0
if {[string length $shortcmit] > 80} {
set shortcmit "[string range $shortcmit 0 80]..."
}
- error_popup "Can't parse git-rev-list output: {$shortcmit}"
+ error_popup "Can't parse git rev-list output: {$shortcmit}"
exit 1
}
set id [lindex $ids 0]
}
proc readcommit {id} {
- if {[catch {set contents [exec git-cat-file commit $id]}]} return
+ if {[catch {set contents [exec git cat-file commit $id]}]} return
parsecommit $id $contents 0
}
proc updatecommits {} {
- global viewdata curview revtreeargs phase displayorder
+ global viewdata curview phase displayorder
global children commitrow
if {$phase ne {}} {
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
+ # 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 " "
set type {}
set tag {}
catch {
- set commit [exec git-rev-parse "$id^0"]
+ 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"]
+ set tagcontents($name) [exec git cat-file tag "$id"]
}
} elseif { $type == "heads" } {
set headids($name) $id
close $refd
}
+proc show_error {w top msg} {
+ message $w.m -text $msg -justify center -aspect 400
+ pack $w.m -side top -fill x -padx 20 -pady 20
+ button $w.ok -text OK -command "destroy $top"
+ pack $w.ok -side bottom -fill x
+ bind $top <Visibility> "grab $top; focus $top"
+ bind $top <Key-Return> "destroy $top"
+ tkwait window $top
+}
+
proc error_popup msg {
set w .error
toplevel $w
wm transient $w .
- message $w.m -text $msg -justify center -aspect 400
- pack $w.m -side top -fill x -padx 20 -pady 20
- button $w.ok -text OK -command "destroy $w"
- pack $w.ok -side bottom -fill x
- bind $w <Visibility> "grab $w; focus $w"
- bind $w <Key-Return> "destroy $w"
- tkwait window $w
+ show_error $w $w $msg
}
proc makewindow {} {
global findtype findtypemenu findloc findstring fstring geometry
global entries sha1entry sha1string sha1but
global maincursor textcursor curtextcursor
- global rowctxmenu mergemax
+ global rowctxmenu mergemax wrapcomment
menu .bar
.bar add cascade -label "File" -menu .bar.file
pack $ctext -side left -fill both -expand 1
.ctop.cdet add .ctop.cdet.left
+ $ctext tag conf comment -wrap $wrapcomment
$ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
$ctext tag conf hunksep -fore blue
$ctext tag conf d0 -fore red
global canv canv2 canv3 ctext cflist mainfont textfont uifont
global stuffsaved findmergefiles maxgraphpct
global maxwidth
- global viewname viewfiles viewperm nextviewnum
- global cmitmode
+ global viewname viewfiles viewargs viewperm nextviewnum
+ global cmitmode wrapcomment
if {$stuffsaved} return
if {![winfo viewable .]} return
puts $f [list set maxgraphpct $maxgraphpct]
puts $f [list set maxwidth $maxwidth]
puts $f [list set cmitmode $cmitmode]
+ puts $f [list set wrapcomment $wrapcomment]
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 -nonewline $f "set permviews {"
for {set v 0} {$v < $nextviewnum} {incr v} {
if {$viewperm($v)} {
- puts $f "{[list $viewname($v) $viewfiles($v)]}"
+ puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
}
}
puts $f "}"
}
}
+# Functions for adding and removing shell-type quoting
+
+proc shellquote {str} {
+ if {![string match "*\['\"\\ \t]*" $str]} {
+ return $str
+ }
+ if {![string match "*\['\"\\]*" $str]} {
+ return "\"$str\""
+ }
+ if {![string match "*'*" $str]} {
+ return "'$str'"
+ }
+ return "\"[string map {\" \\\" \\ \\\\} $str]\""
+}
+
+proc shellarglist {l} {
+ set str {}
+ foreach a $l {
+ if {$str ne {}} {
+ append str " "
+ }
+ append str [shellquote $a]
+ }
+ return $str
+}
+
+proc shelldequote {str} {
+ set ret {}
+ set used -1
+ while {1} {
+ incr used
+ if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
+ append ret [string range $str $used end]
+ set used [string length $str]
+ break
+ }
+ set first [lindex $first 0]
+ set ch [string index $str $first]
+ if {$first > $used} {
+ append ret [string range $str $used [expr {$first - 1}]]
+ set used $first
+ }
+ if {$ch eq " " || $ch eq "\t"} break
+ incr used
+ if {$ch eq "'"} {
+ set first [string first "'" $str $used]
+ if {$first < 0} {
+ error "unmatched single-quote"
+ }
+ append ret [string range $str $used [expr {$first - 1}]]
+ set used $first
+ continue
+ }
+ if {$ch eq "\\"} {
+ if {$used >= [string length $str]} {
+ error "trailing backslash"
+ }
+ append ret [string index $str $used]
+ continue
+ }
+ # here ch == "\""
+ while {1} {
+ if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
+ error "unmatched double-quote"
+ }
+ set first [lindex $first 0]
+ set ch [string index $str $first]
+ if {$first > $used} {
+ append ret [string range $str $used [expr {$first - 1}]]
+ set used $first
+ }
+ if {$ch eq "\""} break
+ incr used
+ append ret [string index $str $used]
+ incr used
+ }
+ }
+ return [list $used $ret]
+}
+
+proc shellsplit {str} {
+ set l {}
+ while {1} {
+ set str [string trimleft $str]
+ if {$str eq {}} break
+ set dq [shelldequote $str]
+ set n [lindex $dq 0]
+ set word [lindex $dq 1]
+ set str [string range $str $n end]
+ lappend l $word
+ }
+ return $l
+}
+
# Code to implement multiple views
proc newview {ishighlight} {
global nextviewnum newviewname newviewperm uifont newishighlight
+ global newviewargs revtreeargs
set newishighlight $ishighlight
set top .gitkview
}
set newviewname($nextviewnum) "View $nextviewnum"
set newviewperm($nextviewnum) 0
+ set newviewargs($nextviewnum) [shellarglist $revtreeargs]
vieweditor $top $nextviewnum "Gitk view definition"
}
proc editview {} {
global curview
global viewname viewperm newviewname newviewperm
+ global viewargs newviewargs
set top .gitkvedit-$curview
if {[winfo exists $top]} {
}
set newviewname($curview) $viewname($curview)
set newviewperm($curview) $viewperm($curview)
+ set newviewargs($curview) [shellarglist $viewargs($curview)]
vieweditor $top $curview "Gitk: edit view $viewname($curview)"
}
grid $top.nl $top.name -sticky w -pady 5
checkbutton $top.perm -text "Remember this view" -variable newviewperm($n)
grid $top.perm - -pady 5 -sticky w
- message $top.l -aspect 500 -font $uifont \
+ message $top.al -aspect 1000 -font $uifont \
+ -text "Commits to include (arguments to git rev-list):"
+ grid $top.al - -sticky w -pady 5
+ entry $top.args -width 50 -textvariable newviewargs($n) \
+ -background white
+ grid $top.args - -sticky ew -padx 5
+ message $top.l -aspect 1000 -font $uifont \
-text "Enter files and directories to include, one per line:"
grid $top.l - -sticky w
text $top.t -width 40 -height 10 -background white
$top.t delete {end - 1c} end
$top.t mark set insert 0.0
}
- grid $top.t - -sticky w -padx 5
+ grid $top.t - -sticky ew -padx 5
frame $top.buts
button $top.buts.ok -text "OK" -command [list newviewok $top $n]
button $top.buts.can -text "Cancel" -command [list destroy $top]
}
proc allviewmenus {n op args} {
- doviewmenu .bar.view 6 [list showview $n] $op $args
+ doviewmenu .bar.view 7 [list showview $n] $op $args
doviewmenu .bar.view.hl 3 [list addhighlight $n] $op $args
}
proc newviewok {top n} {
global nextviewnum newviewperm newviewname newishighlight
global viewname viewfiles viewperm selectedview curview
+ global viewargs newviewargs
+ if {[catch {
+ set newargs [shellsplit $newviewargs($n)]
+ } err]} {
+ error_popup "Error in commit selection arguments: $err"
+ wm raise $top
+ focus $top
+ return
+ }
set files {}
foreach f [split [$top.t get 0.0 end] "\n"] {
set ft [string trim $f]
set viewname($n) $newviewname($n)
set viewperm($n) $newviewperm($n)
set viewfiles($n) $files
+ set viewargs($n) $newargs
addviewmenu $n
if {!$newishighlight} {
after idle showview $n
set viewname($n) $newviewname($n)
allviewmenus $n entryconf -label $viewname($n)
}
- if {$files ne $viewfiles($n)} {
+ if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
set viewfiles($n) $files
+ set viewargs($n) $newargs
if {$curview == $n} {
after idle updatecommits
}
set curview $n
set selectedview $n
set selectedhlview -1
- .bar.view entryconf 1 -state [expr {$n == 0? "disabled": "normal"}]
.bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
+ .bar.view entryconf 3 -state [expr {$n == 0? "disabled": "normal"}]
catch {unset hlview}
.bar.view.hl entryconf 1 -state disabled
selectline $row 0
if {$phase ne {}} {
if {$phase eq "getcommits"} {
- global mainfont
- $canv create text 3 3 -anchor nw -text "Reading commits..." \
- -font $mainfont -tags textitems
+ show_status "Reading commits..."
}
if {[info exists commfd($n)]} {
layoutmore
} else {
finishcommits
}
+ } elseif {$numcommits == 0} {
+ show_status "No commits selected"
}
}
return $x
}
+proc show_status {msg} {
+ global canv mainfont
+
+ clear_display
+ $canv create text 3 3 -anchor nw -text $msg -font $mainfont -tags textitems
+}
+
proc finishcommits {} {
global commitidx phase curview
global canv mainfont ctext maincursor textcursor
if {$commitidx($curview) > 0} {
drawrest
} else {
- $canv delete all
- $canv create text 3 3 -anchor nw -text "No commits selected" \
- -font $mainfont -tags textitems
+ show_status "No commits selected"
}
set phase {}
catch {unset pending_select}
}
if {[catch {
- set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
+ set f [open [list | git diff-tree --stdin -s -r -S$findstring \
<< $inputids] r]
} err]} {
error_popup "Error starting search process: $err"
return
}
if {![regexp {^[0-9a-f]{40}} $line id]} {
- error_popup "Can't parse git-diff-tree output: $line"
+ error_popup "Can't parse git diff-tree output: $line"
stopfindproc
return
}
if {$l == $findstartline} break
}
- # start off a git-diff-tree process if needed
+ # start off a git diff-tree process if needed
if {$diffsneeded ne {}} {
if {[catch {
- set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
+ set df [open [list | git diff-tree -r --stdin << $diffsneeded] r]
} err ]} {
error_popup "Error starting search process: $err"
return
if {[catch {close $df} err]} {
stopfindproc
bell
- error_popup "Error in git-diff-tree: $err"
+ error_popup "Error in git diff-tree: $err"
} elseif {[info exists findid]} {
set id $findid
stopfindproc
if {[info exists fdiffid]} {
while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
&& $fdiffpos < [llength $fdiffsneeded]} {
- # git-diff-tree doesn't output anything for a commit
+ # git diff-tree doesn't output anything for a commit
# which doesn't change anything
set nullid [lindex $fdiffsneeded $fdiffpos]
set treediffs($nullid) {}
proc commit_descriptor {p} {
global commitinfo
+ if {![info exists commitinfo($p)]} {
+ getcommit $p
+ }
set l "..."
- if {[info exists commitinfo($p)]} {
+ if {[llength $commitinfo($p)] > 1} {
set l [lindex $commitinfo($p) 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} {
+proc appendwithlinks {text tags} {
global ctext commitrow linknum curview
set start [$ctext index "end - 1c"]
- $ctext insert end $text
+ $ctext insert end $text $tags
$ctext insert end "\n"
set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
foreach l $links {
$ctext insert end "\n"
}
- set comment {}
+ set headers {}
set olds [lindex $parentlist $l]
if {[llength $olds] > 1} {
set np 0
set tag m$np
}
$ctext insert end "Parent: " $tag
- appendwithlinks [commit_descriptor $p]
+ appendwithlinks [commit_descriptor $p] {}
incr np
}
} else {
foreach p $olds {
- append comment "Parent: [commit_descriptor $p]\n"
+ append headers "Parent: [commit_descriptor $p]\n"
}
}
foreach c [lindex $childlist $l] {
- append comment "Child: [commit_descriptor $c]\n"
+ append headers "Child: [commit_descriptor $c]\n"
}
- append comment "\n"
- append comment [lindex $info 5]
# make anything that looks like a SHA1 ID be a clickable link
- appendwithlinks $comment
+ appendwithlinks $headers {}
+ appendwithlinks [lindex $info 5] {comment}
$ctext tag delete Comments
$ctext tag remove found 1.0 end
set lpp 1
}
allcanvs yview scroll [expr {$dir * $lpp}] units
+ drawvisible
if {![info exists selectedline]} return
set l [expr {$selectedline + $dir * $lpp}]
if {$l < 0} {
catch {unset diffmergeid}
if {![info exists treefilelist($id)]} {
if {![info exists treepending]} {
- if {[catch {set gtf [open [concat | git-ls-tree -r $id] r]}]} {
+ if {[catch {set gtf [open [concat | git ls-tree -r $id] r]}]} {
return
}
set treepending $id
return
}
set blob [lindex $treeidlist($diffids) $i]
- if {[catch {set bf [open [concat | git-cat-file blob $blob] r]} err]} {
+ if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
puts "oops, error reading blob $blob: $err"
return
}
set diffids $id
# this doesn't seem to actually affect anything...
set env(GIT_DIFF_OPTS) $diffopts
- set cmd [concat | git-diff-tree --no-commit-id --cc $id]
+ set cmd [concat | git diff-tree --no-commit-id --cc $id]
if {[catch {set mdf [open $cmd r]} err]} {
error_popup "Error getting merge diffs: $err"
return
set treepending $ids
set treediff {}
if {[catch \
- {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
+ {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 nextupdate diffinhdr treediffs
set env(GIT_DIFF_OPTS) $diffopts
- set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
+ 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 oldid [$patchtop.fromsha1 get]
set newid [$patchtop.tosha1 get]
set fname [$patchtop.fname get]
- if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
+ if {[catch {exec git diff-tree -p $oldid $newid >$fname &} err]} {
error_popup "Error creating patch: $err"
}
catch {destroy $patchtop}
} else {
set text "Tag: $tag\nId: $tagids($tag)"
}
- appendwithlinks $text
+ appendwithlinks $text {}
$ctext conf -state disabled
init_flist {}
}
# defaults...
set datemode 0
set diffopts "-U 5 -p"
-set wrcomcmd "git-diff-tree --stdin -p --pretty"
+set wrcomcmd "git diff-tree --stdin -p --pretty"
set gitencoding {}
catch {
- set gitencoding [exec git-repo-config --get i18n.commitencoding]
+ set gitencoding [exec git repo-config --get i18n.commitencoding]
}
if {$gitencoding == ""} {
set gitencoding "utf-8"
set mingaplen 30
set flistmode "flat"
set cmitmode "patch"
+set wrapcomment "none"
set colors {green red blue magenta darkgrey brown orange}
# check that we can find a .git directory somewhere...
set gitdir [gitdir]
if {![file isdirectory $gitdir]} {
- error_popup "Cannot find the git directory \"$gitdir\"."
+ show_error {} . "Cannot find the git directory \"$gitdir\"."
exit 1
}
+set cmdline_files {}
+set i [lsearch -exact $revtreeargs "--"]
+if {$i >= 0} {
+ set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
+ set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
+} elseif {$revtreeargs ne {}} {
+ if {[catch {
+ set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
+ set cmdline_files [split $f "\n"]
+ set n [llength $cmdline_files]
+ set revtreeargs [lrange $revtreeargs 0 end-$n]
+ } err]} {
+ # unfortunately we get both stdout and stderr in $err,
+ # so look for "fatal:".
+ set i [string first "fatal:" $err]
+ if {$i > 0} {
+ set err [string range $err [expr {$i + 6}] end]
+ }
+ show_error {} . "Bad arguments to gitk:\n$err"
+ exit 1
+ }
+}
+
set history {}
set historyindex 0
set selectedhlview {}
set viewfiles(0) {}
set viewperm(0) 0
+set viewargs(0) {}
+set cmdlineok 0
set stopped 0
set stuffsaved 0
set patchnum 0
makewindow
readrefs
-set cmdline_files {}
-catch {
- set fileargs [eval exec git-rev-parse --no-revs --no-flags $revtreeargs]
- set cmdline_files [split $fileargs "\n"]
- set n [llength $cmdline_files]
- set revtreeargs [lrange $revtreeargs 0 end-$n]
-}
-if {[lindex $revtreeargs end] eq "--"} {
- set revtreeargs [lrange $revtreeargs 0 end-1]
-}
-
-if {$cmdline_files ne {}} {
+if {$cmdline_files ne {} || $revtreeargs ne {}} {
# create a view for the files/dirs specified on the command line
set curview 1
set selectedview 1
set nextviewnum 2
set viewname(1) "Command line"
set viewfiles(1) $cmdline_files
+ set viewargs(1) $revtreeargs
set viewperm(1) 0
addviewmenu 1
- .bar.view entryconf 1 -state normal
.bar.view entryconf 2 -state normal
+ .bar.view entryconf 3 -state normal
}
if {[info exists permviews]} {
incr nextviewnum
set viewname($n) [lindex $v 0]
set viewfiles($n) [lindex $v 1]
+ set viewargs($n) [lindex $v 2]
set viewperm($n) 1
addviewmenu $n
}
projects / git.git / blobdiff