home *** CD-ROM | disk | FTP | other *** search
/ Internet File Formats / InternetFileFormatsCD.bin / text / latex / mac / alpha60.hqx / Tcl / SystemCode / prefs.tcl < prev    next >
Encoding:
Text File  |  1995-07-10  |  5.1 KB  |  260 lines
  1.  
  2.  
  3. #===============================================================================
  4.  
  5.  
  6. proc addArrDef {arr def val} {
  7.     addDef [list $arr $def] $val arr
  8. }
  9.  
  10. proc removeArrDef {arr def} {
  11.     removeDef [list $arr $def] arr
  12. }
  13.  
  14. proc addDef {def val {prefix {}}} {
  15.     global ${prefix}prefDefs
  16.     
  17.     readDefs $prefix
  18.     set ${prefix}prefDefs($def) $val
  19.     writeDefs $prefix
  20.     catch {unset ${prefix}prefDefs}
  21. }
  22.  
  23. proc removeDef {def {prefix {}}} {
  24.     global ${prefix}prefDefs
  25.     
  26.     readDefs $prefix
  27.     catch {unset ${prefix}prefDefs($def)}
  28.     writeDefs $prefix
  29.     catch {unset ${prefix}prefDefs}
  30. }
  31.  
  32. proc readDefs {{prefix {}}} {
  33.     global HOME PREFS globalPrefix
  34.  
  35.     if {![file exists "$PREFS:${prefix}defs.tcl"]} return
  36.     
  37.     set globalPrefix $prefix
  38.     uplevel #0 {source "$PREFS:${globalPrefix}defs.tcl"}
  39. }
  40.  
  41.  
  42. proc writeDefs {{prefix {}}} {
  43.     global HOME PREFS ${prefix}prefDefs 
  44.     
  45.     if {![info exists ${prefix}prefDefs]} {
  46.         catch {removeFile "$PREFS:${prefix}defs.tcl"}
  47.         return
  48.     }
  49.     
  50.     if {![file exists "$PREFS"]} {
  51.         mkdir "$PREFS"
  52.     }
  53.     set fd [open "$PREFS:${prefix}defs.tcl" "w"]
  54.     foreach nm [array names ${prefix}prefDefs] {
  55.         puts $fd [list set ${prefix}prefDefs($nm) [set ${prefix}prefDefs($nm)]]
  56.     }
  57.     close $fd
  58. }
  59.  
  60.  
  61. proc readUserDefs {} {
  62.     global prefDefs arrprefDefs PREFS
  63.     
  64.     if {[file exists "$PREFS:defs.tcl"]} {
  65.         source "$PREFS:defs.tcl"
  66.         
  67.         foreach nm [array names prefDefs] {
  68.             global $nm
  69.             set $nm $prefDefs($nm)
  70.         }
  71.         catch {unset prefDefs}
  72.     }
  73.     
  74.     if {[file exists "$PREFS:arrdefs.tcl"]} {
  75.         source "$PREFS:arrdefs.tcl"
  76.         
  77.         foreach nm [array names arrprefDefs] {
  78.             set arr [lindex $nm 0]
  79.             set field [lindex $nm 1]
  80.             set val $arrprefDefs($nm)
  81.             global $arr
  82.             set ${arr}($field) $val
  83.         }
  84.         catch {unset arrprefDefs}
  85.     }
  86.  
  87.     # Use "prefs.tcl" to define or change any tcl information. */
  88.     if {![file exists "$PREFS:prefs.tcl"]} {
  89.         
  90.         if {![file exists "$PREFS"]} {
  91.             mkdir "$PREFS"
  92.         }
  93.         set fd [open "$PREFS:prefs.tcl" "w"]
  94.         close $fd
  95.     }
  96.     uplevel #0 {
  97.         if {[catch {source "$PREFS:prefs.tcl"}]} {
  98.             alertnote "An error occurred while loading \"prefs.tcl\"" 
  99.         }
  100.     }
  101. }
  102.  
  103.     
  104. proc viewSavedSetting {} {
  105.     global prefDefs arrprefDefs
  106.  
  107.     saveModifiedVars
  108.     
  109.     readDefs
  110.     readDefs arr
  111.     
  112.     set res [listpick -p "The following settings have been saved:" [getSavedSettings]]
  113.  
  114.     if {[regexp {([^(]+)\(([^)]+)\)} $res dummy arr field]} {
  115.         set arg [list $arr $field]
  116.         set val $arrprefDefs($arg)
  117.         if {[string length $val] > 80} {
  118.             global tileLeft tileTop tileWidth
  119.             new -g $tileLeft $tileTop $tileWidth 100 -n "\$${arr}($field)"
  120.             insertText "'$res's value is:\r\r$val\r"
  121.             setWinInfo read-only 1
  122.             setWinInfo dirty 0
  123.             goto 0
  124.         } else {
  125.             alertnote "'$res's value is:\r\r$val\r"
  126.         }
  127.     } else {
  128.         global $res
  129.         alertnote "'$res's value is:\r\r$prefDefs($res)"
  130.     }
  131.  
  132.     unset prefDefs arrprefDefs
  133. }
  134.  
  135. proc removeSavedSetting {} {
  136.     global prefDefs arrprefDefs
  137.     
  138.     readDefs
  139.     readDefs arr
  140.     set res [listpick -p "Remove which setting?" [getSavedSettings]]
  141.  
  142.     if {$res == ""} return
  143.     if {[regexp {([^(]+)\(([^)]+)\)} $res dummy arr field]} {
  144.         global $arr
  145. #         catch {unset ${arr}($field)}
  146.         removeArrDef $arr $field
  147.     } else {
  148.         global $res
  149. #         catch {unset $res}
  150.         removeDef $res
  151.     }
  152.  
  153.     unset prefDefs arrprefDefs
  154. }
  155.  
  156.  
  157. proc getSavedSettings {} {
  158.     global prefDefs arrprefDefs
  159.     
  160.     readDefs
  161.     readDefs arr
  162.     
  163.     set names [array names prefDefs]
  164.     foreach pair [array names arrprefDefs] {
  165.         lappend names "[lindex $pair 0]([lindex $pair 1])"
  166.     }
  167.     
  168.     return [lsort $names]
  169. }
  170.  
  171. #===============================================================================
  172.  
  173. proc buildRecentFiles {} {
  174.     global recentFilesSave modifiedVars
  175.     
  176.     lappend modifiedVars
  177.     
  178.     message "Building recent files menuâ•”"
  179.     if {[info exists recentFilesSave]} {
  180.         foreach f $recentFilesSave {
  181.             pushRecent $f
  182.         }
  183.     }
  184.         
  185.     catch {unset recentFilesSave}
  186. }
  187.  
  188.  
  189. proc pushRecent {name} {
  190.     global recentFiles
  191.     
  192.     if {[string match {*\**} $name] || [string match "Untit*" $name] } return
  193.     if {[info exists recentFiles] && ([set ind [lsearch -exact $recentFiles $name]] >= 0)} {
  194.         set recentFiles [lreplace $recentFiles $ind $ind]
  195.     }
  196.     lappend recentFiles $name
  197.     if {[llength $recentFiles] > 10} {
  198.         set recentFiles [lrange $recentFiles 1 end]
  199.     }
  200.     foreach f $recentFiles {
  201.         lappend tails [file tail $f]
  202.     }
  203.     menu -m -n recent -p recentProc [lsort -ignore $tails]
  204. }
  205.  
  206. proc recentProc {menu name} {
  207.     global recentFiles
  208.     
  209.     if {[set ind [lsearch $recentFiles "*:$name"]] >= 0} {
  210.         edit [lindex $recentFiles $ind]
  211.     }
  212. }
  213.  
  214.  
  215. proc editRecentFile {} {
  216.     global recentFiles
  217.     
  218.     foreach f $recentFiles {
  219.         lappend tails [file tail $f]
  220.     }
  221.     
  222.     foreach res [listpick -l -p {File?} [lsort -ignore $tails]]  {
  223.         set ind [lsearch $recentFiles \*:$res]
  224.         catch {edit [lindex $recentFiles $ind]}
  225.     }
  226. }
  227.  
  228.  
  229. #===============================================================================
  230.  
  231. proc editPrefs.tcl {} {
  232.     global PREFS
  233.     if {![file exists "$PREFS:prefs.tcl"]} {
  234.         set fd [open "$PREFS:prefs.tcl" "w"]
  235.         close $fd
  236.     }
  237.     edit "$PREFS:prefs.tcl"
  238. }
  239.  
  240. # Automatically add a line to the user input file
  241. proc addUserLine {line} {
  242.     global HOME PREFS
  243.  
  244.     if {![file exists "$PREFS"]} {
  245.         mkdir "$PREFS"
  246.     }
  247.     set fid [open "$PREFS:prefs.tcl" "a+"]
  248.     if {![catch {seek $fid -1 end}]} {
  249.         if {[read $fid 1] == "\r"} {
  250.             set line "\r$line"
  251.         }
  252.     }
  253.     seek $fid 0 end
  254.     puts $fid $line
  255.     close $fid
  256. }
  257.  
  258.  
  259.  
  260.