[PATCH v2 0/3] gitk: save only changed configuration on exit

[PATCH v2 0/3] gitk: save only changed configuration on exit

[Max Kirillov]

Changes since v1:

* Add value check to config_variable_change_cb
* Squash 2/3 and 3/3 and the value check into one commit. There is no really
  reasons to divide them except following the real coding history
* Describle the previous undesirable behavior in commit message
* Synchronize writing of config file

Max Kirillov (3):
  gitk refactor: remove boilerplate for configuration variables
  gitk: write only changed configuration variables
  gitk: synchronize config write

 gitk | 215 +++++++++++++++++++++++++++++++++++++++++++------------------------
 1 file changed, 139 insertions(+), 76 deletions(-)

-- 
2.0.1.1697.g73c6810

[PATCH v2 1/3] gitk refactor: remove boilerplate for configuration variables

[Max Kirillov]

Signed-off-by: Max Kirillov <max@max630.net>
---
 gitk | 88 ++++++++++++++++----------------------------------------------------
 1 file changed, 20 insertions(+), 68 deletions(-)

diff --git a/gitk b/gitk
index c8df35d..bc57c11 100755
--- a/gitk
+++ b/gitk
@@ -2772,23 +2772,11 @@ proc doprogupdate {} {
 }
 
 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 visiblerefs
+    global use_ttk
+    global stuffsaved
     global config_file config_file_tmp
+    global config_variables
 
     if {$stuffsaved} return
     if {![winfo viewable .]} return
@@ -2800,59 +2788,10 @@ proc savestuff {w} {
 	if {$::tcl_platform(platform) eq {windows}} {
 	    file attributes $config_file_tmp -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 visiblerefs $visiblerefs]
-	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]
+	foreach var_name $config_variables {
+	    upvar #0 $var_name var
+	    puts $f [list set $var_name $var]
+	}
 
 	puts $f "set geometry(main) [wm geometry .]"
 	puts $f "set geometry(state) [wm state .]"
@@ -12157,6 +12096,19 @@ catch {
     source $config_file
 }
 
+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
+}
+
 parsefont mainfont $mainfont
 eval font create mainfont [fontflags mainfont]
 eval font create mainfontbold [fontflags mainfont 1]
-- 
2.0.1.1697.g73c6810

Re: [PATCH v2 1/3] gitk refactor: remove boilerplate for configuration variables

[Paul Mackerras]

On Sun, Sep 14, 2014 at 11:35:57PM +0300, Max Kirillov wrote:
> Signed-off-by: Max Kirillov <max@max630.net>

This is a nice simplification, applied, thanks.

Paul.

[PATCH v2 2/3] gitk: write only changed configuration variables

[Max Kirillov]

When gitk contains some changed parameter, and there is existing
instance of gitk where the parameter is still old, it is reverted to
that old value when the instance exits.

Instead, store a parameter in config only it is has been modified in the
exiting instance. Otherwise, preserve the value which currently is in
file.  This allows editing the configuration when several instances are
running, and don't get rollback of the modification if some other
instance where the configuration was not edited is closed last.

Since trace(3tcl) can send bogus events, doublecheck if the value has
really been changed, but once it is marked as changed, do not reset it
back to unchanged ever, because if user has restored the original value,
it's the decision which should be stored as well as modified value.

Treat view list especially: instead of rewriting the whole list, merge
individual views. Place old and updated views at their older placed, add
new ones to the end of list.

Do not merge geometry values. They are almost always changing because
user moves and resises windows, and there is no way to find which one of
the geometries is most desired. Just overwrite them unconditionally,
like earlier.

Signed-off-by: Max Kirillov <max@max630.net>
---
 gitk | 100 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++------
 1 file changed, 92 insertions(+), 8 deletions(-)

diff --git a/gitk b/gitk
index bc57c11..e76445b 100755
--- a/gitk
+++ b/gitk
@@ -2771,12 +2771,51 @@ proc doprogupdate {} {
     }
 }
 
+proc config_resolve_variable {name name2} {
+    set var_name ""
+    set key ""
+    if {$name2 eq ""} {
+	set key $name
+	set var_name $name
+    } else {
+	set key "$name,$name2"
+	set var_name "${name}($name2)"
+    }
+    upvar #0 $var_name var
+    return [list $key $var]
+}
+
+proc config_init_trace {name name2} {
+    global config_variable_changed config_variable_original
+
+    set var_info [config_resolve_variable $name $name2]
+    set config_variable_changed([lindex $var_info 0]) 0
+    set config_variable_original([lindex $var_info 0]) [lindex $var_info 1]
+}
+
+proc config_variable_change_cb {name name2 op} {
+    global config_variable_changed config_variable_original
+
+    set var_info [config_resolve_variable $name $name2]
+    if {$op eq "write" &&
+	([llength [array names config_variable_original -exact [lindex $var_info 0]]] == 0 ||
+	 $config_variable_original([lindex $var_info 0]) ne [lindex $var_info 1])} {
+	set config_variable_changed([lindex $var_info 0]) 1
+    }
+}
+
 proc savestuff {w} {
-    global viewname viewfiles viewargs viewargscmd viewperm nextviewnum
-    global use_ttk
     global stuffsaved
     global config_file config_file_tmp
-    global config_variables
+    global config_variables config_variable_changed
+
+    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
@@ -2788,16 +2827,24 @@ proc savestuff {w} {
 	if {$::tcl_platform(platform) eq {windows}} {
 	    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
-	    puts $f [list set $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 {
@@ -2807,12 +2854,39 @@ proc savestuff {w} {
 	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 {$config_variable_changed(viewname,$v) ||
+		$config_variable_changed(viewfiles,$v) ||
+		$config_variable_changed(viewargs,$v) ||
+		$config_variable_changed(viewargscmd,$v) ||
+		$config_variable_changed(viewperm,$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
+		}
+		lappend views_modified_names $current_viewname($v)
 	    }
 	}
+	# 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 $config_file_tmp $config_file
@@ -12108,6 +12182,10 @@ set config_variables {
     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]
@@ -12311,6 +12389,12 @@ if {[info exists permviews]} {
 	addviewmenu $n
     }
 }
+foreach var {viewname viewfiles viewargs viewargscmd viewperm} {
+    for {set v 1} {$v < $nextviewnum} {incr v} {
+	config_init_trace $var $v
+    }
+    trace add variable $var write config_variable_change_cb
+}
 
 if {[tk windowingsystem] eq "win32"} {
     focus -force .
-- 
2.0.1.1697.g73c6810

Re: [PATCH v2 2/3] gitk: write only changed configuration variables

[Paul Mackerras]

On Sun, Sep 14, 2014 at 11:35:58PM +0300, Max Kirillov wrote:
> When gitk contains some changed parameter, and there is existing
> instance of gitk where the parameter is still old, it is reverted to
> that old value when the instance exits.
> 
> Instead, store a parameter in config only it is has been modified in the
> exiting instance. Otherwise, preserve the value which currently is in
> file.  This allows editing the configuration when several instances are
> running, and don't get rollback of the modification if some other
> instance where the configuration was not edited is closed last.
> 
> Since trace(3tcl) can send bogus events, doublecheck if the value has
> really been changed, but once it is marked as changed, do not reset it
> back to unchanged ever, because if user has restored the original value,
> it's the decision which should be stored as well as modified value.
> 
> Treat view list especially: instead of rewriting the whole list, merge
> individual views. Place old and updated views at their older placed, add
> new ones to the end of list.
> 
> Do not merge geometry values. They are almost always changing because
> user moves and resises windows, and there is no way to find which one of
> the geometries is most desired. Just overwrite them unconditionally,
> like earlier.
> 
> Signed-off-by: Max Kirillov <max@max630.net>

I like the idea here but the implementation seems a bit more
complicated than it needs to be.  It seems to me that we need the
trace only for the non-array configuration variables; the array case
is only for the view definitions, and I think we could just set the
changed flag for a view explicitly in [newviewok].  That would
simplify things quite a bit.

I'm also not convinced we need all the uses of upvar.  Why do we need
to use upvar to rename viewname, viewfiles etc. to current_viewname,
etc.?  If you're concerned about what might possibly be in the .gitk
when you source it, perhaps doing the source inside a namespace would
be a cleaner approach?

Paul.

Re: [PATCH v2 2/3] gitk: write only changed configuration variables

[Max Kirillov]

Hi.

On Thu, Oct 30, 2014 at 08:55:13PM +1100, Paul Mackerras wrote:
> It seems to me that we need the trace only for the
> non-array configuration variables; the array case is only
> for the view definitions, and I think we could just set
> the changed flag for a view explicitly in [newviewok].
> That would simplify things quite a bit.

I liked the idea to exploit that tcl can watch array element
uniformly with scalar variables. But I agree that the result
is a bit complicated. I will try to use the explicit flag and
see how it's going to look.

> On Sun, Sep 14, 2014 at 11:35:58PM +0300, Max Kirillov wrote:
> I'm also not convinced we need all the uses of upvar.  Why do we need
> to use upvar to rename viewname, viewfiles etc. to current_viewname,
> etc.?  If you're concerned about what might possibly be in the .gitk
> when you source it, perhaps doing the source inside a namespace would
> be a cleaner approach?

I have tried namespaces originally but failed with them.
Apparently when "set v .." runs in namespace and global v
exists, it modifies the global v rather than creates a new
variabe in a namespace. I don't remember all details now but
I could not find how to make it with namespaces. I should
say I had not known anything about tcl namespaces before
I started doing this but, so maybe I missed something.

-- 
Max

PS: the script which shows the namespace behavior:

> set a 1
> namespace eval ns1 {
>  set a 2
> }
> puts "a=$a"
> puts "ns1::a=$ns1::a"

Output is:
> a=2
> can't read "ns1::a": no such variable
>    while executing
> "puts "ns1::a=$ns1::a""

[PATCH v2 3/3] gitk: synchronize config write

[Max Kirillov]

If several gitk instances are closed simultaneously, safestuff procedure
can run at the same time, resulting in a conflict which may cause losing
of some of the instance's changes, failing the saving operation or even
corrupting the configuration file. This can happen, for example, at user
session closing, or at group closing of all instances of an application
which is possible in some desktop environments.

To avoid this, make sure that only one saving operation is in progress.
It is guarded by existence of $config_file_tmp file. Both creating the
file and moving it to $config_file are atomic operations, so it should
be reliable.

Reading does not need to be syncronized, because moving is atomic
operation, and the $config_file always refers to full and correct file.
But, if there is a stale $config_file_tmp file, report it at gitk start.
If such file is detected at saving, just abort the saving, because this
is how gitk used to handle errors while saving.

Signed-off-by: Max Kirillov <max@max630.net>
---
 gitk | 33 ++++++++++++++++++++++++++++++---
 1 file changed, 30 insertions(+), 3 deletions(-)

diff --git a/gitk b/gitk
index e76445b..c65103e 100755
--- a/gitk
+++ b/gitk
@@ -2771,6 +2771,19 @@ proc doprogupdate {} {
     }
 }
 
+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 "Probably there is stale $config_file_tmp file; config saving is going to fail. Check if it is being used by any existing gitk process and remove it otherwise"
+	}
+    }
+}
+
 proc config_resolve_variable {name name2} {
     set var_name ""
     set key ""
@@ -2819,11 +2832,16 @@ proc savestuff {w} {
 
     if {$stuffsaved} return
     if {![winfo viewable .]} return
+    set remove_tmp 0
     catch {
-	if {[file exists $config_file_tmp]} {
-	    file delete -force $config_file_tmp
+	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 f [open $config_file_tmp w]
+	set remove_tmp 1
 	if {$::tcl_platform(platform) eq {windows}} {
 	    file attributes $config_file_tmp -hidden true
 	}
@@ -2890,6 +2908,14 @@ proc savestuff {w} {
 	puts $f "}"
 	close $f
 	file rename -force $config_file_tmp $config_file
+	set remove_tmp 0
+	return ""
+    } err
+    if {$err ne ""} {
+	puts "Error saving config: $err"
+    }
+    if {$remove_tmp} {
+	file delete -force $config_file_tmp
     }
     set stuffsaved 1
 }
@@ -12169,6 +12195,7 @@ catch {
     }
     source $config_file
 }
+config_check_tmp_exists 50
 
 set config_variables {
     mainfont textfont uifont tabstop findmergefiles maxgraphpct maxwidth
-- 
2.0.1.1697.g73c6810