# Tcl ignores the next line -*- tcl -*- \
exec wish "$0" -- "$@"
-# Copyright © 2005-2011 Paul Mackerras. All rights reserved.
+# Copyright © 2005-2014 Paul Mackerras. All rights reserved.
# This program is free software; it may be used, copied, modified
# and distributed under the terms of the GNU General Public Licence,
# either version 2, or (at your option) any later version.
proc parseviewargs {n arglist} {
global vdatemode vmergeonly vflags vdflags vrevs vfiltered vorigargs env
+ global vinlinediff
global worddiff git_version
set vdatemode($n) 0
set vmergeonly($n) 0
+ set vinlinediff($n) 0
set glflags {}
set diffargs {}
set nextisval 0
"--until=*" - "--before=*" - "--max-age=*" - "--min-age=*" -
"--author=*" - "--committer=*" - "--grep=*" - "-[iE]" -
"--remove-empty" - "--first-parent" - "--cherry-pick" -
- "-S*" - "--pickaxe-all" - "--pickaxe-regex" -
+ "-S*" - "-G*" - "--pickaxe-all" - "--pickaxe-regex" -
"--simplify-by-decoration" {
# These mean that we get a subset of the commits
set filtered 1
lappend glflags $arg
}
+ "-L*" {
+ # Line-log with 'stuck' argument (unstuck form is
+ # not supported)
+ set filtered 1
+ set vinlinediff($n) 1
+ set allknown 0
+ lappend glflags $arg
+ }
"-n" {
# This appears to be the only one that has a value as a
# separate word following it
if {$revs eq {}} {
set revs HEAD
+ } elseif {[lsearch -exact $revs --all] >= 0} {
+ lappend revs HEAD
}
if {[catch {set ids [eval exec git rev-parse $revs]} err]} {
# we get stdout followed by stderr in $err
set pid [pid $fd]
if {$::tcl_platform(platform) eq {windows}} {
- exec kill -f $pid
+ exec taskkill /pid $pid
} else {
exec kill $pid
}
}
resetvarcs $curview
set selectedline {}
- catch {unset currentid}
- catch {unset thickerline}
- catch {unset treediffs}
+ unset -nocomplain currentid
+ unset -nocomplain thickerline
+ unset -nocomplain treediffs
readrefs
changedrefs
if {$showneartags} {
getallcommits
}
clear_display
- catch {unset commitinterest}
- catch {unset cached_commitrow}
- catch {unset targetid}
+ unset -nocomplain commitinterest
+ unset -nocomplain cached_commitrow
+ unset -nocomplain targetid
setcanvscroll
getcommits $selid
return 0
foreach vd [array names vseedcount $view,*] {
unset vseedcount($vd)
}
- catch {unset ordertok}
+ unset -nocomplain ordertok
}
# returns a list of the commits with no children
set vp $v,$p
if {[llength [lappend children($vp) $id]] > 1} {
set children($vp) [lsort -command [list vtokcmp $v] $children($vp)]
- catch {unset ordertok}
+ unset -nocomplain ordertok
}
fix_reversal $p $a $v
incr commitidx($v)
set displayorder [lrange $displayorder 0 [expr {$vrowmod($v) - 1}]]
set parentlist [lrange $parentlist 0 [expr {$vrowmod($v) - 1}]]
}
- catch {unset cached_commitrow}
+ unset -nocomplain cached_commitrow
}
set narctot [expr {[llength $varctok($v)] - 1}]
set a $varcmod($v)
if {[string range $err 0 4] == "usage"} {
set err "Gitk: error reading commits$fv:\
bad arguments to git log."
- if {$viewname($view) eq "Command line"} {
+ if {$viewname($view) eq [mc "Command line"]} {
append err \
" (Note: arguments to gitk are passed to git log\
to allow selection of commits to be displayed.)"
[vtokcmp $view [lindex $children($vp) end-1] $id] > 0} {
set children($vp) [lsort -command [list vtokcmp $view] \
$children($vp)]
- catch {unset ordertok}
+ unset -nocomplain ordertok
}
if {[info exists varcid($view,$p)]} {
fix_reversal $p $a $view
set comment $newcomment
}
set hasnote [string first "\nNotes:\n" $contents]
+ set diff ""
+ # If there is diff output shown in the git-log stream, split it
+ # out. But get rid of the empty line that always precedes the
+ # diff.
+ set i [string first "\n\ndiff" $comment]
+ if {$i >= 0} {
+ set diff [string range $comment $i+1 end]
+ set comment [string range $comment 0 $i-1]
+ }
set commitinfo($id) [list $headline $auname $audate \
- $comname $comdate $comment $hasnote]
+ $comname $comdate $comment $hasnote $diff]
}
proc getcommit {id} {
global hideremotes
foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
- catch {unset $v}
+ unset -nocomplain $v
}
set refd [open [list | git show-ref -d] r]
while {[gets $refd line] >= 0} {
}
}
-proc show_error {w top msg {mc mc}} {
+proc show_error {w top msg} {
global NS
if {![info exists NS]} {set NS ""}
if {[wm state $top] eq "withdrawn"} { wm deiconify $top }
message $w.m -text $msg -justify center -aspect 400
pack $w.m -side top -fill x -padx 20 -pady 20
- ${NS}::button $w.ok -default active -text [$mc OK] -command "destroy $top"
+ ${NS}::button $w.ok -default active -text [mc OK] -command "destroy $top"
pack $w.ok -side bottom -fill x
bind $top <Visibility> "grab $top; focus $top"
bind $top <Key-Return> "destroy $top"
# build up the bottom bar of upper window
${NS}::label .tf.lbar.flabel -text "[mc "Find"] "
- ${NS}::button .tf.lbar.fnext -text [mc "next"] -command {dofind 1 1}
- ${NS}::button .tf.lbar.fprev -text [mc "prev"] -command {dofind -1 1}
+
+ set bm_down_data {
+ #define down_width 16
+ #define down_height 16
+ static unsigned char down_bits[] = {
+ 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
+ 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
+ 0x87, 0xe1, 0x8e, 0x71, 0x9c, 0x39, 0xb8, 0x1d,
+ 0xf0, 0x0f, 0xe0, 0x07, 0xc0, 0x03, 0x80, 0x01};
+ }
+ image create bitmap bm-down -data $bm_down_data -foreground $uifgcolor
+ ${NS}::button .tf.lbar.fnext -width 26 -command {dofind 1 1}
+ .tf.lbar.fnext configure -image bm-down
+
+ set bm_up_data {
+ #define up_width 16
+ #define up_height 16
+ static unsigned char up_bits[] = {
+ 0x80, 0x01, 0xc0, 0x03, 0xe0, 0x07, 0xf0, 0x0f,
+ 0xb8, 0x1d, 0x9c, 0x39, 0x8e, 0x71, 0x87, 0xe1,
+ 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
+ 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01};
+ }
+ image create bitmap bm-up -data $bm_up_data -foreground $uifgcolor
+ ${NS}::button .tf.lbar.fprev -width 26 -command {dofind -1 1}
+ .tf.lbar.fprev configure -image bm-up
+
${NS}::label .tf.lbar.flab2 -text " [mc "commit"] "
+
pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
-side left -fill y
set gdttype [mc "containing:"]
set gm [makedroplist .tf.lbar.gdttype gdttype \
[mc "containing:"] \
[mc "touching paths:"] \
- [mc "adding/removing string:"]]
+ [mc "adding/removing string:"] \
+ [mc "changing lines matching:"]]
trace add variable gdttype write gdttype_change
pack .tf.lbar.gdttype -side left -fill y
$ctext tag conf msep -font textfontbold
$ctext tag conf found -back $foundbgcolor
$ctext tag conf currentsearchhit -back $currentsearchhitbgcolor
- $ctext tag conf wwrap -wrap word
+ $ctext tag conf wwrap -wrap word -lmargin2 1c
+ $ctext tag conf bold -font textfontbold
.pwbottom add .bleft
if {!$use_ttk} {
} else {
bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
+ bind $ctext <Button> {
+ if {"%b" eq 6} {
+ $ctext xview scroll -5 units
+ } elseif {"%b" eq 7} {
+ $ctext xview scroll 5 units
+ }
+ }
if {[tk windowingsystem] eq "aqua"} {
bindall <MouseWheel> {
set delta [expr {- (%D)}]
bindkey b prevfile
bindkey d "$ctext yview scroll 18 units"
bindkey u "$ctext yview scroll -18 units"
+ bindkey g {$sha1entry delete 0 end; focus $sha1entry}
bindkey / {focus $fstring}
bindkey <Key-KP_Divide> {focus $fstring}
bindkey <Key-Return> {dofind 1 1}
bind $fstring <Key-Return> {dofind 1 1}
bind $sha1entry <Key-Return> {gotocommit; break}
bind $sha1entry <<PasteSelection>> clearsha1
+ bind $sha1entry <<Paste>> 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 $ctext $ctxbut {pop_diff_menu %W %X %Y %x %y}
bind $ctext <Button-1> {focus %W}
bind $ctext <<Selection>> rehighlight_search_results
+ for {set i 1} {$i < 10} {incr i} {
+ bind . <$M1B-Key-$i> [list go_to_parent $i]
+ }
set maincursor [. cget -cursor]
set textcursor [$ctext cget -cursor]
{mc "Compare with marked commit" command compare_commits}
{mc "Diff this -> marked commit" command {diffvsmark 0}}
{mc "Diff marked commit -> this" command {diffvsmark 1}}
+ {mc "Revert this commit" command revert}
}
$rowctxmenu configure -tearoff 0
makemenu $headctxmenu {
{mc "Check out this branch" command cobranch}
{mc "Remove this branch" command rmbranch}
+ {mc "Copy branch name" command {clipboard clear; clipboard append $headmenuhead}}
}
$headctxmenu configure -tearoff 0
{mc "Highlight this only" command {flist_hl 1}}
{mc "External diff" command {external_diff}}
{mc "Blame parent commit" command {external_blame 1}}
+ {mc "Copy path" command {clipboard clear; clipboard append $flist_menu_file}}
}
$flist_menu configure -tearoff 0
}
}
+proc config_check_tmp_exists {tries_left} {
+ global config_file_tmp
+
+ if {[file exists $config_file_tmp]} {
+ incr tries_left -1
+ if {$tries_left > 0} {
+ after 100 [list config_check_tmp_exists $tries_left]
+ } else {
+ error_popup "There appears to be a stale $config_file_tmp\
+ file, which will prevent gitk from saving its configuration on exit.\
+ Please remove it if it is not being used by any existing gitk process."
+ }
+ }
+}
+
+proc config_init_trace {name} {
+ global config_variable_changed config_variable_original
+
+ upvar #0 $name var
+ set config_variable_changed($name) 0
+ set config_variable_original($name) $var
+}
+
+proc config_variable_change_cb {name name2 op} {
+ global config_variable_changed config_variable_original
+
+ upvar #0 $name var
+ if {$op eq "write" &&
+ (![info exists config_variable_original($name)] ||
+ $config_variable_original($name) ne $var)} {
+ set config_variable_changed($name) 1
+ }
+}
+
proc savestuff {w} {
- global canv canv2 canv3 mainfont textfont uifont tabstop
- global stuffsaved findmergefiles maxgraphpct
- global maxwidth showneartags showlocalchanges
- global viewname viewfiles viewargs viewargscmd viewperm nextviewnum
- global cmitmode wrapcomment datetimeformat limitdiffs
- global colors uicolor bgcolor fgcolor diffcolors diffcontext selectbgcolor
- global uifgcolor uifgdisabledcolor
- global headbgcolor headfgcolor headoutlinecolor remotebgcolor
- global tagbgcolor tagfgcolor tagoutlinecolor
- global reflinecolor filesepbgcolor filesepfgcolor
- global mergecolors foundbgcolor currentsearchhitbgcolor
- global linehoverbgcolor linehoverfgcolor linehoveroutlinecolor circlecolors
- global mainheadcirclecolor workingfilescirclecolor indexcirclecolor
- global linkfgcolor circleoutlinecolor
- global autoselect autosellen extdifftool perfile_attrs markbgcolor use_ttk
- global hideremotes want_ttk maxrefs
+ global stuffsaved
+ global config_file config_file_tmp
+ global config_variables config_variable_changed
+ global viewchanged
+
+ upvar #0 viewname current_viewname
+ upvar #0 viewfiles current_viewfiles
+ upvar #0 viewargs current_viewargs
+ upvar #0 viewargscmd current_viewargscmd
+ upvar #0 viewperm current_viewperm
+ upvar #0 nextviewnum current_nextviewnum
+ upvar #0 use_ttk current_use_ttk
if {$stuffsaved} return
if {![winfo viewable .]} return
- catch {
- if {[file exists ~/.gitk-new]} {file delete -force ~/.gitk-new}
- set f [open "~/.gitk-new" w]
+ set remove_tmp 0
+ if {[catch {
+ set try_count 0
+ while {[catch {set f [open $config_file_tmp {WRONLY CREAT EXCL}]}]} {
+ if {[incr try_count] > 50} {
+ error "Unable to write config file: $config_file_tmp exists"
+ }
+ after 100
+ }
+ set remove_tmp 1
if {$::tcl_platform(platform) eq {windows}} {
- file attributes "~/.gitk-new" -hidden true
- }
- puts $f [list set mainfont $mainfont]
- puts $f [list set textfont $textfont]
- puts $f [list set uifont $uifont]
- puts $f [list set tabstop $tabstop]
- puts $f [list set findmergefiles $findmergefiles]
- 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 [list set autoselect $autoselect]
- puts $f [list set autosellen $autosellen]
- puts $f [list set showneartags $showneartags]
- puts $f [list set maxrefs $maxrefs]
- puts $f [list set hideremotes $hideremotes]
- puts $f [list set showlocalchanges $showlocalchanges]
- puts $f [list set datetimeformat $datetimeformat]
- puts $f [list set limitdiffs $limitdiffs]
- puts $f [list set uicolor $uicolor]
- puts $f [list set want_ttk $want_ttk]
- puts $f [list set bgcolor $bgcolor]
- puts $f [list set fgcolor $fgcolor]
- puts $f [list set uifgcolor $uifgcolor]
- puts $f [list set uifgdisabledcolor $uifgdisabledcolor]
- puts $f [list set colors $colors]
- puts $f [list set diffcolors $diffcolors]
- puts $f [list set mergecolors $mergecolors]
- puts $f [list set markbgcolor $markbgcolor]
- puts $f [list set diffcontext $diffcontext]
- puts $f [list set selectbgcolor $selectbgcolor]
- puts $f [list set foundbgcolor $foundbgcolor]
- puts $f [list set currentsearchhitbgcolor $currentsearchhitbgcolor]
- puts $f [list set extdifftool $extdifftool]
- puts $f [list set perfile_attrs $perfile_attrs]
- puts $f [list set headbgcolor $headbgcolor]
- puts $f [list set headfgcolor $headfgcolor]
- puts $f [list set headoutlinecolor $headoutlinecolor]
- puts $f [list set remotebgcolor $remotebgcolor]
- puts $f [list set tagbgcolor $tagbgcolor]
- puts $f [list set tagfgcolor $tagfgcolor]
- puts $f [list set tagoutlinecolor $tagoutlinecolor]
- puts $f [list set reflinecolor $reflinecolor]
- puts $f [list set filesepbgcolor $filesepbgcolor]
- puts $f [list set filesepfgcolor $filesepfgcolor]
- puts $f [list set linehoverbgcolor $linehoverbgcolor]
- puts $f [list set linehoverfgcolor $linehoverfgcolor]
- puts $f [list set linehoveroutlinecolor $linehoveroutlinecolor]
- puts $f [list set mainheadcirclecolor $mainheadcirclecolor]
- puts $f [list set workingfilescirclecolor $workingfilescirclecolor]
- puts $f [list set indexcirclecolor $indexcirclecolor]
- puts $f [list set circlecolors $circlecolors]
- puts $f [list set linkfgcolor $linkfgcolor]
- puts $f [list set circleoutlinecolor $circleoutlinecolor]
+ file attributes $config_file_tmp -hidden true
+ }
+ if {[file exists $config_file]} {
+ source $config_file
+ }
+ foreach var_name $config_variables {
+ upvar #0 $var_name var
+ upvar 0 $var_name old_var
+ if {!$config_variable_changed($var_name) && [info exists old_var]} {
+ puts $f [list set $var_name $old_var]
+ } else {
+ puts $f [list set $var_name $var]
+ }
+ }
puts $f "set geometry(main) [wm geometry .]"
puts $f "set geometry(state) [wm state .]"
puts $f "set geometry(topwidth) [winfo width .tf]"
puts $f "set geometry(topheight) [winfo height .tf]"
- if {$use_ttk} {
+ if {$current_use_ttk} {
puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sashpos 0] 1\""
puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sashpos 1] 1\""
} else {
puts $f "set geometry(botwidth) [winfo width .bleft]"
puts $f "set geometry(botheight) [winfo height .bleft]"
+ array set view_save {}
+ array set views {}
+ if {![info exists permviews]} { set permviews {} }
+ foreach view $permviews {
+ set view_save([lindex $view 0]) 1
+ set views([lindex $view 0]) $view
+ }
puts -nonewline $f "set permviews {"
- for {set v 0} {$v < $nextviewnum} {incr v} {
- if {$viewperm($v)} {
- puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v) $viewargscmd($v)]}"
+ for {set v 1} {$v < $current_nextviewnum} {incr v} {
+ if {$viewchanged($v)} {
+ if {$current_viewperm($v)} {
+ set views($current_viewname($v)) [list $current_viewname($v) $current_viewfiles($v) $current_viewargs($v) $current_viewargscmd($v)]
+ } else {
+ set view_save($current_viewname($v)) 0
+ }
+ }
+ }
+ # write old and updated view to their places and append remaining to the end
+ foreach view $permviews {
+ set view_name [lindex $view 0]
+ if {$view_save($view_name)} {
+ puts $f "{$views($view_name)}"
}
+ unset views($view_name)
+ }
+ foreach view_name [array names views] {
+ puts $f "{$views($view_name)}"
}
puts $f "}"
close $f
- file rename -force "~/.gitk-new" "~/.gitk"
+ file rename -force $config_file_tmp $config_file
+ set remove_tmp 0
+ } err]} {
+ puts "Error saving config: $err"
+ }
+ if {$remove_tmp} {
+ file delete -force $config_file_tmp
}
set stuffsaved 1
}
message $w.m -text [mc "
Gitk - a commit viewer for git
-Copyright \u00a9 2005-2011 Paul Mackerras
+Copyright \u00a9 2005-2014 Paul Mackerras
Use and redistribute under the terms of the GNU General Public License"] \
-justify center -aspect 400 -border 2 -bg white -relief groove
[mc "<Down>, n, j Move down one commit"]
[mc "<Left>, z, h Go back in history list"]
[mc "<Right>, x, l Go forward in history list"]
+[mc "<%s-n> Go to n-th parent of current commit in history list" $M1T]
[mc "<PageUp> Move up one page in commit list"]
[mc "<PageDown> Move down one page in commit list"]
[mc "<%s-Home> Scroll to top of commit list" $M1T]
[mc "<%s-F> Find" $M1T]
[mc "<%s-G> Move to next find hit" $M1T]
[mc "<Return> Move to next find hit"]
+[mc "g Go to commit"]
[mc "/ Focus the search box"]
[mc "? Move to previous find hit"]
[mc "f Scroll diff view to next file"]
set cflist_top 1
$cflist tag add highlight 1.0 "1.0 lineend"
} else {
- catch {unset cflist_top}
+ unset -nocomplain cflist_top
}
$cflist conf -state disabled
set difffilestart {}
}
proc gitknewtmpdir {} {
- global diffnum gitktmpdir gitdir
+ global diffnum gitktmpdir gitdir env
if {![info exists gitktmpdir]} {
- set gitktmpdir [file join $gitdir [format ".gitk-tmp.%s" [pid]]]
+ if {[info exists env(GITK_TMPDIR)]} {
+ set tmpdir $env(GITK_TMPDIR)
+ } elseif {[info exists env(TMPDIR)]} {
+ set tmpdir $env(TMPDIR)
+ } else {
+ set tmpdir $gitdir
+ }
+ set gitktmpformat [file join $tmpdir ".gitk-tmp.XXXXXX"]
+ if {[catch {set gitktmpdir [exec mktemp -d $gitktmpformat]}]} {
+ set gitktmpdir [file join $gitdir [format ".gitk-tmp.%s" [pid]]]
+ }
if {[catch {file mkdir $gitktmpdir} err]} {
error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
unset gitktmpdir
set id $nullid2
}
if {[commitinview $id $curview]} {
- selectline [rowofcommit $id] 1 [list $fname $lnum]
+ selectline [rowofcommit $id] 1 [list $fname $lnum] 1
} else {
error_popup [mc "That line comes from commit %s, \
which is not in this view" [shortids $id]]
return $l
}
+proc set_window_title {} {
+ global appname curview viewname vrevs
+ set rev [mc "All files"]
+ if {$curview ne 0} {
+ if {$viewname($curview) eq [mc "Command line"]} {
+ set rev [string map {"--gitk-symmetric-diff-marker" "--merge"} $vrevs($curview)]
+ } else {
+ set rev $viewname($curview)
+ }
+ }
+ wm title . "[reponame]: $rev - $appname"
+}
+
# Code to implement multiple views
proc newview {ishighlight} {
{committer t15 . "--committer=*" {mc "Committer:"}}
{loginfo t15 .. "--grep=*" {mc "Commit Message:"}}
{allmatch b .. "--all-match" {mc "Matches all Commit Info criteria"}}
+ {igrep b .. "--invert-grep" {mc "Matches no Commit Info criteria"}}
{changes_l l + {} {mc "Changes to Files:"}}
{pickaxe_s r0 . {} {mc "Fixed String"}}
{pickaxe_t r1 . "--pickaxe-regex" {mc "Regular Expression"}}
proc newviewok {top n {apply 0}} {
global nextviewnum newviewperm newviewname newishighlight
- global viewname viewfiles viewperm selectedview curview
+ global viewname viewfiles viewperm viewchanged selectedview curview
global viewargs viewargscmd newviewopts viewhlmenu
if {[catch {
incr nextviewnum
set viewname($n) $newviewname($n)
set viewperm($n) $newviewopts($n,perm)
+ set viewchanged($n) 1
set viewfiles($n) $files
set viewargs($n) $newargs
set viewargscmd($n) $newviewopts($n,cmd)
} else {
# editing an existing view
set viewperm($n) $newviewopts($n,perm)
+ set viewchanged($n) 1
if {$newviewname($n) ne $viewname($n)} {
set viewname($n) $newviewname($n)
doviewmenu .bar.view 5 [list showview $n] \
}
proc delview {} {
- global curview viewperm hlview selectedhlview
+ global curview viewperm hlview selectedhlview viewchanged
if {$curview == 0} return
if {[info exists hlview] && $hlview == $curview} {
}
allviewmenus $curview delete
set viewperm($curview) 0
+ set viewchanged($curview) 1
showview 0
}
}
unselectline
normalline
- catch {unset treediffs}
+ unset -nocomplain treediffs
clear_display
if {[info exists hlview] && $hlview == $n} {
unset hlview
set selectedhlview [mc "None"]
}
- catch {unset commitinterest}
- catch {unset cached_commitrow}
- catch {unset ordertok}
+ unset -nocomplain commitinterest
+ unset -nocomplain cached_commitrow
+ unset -nocomplain ordertok
set curview $n
set selectedview $n
set rowfinal {}
set numcommits $commitidx($n)
- catch {unset colormap}
- catch {unset rowtextx}
+ unset -nocomplain colormap
+ unset -nocomplain rowtextx
set nextcolor 0
set canvxmax [$canv cget -width]
set curview $n
} elseif {$numcommits == 0} {
show_status [mc "No commits selected"]
}
+ set_window_title
}
# Stuff relating to the highlighting facility
if {![info exists hlview]} return
unset hlview
- catch {unset vhighlights}
+ unset -nocomplain vhighlights
unbolden
}
# delete previous highlights
catch {close $filehighlight}
unset filehighlight
- catch {unset fhighlights}
+ unset -nocomplain fhighlights
unbolden
unhighlight_filelist
}
bolden_name $id mainfont
}
set boldnameids {}
- catch {unset nhighlights}
+ unset -nocomplain nhighlights
unbolden
unmarkmatches
if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
set gdtargs [concat -- $relative_paths]
} elseif {$gdttype eq [mc "adding/removing string:"]} {
set gdtargs [list "-S$highlight_files"]
+ } elseif {$gdttype eq [mc "changing lines matching:"]} {
+ set gdtargs [list "-G$highlight_files"]
} else {
# must be "containing:", i.e. we're searching commit info
return
global descendent desc_todo ancestor anc_todo
global highlight_related
- catch {unset descendent}
+ unset -nocomplain descendent
set desc_todo [list $a]
- catch {unset ancestor}
+ unset -nocomplain ancestor
set anc_todo [list $a]
if {$highlight_related ne [mc "None"]} {
rhighlight_none
proc rhighlight_none {} {
global rhighlights
- catch {unset rhighlights}
+ unset -nocomplain rhighlights
unbolden
}
set rowisopt {}
set rowfinal {}
set canvxmax [$canv cget -width]
- catch {unset colormap}
- catch {unset rowtextx}
+ unset -nocomplain colormap
+ unset -nocomplain rowtextx
setcanvscroll
}
# spawn off a process to do git diff-index --cached HEAD
proc dodiffindex {} {
global lserial showlocalchanges vfilelimit curview
- global hasworktree
+ global hasworktree git_version
if {!$showlocalchanges || !$hasworktree} return
incr lserial
- set cmd "|git diff-index --cached HEAD"
+ if {[package vcompare $git_version "1.7.2"] >= 0} {
+ set cmd "|git diff-index --cached --ignore-submodules=dirty HEAD"
+ } else {
+ set cmd "|git diff-index --cached HEAD"
+ }
if {$vfilelimit($curview) ne {}} {
set cmd [concat $cmd -- $vfilelimit($curview)]
}
global linehtag linentag linedtag boldids boldnameids
allcanvs delete all
- catch {unset iddrawn}
- catch {unset linesegs}
- catch {unset linehtag}
- catch {unset linentag}
- catch {unset linedtag}
+ unset -nocomplain iddrawn
+ unset -nocomplain linesegs
+ unset -nocomplain linehtag
+ unset -nocomplain linentag
+ unset -nocomplain linedtag
set boldids {}
set boldnameids {}
- catch {unset vhighlights}
- catch {unset fhighlights}
- catch {unset nhighlights}
- catch {unset rhighlights}
+ unset -nocomplain vhighlights
+ unset -nocomplain fhighlights
+ unset -nocomplain nhighlights
+ unset -nocomplain rhighlights
set need_redisplay 0
set nrows_drawn 0
}
$canv bind $t <Button-1> "lineclick %x %y $id 1"
}
+proc graph_pane_width {} {
+ global use_ttk
+
+ if {$use_ttk} {
+ set g [.tf.histframe.pwclist sashpos 0]
+ } else {
+ set g [.tf.histframe.pwclist sash coord 0]
+ }
+ return [lindex $g 0]
+}
+
+proc totalwidth {l font extra} {
+ set tot 0
+ foreach str $l {
+ set tot [expr {$tot + [font measure $font $str] + $extra}]
+ }
+ return $tot
+}
+
proc drawtags {id x xt y1} {
global idtags idheads idotherrefs mainhead
global linespc lthickness
set marks {}
set ntags 0
set nheads 0
+ set singletag 0
+ set maxtags 3
+ set maxtagpct 25
+ set maxwidth [expr {[graph_pane_width] * $maxtagpct / 100}]
+ set delta [expr {int(0.5 * ($linespc - $lthickness))}]
+ set extra [expr {$delta + $lthickness + $linespc}]
+
if {[info exists idtags($id)]} {
set marks $idtags($id)
set ntags [llength $marks]
+ if {$ntags > $maxtags ||
+ [totalwidth $marks mainfont $extra] > $maxwidth} {
+ # show just a single "n tags..." tag
+ set singletag 1
+ if {$ntags == 1} {
+ set marks [list "tag..."]
+ } else {
+ set marks [list [format "%d tags..." $ntags]]
+ }
+ set ntags 1
+ }
}
if {[info exists idheads($id)]} {
set marks [concat $marks $idheads($id)]
return $xt
}
- set delta [expr {int(0.5 * ($linespc - $lthickness))}]
set yt [expr {$y1 - 0.5 * $linespc}]
set yb [expr {$yt + $linespc - 1}]
set xvals {}
}
lappend xvals $xt
lappend wvals $wid
- set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
+ set xt [expr {$xt + $wid + $extra}]
}
set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
-width $lthickness -fill $reflinecolor -tags tag.$id]
$xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
-width 1 -outline $tagoutlinecolor -fill $tagbgcolor \
-tags tag.$id]
- $canv bind $t <1> [list showtag $tag_quoted 1]
+ if {$singletag} {
+ set tagclick [list showtags $id 1]
+ } else {
+ set tagclick [list showtag $tag_quoted 1]
+ }
+ $canv bind $t <1> $tagclick
set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
} else {
# draw a head or other ref
set t [$canv create text $xl $y1 -anchor w -text $tag -fill $headfgcolor \
-font $font -tags [list tag.$id text]]
if {$ntags >= 0} {
- $canv bind $t <1> [list showtag $tag_quoted 1]
+ $canv bind $t <1> $tagclick
} elseif {$nheads >= 0} {
$canv bind $t $ctxbut [list headmenu %X %Y $id $tag_quoted]
}
global canv fgcolor
clear_display
+ set_window_title
$canv create text 3 3 -anchor nw -text $msg -font mainfont \
-tags text -fill $fgcolor
}
# add a list of tag or branch names at position pos
# returns the number of names inserted
proc appendrefs {pos ids var} {
- global ctext linknum curview $var maxrefs mainheadid
+ global ctext linknum curview $var maxrefs visiblerefs mainheadid
if {[catch {$ctext index $pos}]} {
return 0
if {[llength $tags] > $maxrefs} {
# If we are displaying heads, and there are too many,
# see if there are some important heads to display.
- # Currently this means "master" and the current head.
+ # Currently that are the current head and heads listed in $visiblerefs option
set itags {}
if {$var eq "idheads"} {
set utags {}
foreach ti $tags {
set hname [lindex $ti 0]
set id [lindex $ti 1]
- if {($hname eq "master" || $id eq $mainheadid) &&
+ if {([lsearch -exact $visiblerefs $hname] != -1 || $id eq $mainheadid) &&
[llength $itags] < $maxrefs} {
lappend itags $ti
} else {
$canv raise $t
}
-proc selectline {l isnew {desired_loc {}}} {
+proc selectline {l isnew {desired_loc {}} {switch_to_patch 0}} {
global canv ctext commitinfo selectedline
global canvy0 linespc parents children curview
global currentid sha1entry
global cmitmode showneartags allcommits
global targetrow targetid lastscrollrows
global autoselect autosellen jump_to_here
+ global vinlinediff
- catch {unset pending_select}
+ unset -nocomplain pending_select
$canv delete hover
normalline
unsel_reflist
setcanvscroll
}
+ if {$cmitmode ne "patch" && $switch_to_patch} {
+ set cmitmode "patch"
+ }
+
set y [expr {$canvy0 + $l * $linespc}]
set ymax [lindex [$canv cget -scrollregion] 3]
set ytop [expr {$y - $linespc - 1}]
init_flist [mc "Comments"]
if {$cmitmode eq "tree"} {
gettree $id
+ } elseif {$vinlinediff($curview) == 1} {
+ showinlinediff $id
} elseif {[llength $olds] <= 1} {
startdiff $id
} else {
global selectedline currentid
set selectedline {}
- catch {unset currentid}
+ unset -nocomplain currentid
allcanvs delete secsel
rhighlight_none
}
if {[info exists last_posvars]} {
foreach {var val} $last_posvars {
global $var
- catch {unset $var}
+ unset -nocomplain $var
}
unset last_posvars
}
}
}
+proc go_to_parent {i} {
+ global parents curview targetid
+ set ps $parents($curview,$targetid)
+ if {[llength $ps] >= $i} {
+ selbyid [lindex $ps [expr $i - 1]]
+ }
+}
+
proc gettree {id} {
global treefilelist treeidlist diffids diffmergeid treepending
global nullid nullid2
set diffids $id
- catch {unset diffmergeid}
+ unset -nocomplain diffmergeid
if {![info exists treefilelist($id)]} {
if {![info exists treepending]} {
if {$id eq $nullid} {
settabs 1
set diffids $ids
- catch {unset diffmergeid}
+ unset -nocomplain diffmergeid
if {![info exists treediffs($ids)] ||
[lsearch -exact $ids $nullid] >= 0 ||
[lsearch -exact $ids $nullid2] >= 0} {
}
}
+proc showinlinediff {ids} {
+ global commitinfo commitdata ctext
+ global treediffs
+
+ set info $commitinfo($ids)
+ set diff [lindex $info 7]
+ set difflines [split $diff "\n"]
+
+ initblobdiffvars
+ set treediff {}
+
+ set inhdr 0
+ foreach line $difflines {
+ if {![string compare -length 5 "diff " $line]} {
+ set inhdr 1
+ } elseif {$inhdr && ![string compare -length 4 "+++ " $line]} {
+ # offset also accounts for the b/ prefix
+ lappend treediff [string range $line 6 end]
+ set inhdr 0
+ }
+ }
+
+ set treediffs($ids) $treediff
+ add_flist $treediff
+
+ $ctext conf -state normal
+ foreach line $difflines {
+ parseblobdiffline $ids $line
+ }
+ maybe_scroll_ctext 1
+ $ctext conf -state disabled
+}
+
# If the filename (name) is under any of the passed filter paths
# then return true to include the file in the listing.
proc path_filter {filter name} {
}
proc diffcmd {ids flags} {
- global log_showroot nullid nullid2
+ global log_showroot nullid nullid2 git_version
set i [lsearch -exact $ids $nullid]
set j [lsearch -exact $ids $nullid2]
}
}
} elseif {$j >= 0} {
+ if {[package vcompare $git_version "1.7.2"] >= 0} {
+ set flags "$flags --ignore-submodules=dirty"
+ }
set cmd [concat | git diff-index --cached $flags]
if {[llength $ids] > 1} {
# comparing index with specific revision
}
proc gettreediffs {ids} {
- global treediff treepending
+ global treediff treepending limitdiffs vfilelimit curview
- if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
+ set cmd [diffcmd $ids {--no-commit-id}]
+ if {$limitdiffs && $vfilelimit($curview) ne {}} {
+ set cmd [concat $cmd -- $vfilelimit($curview)]
+ }
+ if {[catch {set gdtf [open $cmd r]}]} return
set treepending $ids
set treediff {}
return [expr {$nr >= $max? 2: 1}]
}
close $gdtf
- if {$limitdiffs && $vfilelimit($curview) ne {}} {
- set flist {}
- foreach f $treediff {
- if {[path_filter $vfilelimit($curview) $f]} {
- lappend flist $f
- }
- }
- set treediffs($ids) $flist
- } else {
- set treediffs($ids) $treediff
- }
+ set treediffs($ids) $treediff
unset treepending
if {$cmitmode eq "tree" && [llength $diffids] == 1} {
gettree $diffids
reselectline
}
+proc initblobdiffvars {} {
+ global diffencoding targetline diffnparents
+ global diffinhdr currdiffsubmod diffseehere
+ set targetline {}
+ set diffnparents 0
+ set diffinhdr 0
+ set diffencoding [get_path_encoding {}]
+ set currdiffsubmod ""
+ set diffseehere -1
+}
+
proc getblobdiffs {ids} {
global blobdifffd diffids env
- global diffinhdr treediffs
+ global treediffs
global diffcontext
global ignorespace
global worddiff
global limitdiffs vfilelimit curview
- global diffencoding targetline diffnparents
- global git_version currdiffsubmod
+ global git_version
set textconv {}
if {[package vcompare $git_version "1.6.1"] >= 0} {
error_popup [mc "Error getting diffs: %s" $err]
return
}
- set targetline {}
- set diffnparents 0
- set diffinhdr 0
- set diffencoding [get_path_encoding {}]
fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
set blobdifffd($ids) $bdf
- set currdiffsubmod ""
+ initblobdiffvars
filerun $bdf [list getblobdiffline $bdf $diffids]
}
set diffline 0
}
+proc blobdiffmaybeseehere {ateof} {
+ global diffseehere
+ if {$diffseehere >= 0} {
+ mark_ctext_line [lindex [split $diffseehere .] 0]
+ }
+ maybe_scroll_ctext $ateof
+}
+
proc getblobdiffline {bdf ids} {
- global diffids blobdifffd ctext curdiffstart
- global diffnexthead diffnextnote difffilestart
- global ctext_file_names ctext_file_lines
- global diffinhdr treediffs mergemax diffnparents
- global diffencoding jump_to_here targetline diffline currdiffsubmod
- global worddiff
+ global diffids blobdifffd
+ global ctext
set nr 0
$ctext conf -state normal
catch {close $bdf}
return 0
}
- if {![string compare -length 5 "diff " $line]} {
- if {![regexp {^diff (--cc|--git) } $line m type]} {
- set line [encoding convertfrom $line]
- $ctext insert end "$line\n" hunksep
- continue
+ parseblobdiffline $ids $line
+ }
+ $ctext conf -state disabled
+ blobdiffmaybeseehere [eof $bdf]
+ if {[eof $bdf]} {
+ catch {close $bdf}
+ return 0
+ }
+ return [expr {$nr >= 1000? 2: 1}]
+}
+
+proc parseblobdiffline {ids line} {
+ global ctext curdiffstart
+ global diffnexthead diffnextnote difffilestart
+ global ctext_file_names ctext_file_lines
+ global diffinhdr treediffs mergemax diffnparents
+ global diffencoding jump_to_here targetline diffline currdiffsubmod
+ global worddiff diffseehere
+
+ if {![string compare -length 5 "diff " $line]} {
+ if {![regexp {^diff (--cc|--git) } $line m type]} {
+ set line [encoding convertfrom $line]
+ $ctext insert end "$line\n" hunksep
+ continue
+ }
+ # start of a new file
+ set diffinhdr 1
+ $ctext insert end "\n"
+ set curdiffstart [$ctext index "end - 1c"]
+ lappend ctext_file_names ""
+ lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
+ $ctext insert end "\n" filesep
+
+ if {$type eq "--cc"} {
+ # start of a new file in a merge diff
+ set fname [string range $line 10 end]
+ if {[lsearch -exact $treediffs($ids) $fname] < 0} {
+ lappend treediffs($ids) $fname
+ add_flist [list $fname]
}
- # start of a new file
- set diffinhdr 1
- $ctext insert end "\n"
- set curdiffstart [$ctext index "end - 1c"]
- lappend ctext_file_names ""
- lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
- $ctext insert end "\n" filesep
-
- if {$type eq "--cc"} {
- # start of a new file in a merge diff
- set fname [string range $line 10 end]
- if {[lsearch -exact $treediffs($ids) $fname] < 0} {
- lappend treediffs($ids) $fname
- add_flist [list $fname]
- }
+ } else {
+ set line [string range $line 11 end]
+ # If the name hasn't changed the length will be odd,
+ # the middle char will be a space, and the two bits either
+ # side will be a/name and b/name, or "a/name" and "b/name".
+ # If the name has changed we'll get "rename from" and
+ # "rename to" or "copy from" and "copy to" lines following
+ # this, and we'll use them to get the filenames.
+ # This complexity is necessary because spaces in the
+ # filename(s) don't get escaped.
+ set l [string length $line]
+ set i [expr {$l / 2}]
+ if {!(($l & 1) && [string index $line $i] eq " " &&
+ [string range $line 2 [expr {$i - 1}]] eq \
+ [string range $line [expr {$i + 3}] end])} {
+ return
+ }
+ # unescape if quoted and chop off the a/ from the front
+ if {[string index $line 0] eq "\""} {
+ set fname [string range [lindex $line 0] 2 end]
} else {
- set line [string range $line 11 end]
- # If the name hasn't changed the length will be odd,
- # the middle char will be a space, and the two bits either
- # side will be a/name and b/name, or "a/name" and "b/name".
- # If the name has changed we'll get "rename from" and
- # "rename to" or "copy from" and "copy to" lines following
- # this, and we'll use them to get the filenames.
- # This complexity is necessary because spaces in the
- # filename(s) don't get escaped.
- set l [string length $line]
- set i [expr {$l / 2}]
- if {!(($l & 1) && [string index $line $i] eq " " &&
- [string range $line 2 [expr {$i - 1}]] eq \
- [string range $line [expr {$i + 3}] end])} {
- continue
- }
- # unescape if quoted and chop off the a/ from the front
- if {[string index $line 0] eq "\""} {
- set fname [string range [lindex $line 0] 2 end]
- } else {
- set fname [string range $line 2 [expr {$i - 1}]]
- }
+ set fname [string range $line 2 [expr {$i - 1}]]
}
- makediffhdr $fname $ids
+ }
+ makediffhdr $fname $ids
- } elseif {![string compare -length 16 "* Unmerged path " $line]} {
- set fname [encoding convertfrom [string range $line 16 end]]
- $ctext insert end "\n"
- set curdiffstart [$ctext index "end - 1c"]
- lappend ctext_file_names $fname
- lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
+ } elseif {![string compare -length 16 "* Unmerged path " $line]} {
+ set fname [encoding convertfrom [string range $line 16 end]]
+ $ctext insert end "\n"
+ set curdiffstart [$ctext index "end - 1c"]
+ lappend ctext_file_names $fname
+ lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
+ $ctext insert end "$line\n" filesep
+ set i [lsearch -exact $treediffs($ids) $fname]
+ if {$i >= 0} {
+ setinlist difffilestart $i $curdiffstart
+ }
+
+ } elseif {![string compare -length 2 "@@" $line]} {
+ regexp {^@@+} $line ats
+ set line [encoding convertfrom $diffencoding $line]
+ $ctext insert end "$line\n" hunksep
+ if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
+ set diffline $nl
+ }
+ set diffnparents [expr {[string length $ats] - 1}]
+ set diffinhdr 0
+
+ } elseif {![string compare -length 10 "Submodule " $line]} {
+ # start of a new submodule
+ if {[regexp -indices "\[0-9a-f\]+\\.\\." $line nameend]} {
+ set fname [string range $line 10 [expr [lindex $nameend 0] - 2]]
+ } else {
+ set fname [string range $line 10 [expr [string first "contains " $line] - 2]]
+ }
+ if {$currdiffsubmod != $fname} {
+ $ctext insert end "\n"; # Add newline after commit message
+ }
+ set curdiffstart [$ctext index "end - 1c"]
+ lappend ctext_file_names ""
+ if {$currdiffsubmod != $fname} {
+ lappend ctext_file_lines $fname
+ makediffhdr $fname $ids
+ set currdiffsubmod $fname
+ $ctext insert end "\n$line\n" filesep
+ } else {
$ctext insert end "$line\n" filesep
+ }
+ } elseif {![string compare -length 3 " >" $line]} {
+ set $currdiffsubmod ""
+ set line [encoding convertfrom $diffencoding $line]
+ $ctext insert end "$line\n" dresult
+ } elseif {![string compare -length 3 " <" $line]} {
+ set $currdiffsubmod ""
+ set line [encoding convertfrom $diffencoding $line]
+ $ctext insert end "$line\n" d0
+ } elseif {$diffinhdr} {
+ if {![string compare -length 12 "rename from " $line]} {
+ set fname [string range $line [expr 6 + [string first " from " $line] ] end]
+ 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
}
-
- } elseif {![string compare -length 2 "@@" $line]} {
- regexp {^@@+} $line ats
- set line [encoding convertfrom $diffencoding $line]
- $ctext insert end "$line\n" hunksep
- if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
- set diffline $nl
+ } elseif {![string compare -length 10 $line "rename to "] ||
+ ![string compare -length 8 $line "copy to "]} {
+ set fname [string range $line [expr 4 + [string first " to " $line] ] end]
+ if {[string index $fname 0] eq "\""} {
+ set fname [lindex $fname 0]
}
- set diffnparents [expr {[string length $ats] - 1}]
+ makediffhdr $fname $ids
+ } elseif {[string compare -length 3 $line "---"] == 0} {
+ # do nothing
+ return
+ } elseif {[string compare -length 3 $line "+++"] == 0} {
set diffinhdr 0
+ return
+ }
+ $ctext insert end "$line\n" filesep
- } elseif {![string compare -length 10 "Submodule " $line]} {
- # start of a new submodule
- if {[regexp -indices "\[0-9a-f\]+\\.\\." $line nameend]} {
- set fname [string range $line 10 [expr [lindex $nameend 0] - 2]]
- } else {
- set fname [string range $line 10 [expr [string first "contains " $line] - 2]]
- }
- if {$currdiffsubmod != $fname} {
- $ctext insert end "\n"; # Add newline after commit message
- }
- set curdiffstart [$ctext index "end - 1c"]
- lappend ctext_file_names ""
- if {$currdiffsubmod != $fname} {
- lappend ctext_file_lines $fname
- makediffhdr $fname $ids
- set currdiffsubmod $fname
- $ctext insert end "\n$line\n" filesep
- } else {
- $ctext insert end "$line\n" filesep
- }
- } elseif {![string compare -length 3 " >" $line]} {
- set $currdiffsubmod ""
- set line [encoding convertfrom $diffencoding $line]
- $ctext insert end "$line\n" dresult
- } elseif {![string compare -length 3 " <" $line]} {
- set $currdiffsubmod ""
- set line [encoding convertfrom $diffencoding $line]
- $ctext insert end "$line\n" d0
- } elseif {$diffinhdr} {
- if {![string compare -length 12 "rename from " $line]} {
- set fname [string range $line [expr 6 + [string first " from " $line] ] end]
- 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
+ } else {
+ set line [string map {\x1A ^Z} \
+ [encoding convertfrom $diffencoding $line]]
+ # parse the prefix - one ' ', '-' or '+' for each parent
+ set prefix [string range $line 0 [expr {$diffnparents - 1}]]
+ set tag [expr {$diffnparents > 1? "m": "d"}]
+ set dowords [expr {$worddiff ne [mc "Line diff"] && $diffnparents == 1}]
+ set words_pre_markup ""
+ set words_post_markup ""
+ if {[string trim $prefix " -+"] eq {}} {
+ # prefix only has " ", "-" and "+" in it: normal diff line
+ set num [string first "-" $prefix]
+ if {$dowords} {
+ set line [string range $line 1 end]
+ }
+ if {$num >= 0} {
+ # removed line, first parent with line is $num
+ if {$num >= $mergemax} {
+ set num "max"
}
- } elseif {![string compare -length 10 $line "rename to "] ||
- ![string compare -length 8 $line "copy to "]} {
- set fname [string range $line [expr 4 + [string first " to " $line] ] end]
- if {[string index $fname 0] eq "\""} {
- set fname [lindex $fname 0]
+ if {$dowords && $worddiff eq [mc "Markup words"]} {
+ $ctext insert end "\[-$line-\]" $tag$num
+ } else {
+ $ctext insert end "$line" $tag$num
}
- makediffhdr $fname $ids
- } elseif {[string compare -length 3 $line "---"] == 0} {
- # do nothing
- continue
- } elseif {[string compare -length 3 $line "+++"] == 0} {
- set diffinhdr 0
- continue
- }
- $ctext insert end "$line\n" filesep
-
- } else {
- set line [string map {\x1A ^Z} \
- [encoding convertfrom $diffencoding $line]]
- # parse the prefix - one ' ', '-' or '+' for each parent
- set prefix [string range $line 0 [expr {$diffnparents - 1}]]
- set tag [expr {$diffnparents > 1? "m": "d"}]
- set dowords [expr {$worddiff ne [mc "Line diff"] && $diffnparents == 1}]
- set words_pre_markup ""
- set words_post_markup ""
- if {[string trim $prefix " -+"] eq {}} {
- # prefix only has " ", "-" and "+" in it: normal diff line
- set num [string first "-" $prefix]
- if {$dowords} {
- set line [string range $line 1 end]
+ if {!$dowords} {
+ $ctext insert end "\n" $tag$num
}
- if {$num >= 0} {
- # removed line, first parent with line is $num
- if {$num >= $mergemax} {
- set num "max"
- }
- if {$dowords && $worddiff eq [mc "Markup words"]} {
- $ctext insert end "\[-$line-\]" $tag$num
- } else {
- $ctext insert end "$line" $tag$num
- }
- if {!$dowords} {
- $ctext insert end "\n" $tag$num
- }
- } else {
- set tags {}
- if {[string first "+" $prefix] >= 0} {
- # added line
- lappend tags ${tag}result
- if {$diffnparents > 1} {
- set num [string first " " $prefix]
- if {$num >= 0} {
- if {$num >= $mergemax} {
- set num "max"
- }
- lappend tags m$num
+ } else {
+ set tags {}
+ if {[string first "+" $prefix] >= 0} {
+ # added line
+ lappend tags ${tag}result
+ if {$diffnparents > 1} {
+ set num [string first " " $prefix]
+ if {$num >= 0} {
+ if {$num >= $mergemax} {
+ set num "max"
}
- }
- set words_pre_markup "{+"
- set words_post_markup "+}"
- }
- if {$targetline ne {}} {
- if {$diffline == $targetline} {
- set seehere [$ctext index "end - 1 chars"]
- set targetline {}
- } else {
- incr diffline
+ lappend tags m$num
}
}
- if {$dowords && $worddiff eq [mc "Markup words"]} {
- $ctext insert end "$words_pre_markup$line$words_post_markup" $tags
+ set words_pre_markup "{+"
+ set words_post_markup "+}"
+ }
+ if {$targetline ne {}} {
+ if {$diffline == $targetline} {
+ set diffseehere [$ctext index "end - 1 chars"]
+ set targetline {}
} else {
- $ctext insert end "$line" $tags
- }
- if {!$dowords} {
- $ctext insert end "\n" $tags
+ incr diffline
}
}
- } elseif {$dowords && $prefix eq "~"} {
- $ctext insert end "\n" {}
- } else {
- # "\ No newline at end of file",
- # or something else we don't recognize
- $ctext insert end "$line\n" hunksep
+ if {$dowords && $worddiff eq [mc "Markup words"]} {
+ $ctext insert end "$words_pre_markup$line$words_post_markup" $tags
+ } else {
+ $ctext insert end "$line" $tags
+ }
+ if {!$dowords} {
+ $ctext insert end "\n" $tags
+ }
}
+ } elseif {$dowords && $prefix eq "~"} {
+ $ctext insert end "\n" {}
+ } else {
+ # "\ No newline at end of file",
+ # or something else we don't recognize
+ $ctext insert end "$line\n" hunksep
}
}
- if {[info exists seehere]} {
- mark_ctext_line [lindex [split $seehere .] 0]
- }
- maybe_scroll_ctext [eof $bdf]
- $ctext conf -state disabled
- if {[eof $bdf]} {
- catch {close $bdf}
- return 0
- }
- return [expr {$nr >= 1000? 2: 1}]
}
proc changediffdisp {} {
}
$ctext delete $first end
if {$first eq "1.0"} {
- catch {unset pendinglinks}
+ unset -nocomplain pendinglinks
}
set ctext_file_names {}
set ctext_file_lines {}
highlightfile_for_scrollpos $topidx
}
- catch {unset suppress_highlighting_file_for_this_scrollpos}
+ unset -nocomplain suppress_highlighting_file_for_this_scrollpos
.bleft.bottom.sb set $f0 $f1
if {$searchstring ne {}} {
notbusy cherrypick
}
+proc revert {} {
+ global rowmenuid curview
+ global mainhead mainheadid
+ global gitdir
+
+ set oldhead [exec git rev-parse HEAD]
+ set dheads [descheads $rowmenuid]
+ if { $dheads eq {} || [lsearch -exact $dheads $oldhead] == -1 } {
+ set ok [confirm_popup [mc "Commit %s is not\
+ included in branch %s -- really revert it?" \
+ [string range $rowmenuid 0 7] $mainhead]]
+ if {!$ok} return
+ }
+ nowbusy revert [mc "Reverting"]
+ update
+
+ if [catch {exec git revert --no-edit $rowmenuid} err] {
+ notbusy revert
+ if [regexp {files would be overwritten by merge:(\n(( |\t)+[^\n]+\n)+)}\
+ $err match files] {
+ regsub {\n( |\t)+} $files "\n" files
+ error_popup [mc "Revert failed because of local changes to\
+ the following files:%s Please commit, reset or stash \
+ your changes and try again." $files]
+ } elseif [regexp {error: could not revert} $err] {
+ if [confirm_popup [mc "Revert failed because of merge conflict.\n\
+ Do you wish to run git citool to resolve it?"]] {
+ # Force citool to read MERGE_MSG
+ file delete [file join $gitdir "GITGUI_MSG"]
+ exec_citool {} $rowmenuid
+ }
+ } else { error_popup $err }
+ run updatecommits
+ return
+ }
+
+ set newhead [exec git rev-parse HEAD]
+ if { $newhead eq $oldhead } {
+ notbusy revert
+ error_popup [mc "No changes committed"]
+ return
+ }
+
+ addnewchild $newhead $oldhead
+
+ if [commitinview $oldhead $curview] {
+ # XXX this isn't right if we have a path limit...
+ insertrow $newhead $oldhead $curview
+ if {$mainhead ne {}} {
+ movehead $newhead $mainhead
+ movedhead $newhead $mainhead
+ }
+ set mainheadid $newhead
+ redrawtags $oldhead
+ redrawtags $newhead
+ selbyid $newhead
+ }
+
+ notbusy revert
+}
+
proc resethead {} {
global mainhead rowmenuid confirm_ok resettype NS
-width 30 -height 20 -cursor $maincursor \
-spacing1 1 -spacing3 1 -state disabled
$top.list tag configure highlight -background $selectbgcolor
- lappend bglist $top.list
- lappend fglist $top.list
+ if {![lsearch -exact $bglist $top.list]} {
+ lappend bglist $top.list
+ lappend fglist $top.list
+ }
${NS}::scrollbar $top.ysb -command "$top.list yview" -orient vertical
${NS}::scrollbar $top.xsb -command "$top.list xview" -orient horizontal
grid $top.list $top.ysb -sticky nsew
}
if {$nid > 0} {
global cached_dheads cached_dtags cached_atags
- catch {unset cached_dheads}
- catch {unset cached_dtags}
- catch {unset cached_atags}
+ unset -nocomplain cached_dheads
+ unset -nocomplain cached_dtags
+ unset -nocomplain cached_atags
}
if {![eof $fd]} {
return [expr {$nid >= 1000? 2: 1}]
foreach v {arcnos arcout arcids arcstart arcend growing \
arctags archeads allparents allchildren} {
global $v
- catch {unset $v}
+ unset -nocomplain $v
}
set allcwait 0
set nextarc 0
if {![info exists arcout($id)]} {
recalcarc [lindex $arcnos($id) 0]
}
- catch {unset cached_dtags}
- catch {unset cached_atags}
+ unset -nocomplain cached_dtags
+ unset -nocomplain cached_atags
}
proc addedhead {hid head} {
if {![info exists arcout($hid)]} {
recalcarc [lindex $arcnos($hid) 0]
}
- catch {unset cached_dheads}
+ unset -nocomplain cached_dheads
}
proc removedhead {hid head} {
global cached_dheads
- catch {unset cached_dheads}
+ unset -nocomplain cached_dheads
}
proc movedhead {hid head} {
if {![info exists arcout($hid)]} {
recalcarc [lindex $arcnos($hid) 0]
}
- catch {unset cached_dheads}
+ unset -nocomplain cached_dheads
}
proc changedrefs {} {
}
}
}
- catch {unset cached_tagcontent}
- catch {unset cached_dtags}
- catch {unset cached_atags}
- catch {unset cached_dheads}
+ unset -nocomplain cached_tagcontent
+ unset -nocomplain cached_dtags
+ unset -nocomplain cached_atags
+ unset -nocomplain cached_dheads
}
proc rereadrefs {} {
return [list $x $y $z]
}
+proc add_tag_ctext {tag} {
+ global ctext cached_tagcontent tagids
+
+ if {![info exists cached_tagcontent($tag)]} {
+ catch {
+ set cached_tagcontent($tag) [exec git cat-file -p $tag]
+ }
+ }
+ $ctext insert end "[mc "Tag"]: $tag\n" bold
+ if {[info exists cached_tagcontent($tag)]} {
+ set text $cached_tagcontent($tag)
+ } else {
+ set text "[mc "Id"]: $tagids($tag)"
+ }
+ appendwithlinks $text {}
+}
+
proc showtag {tag isnew} {
global ctext cached_tagcontent tagids linknum tagobjid
clear_ctext
settabs 0
set linknum 0
- if {![info exists cached_tagcontent($tag)]} {
- catch {
- set cached_tagcontent($tag) [exec git cat-file -p $tag]
- }
+ add_tag_ctext $tag
+ maybe_scroll_ctext 1
+ $ctext conf -state disabled
+ init_flist {}
+}
+
+proc showtags {id isnew} {
+ global idtags ctext linknum
+
+ if {$isnew} {
+ addtohistory [list showtags $id 0] savectextpos
}
- if {[info exists cached_tagcontent($tag)]} {
- set text $cached_tagcontent($tag)
- } else {
- set text "[mc "Tag"]: $tag\n[mc "Id"]: $tagids($tag)"
+ $ctext conf -state normal
+ clear_ctext
+ settabs 0
+ set linknum 0
+ set sep {}
+ foreach tag $idtags($id) {
+ $ctext insert end $sep
+ add_tag_ctext $tag
+ set sep "\n\n"
}
- appendwithlinks $text {}
maybe_scroll_ctext 1
$ctext conf -state disabled
init_flist {}
${NS}::label $page.maxwidthl -text [mc "Maximum graph width (lines)"]
spinbox $page.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
grid $page.spacer $page.maxwidthl $page.maxwidth -sticky w
+ #xgettext:no-tcl-format
${NS}::label $page.maxpctl -text [mc "Maximum graph width (% of pane)"]
spinbox $page.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
grid x $page.maxpctl $page.maxpct -sticky w
proc setselbg {c} {
global bglist cflist
foreach w $bglist {
- $w configure -selectbackground $c
+ if {[winfo exists $w]} {
+ $w configure -selectbackground $c
+ }
}
$cflist tag configure highlight \
-background [$cflist cget -selectbackground]
global bglist
foreach w $bglist {
- $w conf -background $c
+ if {[winfo exists $w]} {
+ $w conf -background $c
+ }
}
}
global fglist canv
foreach w $fglist {
- $w conf -foreground $c
+ if {[winfo exists $w]} {
+ $w conf -foreground $c
+ }
}
allcanvs itemconf text -fill $c
$canv itemconf circle -outline $c
($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}
+ unset -nocomplain treediffs
}
if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
|| $maxgraphpct != $oldprefs(maxgraphpct)} {
proc formatdate {d} {
global datetimeformat
if {$d ne {}} {
- set d [clock format [lindex $d 0] -format $datetimeformat]
+ # If $datetimeformat includes a timezone, display in the
+ # timezone of the argument. Otherwise, display in local time.
+ if {[string match {*%[zZ]*} $datetimeformat]} {
+ if {[catch {set d [clock format [lindex $d 0] -timezone [lindex $d 1] -format $datetimeformat]}]} {
+ # Tcl < 8.5 does not support -timezone. Emulate it by
+ # setting TZ (e.g. TZ=<-0430>+04:30).
+ global env
+ if {[info exists env(TZ)]} {
+ set savedTZ $env(TZ)
+ }
+ set zone [lindex $d 1]
+ set sign [string map {+ - - +} [string index $zone 0]]
+ set env(TZ) <$zone>$sign[string range $zone 1 2]:[string range $zone 3 4]
+ set d [clock format [lindex $d 0] -format $datetimeformat]
+ if {[info exists savedTZ]} {
+ set env(TZ) $savedTZ
+ } else {
+ unset env(TZ)
+ }
+ }
+ } else {
+ set d [clock format [lindex $d 0] -format $datetimeformat]
+ }
}
return $d
}
return $tcl_enc
}
+## For msgcat loading, first locate the installation location.
+if { [info exists ::env(GITK_MSGSDIR)] } {
+ ## Msgsdir was manually set in the environment.
+ set gitk_msgsdir $::env(GITK_MSGSDIR)
+} else {
+ ## Let's guess the prefix from argv0.
+ set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
+ set gitk_libdir [file join $gitk_prefix share gitk lib]
+ set gitk_msgsdir [file join $gitk_libdir msgs]
+ unset gitk_prefix
+}
+
+## Internationalization (i18n) through msgcat and gettext. See
+## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
+package require msgcat
+namespace import ::msgcat::mc
+## And eventually load the actual message catalog
+::msgcat::mcload $gitk_msgsdir
+
# First check that Tcl/Tk is recent enough
if {[catch {package require Tk 8.4} err]} {
- show_error {} . "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
- Gitk requires at least Tcl/Tk 8.4." list
+ show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
+ Gitk requires at least Tcl/Tk 8.4."]
exit 1
}
+# on OSX bring the current Wish process window to front
+if {[tk windowingsystem] eq "aqua"} {
+ exec osascript -e [format {
+ tell application "System Events"
+ set frontmost of processes whose unix id is %d to true
+ end tell
+ } [pid] ]
+}
+
# Unset GIT_TRACE var if set
if { [info exists ::env(GIT_TRACE)] } {
unset ::env(GIT_TRACE)
}
# defaults...
-set wrcomcmd "git diff-tree --stdin -p --pretty"
+set wrcomcmd "git diff-tree --stdin -p --pretty=email"
set gitencoding {}
catch {
set showneartags 1
set hideremotes 0
set maxrefs 20
+set visiblerefs {"master"}
set maxlinelen 200
set showlocalchanges 1
set limitdiffs 1
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.
- set gitk_msgsdir $::env(GITK_MSGSDIR)
-} else {
- ## Let's guess the prefix from argv0.
- set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
- set gitk_libdir [file join $gitk_prefix share gitk lib]
- set gitk_msgsdir [file join $gitk_libdir msgs]
- unset gitk_prefix
+catch {
+ # follow the XDG base directory specification by default. See
+ # http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html
+ if {[info exists env(XDG_CONFIG_HOME)] && $env(XDG_CONFIG_HOME) ne ""} {
+ # XDG_CONFIG_HOME environment variable is set
+ set config_file [file join $env(XDG_CONFIG_HOME) git gitk]
+ set config_file_tmp [file join $env(XDG_CONFIG_HOME) git gitk-tmp]
+ } else {
+ # default XDG_CONFIG_HOME
+ set config_file "~/.config/git/gitk"
+ set config_file_tmp "~/.config/git/gitk-tmp"
+ }
+ if {![file exists $config_file]} {
+ # for backward compatibility use the old config file if it exists
+ if {[file exists "~/.gitk"]} {
+ set config_file "~/.gitk"
+ set config_file_tmp "~/.gitk-tmp"
+ } elseif {![file exists [file dirname $config_file]]} {
+ file mkdir [file dirname $config_file]
+ }
+ }
+ source $config_file
}
+config_check_tmp_exists 50
-## Internationalization (i18n) through msgcat and gettext. See
-## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
-package require msgcat
-namespace import ::msgcat::mc
-## And eventually load the actual message catalog
-::msgcat::mcload $gitk_msgsdir
-
-catch {source ~/.gitk}
+set config_variables {
+ mainfont textfont uifont tabstop findmergefiles maxgraphpct maxwidth
+ cmitmode wrapcomment autoselect autosellen showneartags maxrefs visiblerefs
+ hideremotes showlocalchanges datetimeformat limitdiffs uicolor want_ttk
+ bgcolor fgcolor uifgcolor uifgdisabledcolor colors diffcolors mergecolors
+ markbgcolor diffcontext selectbgcolor foundbgcolor currentsearchhitbgcolor
+ extdifftool perfile_attrs headbgcolor headfgcolor headoutlinecolor
+ remotebgcolor tagbgcolor tagfgcolor tagoutlinecolor reflinecolor
+ filesepbgcolor filesepfgcolor linehoverbgcolor linehoverfgcolor
+ linehoveroutlinecolor mainheadcirclecolor workingfilescirclecolor
+ indexcirclecolor circlecolors linkfgcolor circleoutlinecolor
+}
+foreach var $config_variables {
+ config_init_trace $var
+ trace add variable $var write config_variable_change_cb
+}
parsefont mainfont $mainfont
eval font create mainfont [fontflags mainfont]
set highlight_files {}
set viewfiles(0) {}
set viewperm(0) 0
+set viewchanged(0) 0
set viewargs(0) {}
set viewargscmd(0) {}
}
# wait for the window to become visible
tkwait visibility .
-wm title . "$appname: [reponame]"
+set_window_title
update
readrefs
set viewargs(1) $revtreeargs
set viewargscmd(1) $revtreeargscmd
set viewperm(1) 0
+ set viewchanged(1) 0
set vdatemode(1) 0
addviewmenu 1
.bar.view entryconf [mca "Edit view..."] -state normal
set viewargs($n) [lindex $v 2]
set viewargscmd($n) [lindex $v 3]
set viewperm($n) 1
+ set viewchanged($n) 0
addviewmenu $n
}
}