home *** CD-ROM | disk | FTP | other *** search
/ Practical Programming in Tcl & Tk (4th Edition) / TCLBOOK4.BIN / pc / exsource / 31_8.tcl < prev    next >
Text File  |  2003-04-16  |  778b  |  33 lines
  1. #
  2. # Example 31-8
  3. # Resource_GetFamily merges user and application resources.
  4. #
  5.  
  6. proc Resource_GetFamily { w resname } {
  7.     set res            [option get $w $resname {}]
  8.     set lres            [option get $w l$resname {}]
  9.     set ures            [option get $w u$resname {}]
  10.     set l-res            [option get $w l-$resname {}]
  11.     set u-res            [option get $w u-$resname {}]
  12.     # Site-local deletions from application resources
  13.     set list [lsubtract $res ${l-res}]
  14.     # Site-local additions
  15.     set list [concat $list $lres]
  16.     # Per-user deletions
  17.     set list [lsubtract $list ${u-res}]
  18.     # Per-user additions
  19.     return [concat $list $ures]
  20. }
  21. proc lsubtract { orig nuke } {
  22.     # Remove elements in $nuke from $orig
  23.     foreach x $nuke {
  24.         set ix [lsearch $orig $x]
  25.         if {$ix >= 0} {
  26.             set orig [lreplace $orig $ix $ix]
  27.         }
  28.     }
  29.     return $orig
  30. }
  31.  
  32.  
  33.