Most of my applications use Tcl scripts to save/restore settings.   I'm now building an application with a large number of very loosely coupled components and wanted a way for those components to each save and restore settings from a common file.   Below is my modest solution to this.  A snit::type (class) called `StateManager` and an associated type that uses the singleton pattern to allow parts of an application to interact with the same `StateManager` object.

Key features:
    * Application chunks register names of variables to put in the file along with a getter script, which is expected to return the value to write to file and a setter which is called when the variable has a setting in a configuration script.   
    * A safe interpreter is encapsulated in the `StateManager` to ensure that settings files don't go wild on you.
    * Implementation of the singleton pattern to allow parts of a loosely coupled application to all use a common `StateManager` object.  Snit's delegation mechanism makes it very easy to make the `StateManagerSingleton` objects a complete stand-in for the underlying  `StateManager` singleton instance.

Work to do:
    * Ensure the safe interpreter name chosen is really unique  -- any takers there?
 

======

##
# @file state.tcl
# @brief State manager for save/restore arbitrary states.
# @author Ron Fox <fox@nscl.msu.edu>

package provide StateManager 1.0
package require snit

##
# @class StateManager
#
#  Provides a mechanism to allow packages in a program to save and restore
#  internal state.  This is done by associating state variables with
#  getters and setters and providing a changed method to indicate
#  when to write a new copy of the saved file.
#
#  Save files are simply Tcl scripts that contain a bunch of set commands.
#  Those commands will be executed in a safe interpreter.
#
# OPTIONS
#   -file  - Path to the file that will hold the save script.
#
# METHOD
#   addStateVariable   - Adds a new state variable to state manager
#   listStateVariables - lists the state variables in the state manager.
#   removeStateVariable - Removes a state variable from the registered list.
#   save               - Save the state (-file must be defined by now).
#   restore            - restore the state (-file must be defined by now).
#
snit::type StateManager {
    option -file
    
    
    # State variables are an ordered list so that
    # it is possible to define the order in which data are written to file
    # and restored from the file to internal state.
    #
    #  Each element of the list is a three element list containing:
    #  *  The variable name.
    #  *  A command that will provide the correct value for that variable.  This
    #     is parameterized by the variable name when called.
    #  * A command that will react to a restored value for this variable.
    #    This command is parameterized by the variable name and new value.
    #
    variable registeredVariables [list]
    
    ##
    # constructor
    #   Contstruct the object.  Simply process the configuration options.
    # @param args  option/value pairs.
    #
    constructor args {
        $self configurelist $args
    }
    ##
    # addStateVariable
    #   adds a stateVariable to the list
    #
    # @param name   - Name of the state variable.
    # @param getter - Command to get the variable value.
    # @param setter - Command to set the variable value.
    #
    method addStateVariable {name getter setter} {
        if {[lsearch -exact -index 0 $registeredVariables $name] != -1} {
            error "There is already a registration for the variable '$name'"
        }
        lappend registeredVariables [list $name $getter $setter]
    }
    ##
    # listStateVariables
    #
    # @return the current list of state variables.  This is a list whose
    #         elements are triples of name, getter, setter.
    #
    method listStateVariables {} {
        return $registeredVariables
    }
    ##
    # save
    #   Saves the configuration.
    #   * -file must  have been configured.
    #   * The registered variables are itereated over and the getter
    #     for each is called.
    #   * A set command for the registered variable is written to the
    #    specified -file
    #
    method save {} {
        if {$options(-file) eq ""} {
            error {Cannot save prior to configuring -file}
        }
        set fd [open $options(-file) w]
        
        # Now iterate over the variables, getting values and writing
        # set commands.
        
        foreach variable $registeredVariables {
            
            set varname [lindex $variable 0]
            set getter  [lindex $variable 1]
            set value [{*}$getter $varname]
            puts $fd [list set $varname $value]
        }
        
        #  Close the file
        
        close $fd
    }
    ##
    # restore
    #   Restores the configuratino
    #   * -file must have been configured.
    #   * A safe interpreter is created and [source] exposed
    #   * The -file is sourced into the interpreter.
    #   * For each variable in the registered list, if that variable
    #     exists in the slave interpreter, that variable's setter is called.
    #
    method restore {} {
        if {$options(-file) eq "" } {
            error {Cannot restore prior to configuring -file}
        }
        if {![file readable $options(-file)]} {
            error "The restore file '$options(-file)' does not exist or is not readable"
        }
        interp create -safe StateManagerInterp
        StateManagerInterp expose source
        StateManagerInterp eval source $options(-file)
        
        foreach variable $registeredVariables {
            set varname [lindex $variable 0]
            set setter  [lindex $variable 2]
            
            if {[StateManagerInterp eval info vars $varname] eq $varname} {
                set value [StateManagerInterp eval set $varname]
                {*}$setter $varname $value
            }
        }
        interp delete StateManagerInterp
    }
}

##
# @class StateManagerSingleton
#
#   This is provided for applications that need a single state saver.
#
snit::type StateManagerSingleton {
    component instance
    
    delegate option * to instance
    delegate method * to instance
    
    typevariable theInstance ""
    
    ##
    # constructor
    #    If this is the first construction, create the instance.
    #    Regardless, install the instance as the instance component.
    #    all options and methods are  delegated to the instance component
    #    so this will appear exactly like a state manager oject.
    #
    # @param args - configuration options.
    #
    constructor args {
        if {$theInstance eq ""} {
            set theInstance [StateManager %AUTO%]
        }
        install instance using set theInstance
        $self configurelist $args
    }
    
}
======

Here's the test suite for the component:

======

##
# @file state.test
# @brief Tests for program state save/restore
# @author Ron Fox <fox@nscl.msu.edu>

package require tcltest
package require StateManager

#-----------------------------------------------------------------------------
# Construction tests

tcltest::test construct-0 {Construction provides an identifier} \
-cleanup {
    a destroy
} \
-body {
    StateManager a
} -result ::a

tcltest::test construct-1 {Can construct with a -file parameter} \
-cleanup {
    a destroy
} \
-body {
    StateManager a -file config.tcl
    a cget -file
} -result config.tcl

#---------------------------------------------------------------------------
#  Registration/listing tests.
#

tcltest::test register-list-1 {Registration is reflected in listings} \
-setup {
    StateManager a
} \
-cleanup {
    a destroy
} \
-body {
    a addStateVariable test setTest getTest
    a listStateVariables
    
} -result [list [list test setTest getTest]]


tcltest::test register-list-2 {Duplicate registration is an error} \
-setup {
    StateManager a
} \
-cleanup {
    a destroy
} \
-body {
    a addStateVariable test setTest getTest
    set status [catch {a addStateVariable test setTest getTest} message]
    list $status $message
} -result [list 1 {There is already a registration for the variable 'test'}]

tcltest::test register-list-3 {Registration order is preserved} \
-setup {
    StateManager a
} \
-cleanup {
    a destroy
} \
-body {
    a addStateVariable test setTest getTest
    a addStateVariable btest setbTest getbTest
} -result [list [list test setTest getTest] [list btest setbTest getbTest]]

#------------------------------------------------------------------------------
# Save tests

# Save/restore tests use the infrastructure below:

set aa {this is one variable}
set bb {this is another variable}

#
#  Setter puts stuff in the ::restored:: namespace which must be
#  created/cleaned up by the test.  This prevents the original
#  aa/bb from being overwritten.

proc setter {varname value} {
    set ::restored::$varname $value
}
proc getter {varname} {
    set ::$varname
}
#
#  These getter/setters are used in tests to ensure that
#  multiword getter/setters can be supplied
#
proc complexgetter {bravo varname} {
    set ::$varname
}
proc complexsetter {bravo varname value} {
    set ::restored::$varname $value
}

tcltest::test save-1 {Save without -file set is an error} \
-setup {
    StateManager a
} \
-cleanup {
    a destroy
    catch {file delete settings.test}
} \
-body {
   
    set status [catch {a save} message]
    list $status $message
} -result [list 1 {Cannot save prior to configuring -file}]


tcltest::test save-2 {Save with nothing monitored is an empty file} \
-setup {
    StateManager a
    set fullpath [file join [tcltest::temporaryDirectory] settings.test]
} \
-cleanup {
    a destroy
    tcltest::removeFile settings.test
} \
-body {
    
    a configure -file $fullpath
    a save
    set fd [open $fullpath r]
    set contents [read $fd]
    close $fd
    set contents
} -result {}

tcltest::test save-3 {Save with a registered makes a file with set a...} \
-setup {
    StateManager a
    set fullpath [file join [tcltest::temporaryDirectory] settings.test]
    a addStateVariable aa getter setter
    interp create -safe slave
    interp expose slave source
} \
-cleanup {
    a destroy
    tcltest::removeFile settings.test
    interp delete slave
} \
-body {
    
    a configure -file $fullpath
    a save
    interp eval slave source $fullpath
    interp eval slave set aa
    
} -result $aa


tcltest::test save-4 {Save with a,b, registered makes a file with set a, set b} \
-setup {
    StateManager a
    set fullpath [file join [tcltest::temporaryDirectory] settings.test]
    a addStateVariable aa getter setter
    a addStateVariable bb getter setter
    interp create -safe slave
    interp expose slave source
} \
-cleanup {
    a destroy
    tcltest::removeFile settings.test
    interp delete slave
} \
-body {
    
    a configure -file $fullpath
    a save
    interp eval slave source $fullpath
    set varaa [interp eval slave set aa]
    set varbb [interp eval slave set bb]
    
    list $varaa $varbb
} -result [list $aa $bb]

tcltest::test save-5 {Save a with complex getter should give correct save file} \
-setup {
    StateManager a
    set fullpath [file join [tcltest::temporaryDirectory] settings.test]
    a addStateVariable aa [list complexgetter junk] setter
    interp create -safe slave
    interp expose slave source
} \
-cleanup {
    a destroy
    tcltest::removeFile settings.test
    interp delete slave
} \
-body {
    
    a configure -file $fullpath
    a save
    interp eval slave source $fullpath
    interp eval slave set aa
    
} -result $aa

#------------------------------------------------------------------------------
# Restore tests.
#

tcltest::test restore-0 {Restore without -file configured fails} \
-setup {
    StateManager a
} \
-cleanup {
    a destroy 
} \
-body {
    set status [catch {a restore} text]
    list $status $text
} -result [list 1 {Cannot restore prior to configuring -file}]


tcltest::test restore-1 {Restore with no vars saved does nothing} \
-setup {
    set fullpath [file join [tcltest::temporaryDirectory] settings.test]
    StateManager a -file $fullpath
    a save
    
    namespace eval ::restored:: {}
} \
-cleanup {
    a destroy
    namespace delete ::restored
} \
-body {
    a restore
    info var ::restored::*
} -result [list]



tcltest::test restore-2 {Restore with aa saved makes aa in ::restored::} \
-setup {
    set fullpath [file join [tcltest::temporaryDirectory] settings.test]
    StateManager a -file $fullpath
    a addStateVariable aa getter setter
    a save
    
    namespace eval ::restored:: {}
} \
-cleanup {
    a destroy
    namespace delete ::restored
} \
-body {
    a restore
    list [info var ::restored::*] [set ::restored::aa]
    
} -result [list ::restored::aa $aa]


tcltest::test restore-3 {restore with aa,bb saved makes both in ::restored::} \
-setup {
    set fullpath [file join [tcltest::temporaryDirectory] settings.test]
    StateManager a -file $fullpath
    a addStateVariable aa getter setter
    a addStateVariable bb getter setter
    a save
    
    namespace eval ::restored:: {}
} \
-cleanup {
    a destroy
    namespace delete ::restored
} \
-body {
    a restore
    list [lsort [info var ::restored::*]] [set ::restored::aa] [set ::restored::bb]
    
} -result [list [list ::restored::aa ::restored::bb] $aa $bb]

tcltest::test restore-4 {Restore from nonexistent file is an error} \
-setup {
    StateManager a -file /no/such/file/exists.txt
} \
-cleanup {
    a destroy
} \
-body {
    set status [catch {a restore} message]
    list $status $message
} -result [list 1 {The restore file '/no/such/file/exists.txt' does not exist or is not readable}]

tcltest::test restore-5 {Restore with complex setter should work fine} \
-setup {
    set fullpath [file join [tcltest::temporaryDirectory] settings.test]
    StateManager a -file $fullpath
    a addStateVariable aa getter [list complexsetter 1234]
    a save
    
    namespace eval ::restored:: {}
} \
-cleanup {
    a destroy
    namespace delete ::restored
} \
-body {
    a restore
    list [info var ::restored::*] [set ::restored::aa]
    
} -result [list ::restored::aa $aa]



# Report the test results.

tcltest::cleanupTests
======
<<categories>>Dev. Tools