home *** CD-ROM | disk | FTP | other *** search
/ Practical Programming in Tcl & Tk (4th Edition) / TCLBOOK4.BIN / pc / exsource.old / 43_8.tcl < prev    next >
Text File  |  2003-04-15  |  1KB  |  53 lines
  1. #
  2. # Example 43-8
  3. # Saving preferences settings to a file.
  4. #
  5.  
  6. # PrefSave writes the resource specifications to the
  7. # end of the per-user resource file,
  8. proc PrefSave {} {
  9.     global pref
  10.     if [catch {
  11.         set old [open $pref(userDefaults) r]
  12.         set oldValues [split [read $old] \n]
  13.         close $old
  14.     }] {
  15.         set oldValues {}
  16.     }
  17.     if [catch {open $pref(userDefaults).new w} out] {
  18.         .pref.but.label configure -text \
  19.         "Cannot save in $pref(userDefaults).new: $out"
  20.         return
  21.     }
  22.     foreach line $oldValues {
  23.         if {$line == \
  24.                 "!!! Lines below here automatically added"} {
  25.             break
  26.         } else {
  27.             puts $out $line
  28.         }
  29.     }
  30.     puts $out "!!! Lines below here automatically added"
  31.     puts $out "!!! [exec date]"
  32.     puts $out "!!! Do not edit below here"
  33.     foreach item $preferences {
  34.         set varName [PrefVar $item]
  35.         set resName [PrefRes $item]
  36.         if [info exists pref(entry,$varName)] {
  37.             PrefEntrySet $pref(entry,$varName) $varName
  38.         }
  39.         set value [PrefValue $varName $resName]
  40.         puts $out [format "%s\t%s" *${resName}: $value]
  41.     }
  42.     close $out
  43.     set new [glob $pref(userDefaults).new]
  44.     set old [file root $new]
  45.     if [catch {file rename -force $new $old} err] {
  46.         Status "Cannot install $new: $err"
  47.         return
  48.     }
  49.     PrefDismiss
  50. }
  51.  
  52.  
  53.