home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / custedarea.tcl < prev    next >
Text File  |  1996-10-22  |  10KB  |  414 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cadre Technologies Inc.    1996
  4. #
  5. #      File:           @(#)custedarea.tcl    1.22
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)custedarea.tcl    1.22   04 Apr 1996 Copyright 1996 Cadre Technologies Inc.
  10.  
  11. # Start user added include file section
  12. require custfileut.tcl
  13. # End user added include file section
  14.  
  15.  
  16. Class CustEdArea : {Object} {
  17.     constructor
  18.     method destructor
  19.     method load
  20.     method edit
  21.     method save
  22.     method quit
  23.     method readCorporateObjects
  24.     method readUserObjects
  25.     method readUpperLevelsObjects
  26.     method readLevelObjects
  27.     method read
  28.     method deleteObjects
  29.     method redefineObject
  30.     method adjustCreatedObject
  31.     method setContext
  32.     method sortArea
  33.     method source
  34.     method filter
  35.     attribute isChanged
  36.     attribute isReadOnly
  37.     attribute toolType
  38.     attribute _curName
  39.     attribute _curType
  40.     attribute _path
  41.     attribute _scope
  42.     attribute _level
  43.     attribute _repObj
  44.     attribute _filter
  45. }
  46.  
  47. constructor CustEdArea {class this name} {
  48.     set this [Object::constructor $class $this $name]
  49.     $this isChanged 0
  50.     $this isReadOnly 0
  51.     $this toolType "browser"
  52.     # Start constructor user section
  53.     # End constructor user section
  54.     return $this
  55. }
  56.  
  57. method CustEdArea::destructor {this} {
  58.     set ref [$this _filter]
  59.     if {$ref != ""} {
  60.         $ref _editorArea ""
  61.     }
  62.     # Start destructor user section
  63.     # End destructor user section
  64. }
  65.  
  66. proc CustEdArea::indentList {list indentLevel protect} {
  67.  
  68.     set indents ""
  69.     for {set i 0} {$i < $indentLevel} {incr i} {
  70.         set indents "$indents\t"
  71.     }
  72.  
  73.     set indList " \{"
  74.     while {![lempty $list]} {
  75.         set key [lvarpop list]
  76.         set value [lvarpop list]
  77.         if {[string length $key] > 7} {
  78.             set tabs "\t"
  79.         } else {
  80.             set tabs "\t\t"
  81.         }
  82.         if {$protect == 1} {
  83.             set strVal [string trim $value]
  84.             if {[regexp {[     ]} $strVal]==1 || $strVal==""} {
  85.                set indList "$indList\n\t$indents$key$tabs\{$value\}"
  86.             } else {
  87.                set indList "$indList\n\t$indents$key$tabs$value"
  88.             }
  89.         } else {
  90.             set indList "$indList\n\t$indents$key$tabs$value"
  91.         }
  92.     }
  93.     set indList "$indList\n$indents\}\n"
  94.     return $indList
  95. }
  96.  
  97. method CustEdArea::load {this obj} {
  98.  
  99.     $this isReadOnly 1
  100.     $this isChanged 0
  101.  
  102.     if [isCommand $obj] {
  103.         $this _repObj $obj
  104.         $this _curName [[[$this _repObj] customFile] name]
  105.         $this _curType [[[$this _repObj] customFile] type]
  106.         $this readUpperLevelsObjects
  107.         $this readUserObjects
  108.         $this readLevelObjects
  109.     } else {
  110.         # if user or corporate is the case, the name of the
  111.         # file is given
  112.         # [$this _curName].[$this _curType]
  113.         $this _repObj ""
  114.         set index [string last "." $obj]
  115.         $this _curName [string range $obj 0 [expr {$index -1}]]
  116.         $this _curType [string range $obj [expr {$index +1}] end]
  117.         $this readCorporateObjects
  118.         if {"[$this _level]" == "user"} {
  119.             $this readUserObjects
  120.         }
  121.     }
  122.  
  123.     $this sortArea
  124.     [$this filter] rehash
  125. }
  126.  
  127. method CustEdArea::edit {this obj} {
  128.  
  129.     $this isReadOnly 1
  130.     $this isChanged 0
  131.  
  132.     if {[isCommand $obj]} {
  133.         # lock the object
  134.         if {[$this _repObj] != $obj || [.main currentlyReadOnly]} {
  135.             $obj edit
  136.             $this _repObj $obj
  137.             $this _curName [[[$this _repObj] customFile] name]
  138.             $this _curType [[[$this _repObj] customFile] type]
  139.         }
  140.         $this readUpperLevelsObjects
  141.         $this readUserObjects
  142.         $this isReadOnly 0
  143.         $this readLevelObjects
  144.     } else {
  145.         # if user or corporate is the case, the name of the
  146.         # file is given
  147.         # [$this _curName].[$this _curType]
  148.         $this _repObj ""
  149.         set index [string last "." $obj]
  150.         $this _curName [string range $obj 0 [expr {$index -1}]]
  151.         $this _curType [string range $obj [expr {$index +1}] end]
  152.         if {"[$this _level]" == "user"} {
  153.             $this readCorporateObjects
  154.             $this isReadOnly 0
  155.             $this readUserObjects
  156.         } else {
  157.             $this isReadOnly 0
  158.             $this readCorporateObjects
  159.         }
  160.     }
  161.  
  162.     $this sortArea
  163.     [$this filter] rehash
  164. }
  165.  
  166. method CustEdArea::save {this} {
  167.  
  168.     set tmpFile [args_file {}]
  169.      set fid [open $tmpFile w]
  170.      foreach object [$this getObjects] {
  171.         if [$object editable] {
  172.             $this writeObject $object $fid
  173.         }
  174.     }
  175.     close $fid
  176.     if {[$this _level] == "user"} {
  177.         set file [path_name concat \
  178.             [path_name concat ~ icase] \
  179.             [$this _curName].[$this _curType] \
  180.         ]
  181.         copy_text_file $tmpFile $file
  182.     } elseif {[$this _level] == "corporate"} {
  183.         set file [m4_path_name etc [$this _curName].[$this _curType]]
  184.         copy_text_file $tmpFile $file
  185.     } else {
  186.         [$this _repObj] upLoad $tmpFile
  187.     }
  188.     unlink $tmpFile
  189.  
  190.     $this isChanged 0
  191. }
  192.  
  193. method CustEdArea::quit {this} {
  194.  
  195.     if [isCommand [$this _repObj]] {
  196.         [$this _repObj] quit
  197.     }
  198. }
  199.  
  200. method CustEdArea::readCorporateObjects {this} {
  201.  
  202.     set corp [[ClientContext::global] currentCorporate]
  203.  
  204.     $this read $corp corporate
  205. }
  206.  
  207. method CustEdArea::readUserObjects {this} {
  208.  
  209.     eval "proc registerObject {spec} {$this createObject \$spec user}"
  210.  
  211.     set file [path_name concat [path_name concat ~ icase] \
  212.         [$this _curName].[$this _curType]]
  213.     if [file exists $file] {
  214.         $this source $file
  215.     }
  216. }
  217.  
  218. method CustEdArea::readUpperLevelsObjects {this} {
  219.  
  220.     # read all the levels up to the current level
  221.  
  222.     set name [$this _curName]
  223.     set type [$this _curType]
  224.  
  225.     case [$this _level] in {
  226.  
  227.         {corporate} {
  228.         }
  229.         {project} {
  230.             $this read [lindex [$this _path] 0] corporate
  231.         }
  232.         {config} {
  233.             $this read [lindex [$this _path] 0] corporate
  234.             $this read [lindex [$this _path] 1] project
  235.         }
  236.         {phase} {
  237.             $this read [lindex [$this _path] 0] corporate
  238.             $this read [lindex [$this _path] 1] project
  239.             $this read [lindex [$this _path] 2] configuration
  240.         }
  241.         {system} {
  242.             $this read [lindex [$this _path] 0] corporate
  243.             $this read [lindex [$this _path] 1] project
  244.             $this read [lindex [$this _path] 2] configuration
  245.             $this read [lindex [$this _path] 3] phase
  246.         }
  247.     }
  248. }
  249.  
  250. method CustEdArea::readLevelObjects {this} {
  251.  
  252.     eval "proc registerObject {spec} {$this createObject \$spec \
  253.                             [$this _level]}"
  254.     if {![[$this _repObj] isNil]} {
  255.         set tmpFile [args_file {}]
  256.         [$this _repObj] downLoad $tmpFile
  257.         $this source $tmpFile
  258.         unlink $tmpFile
  259.     }
  260. }
  261.  
  262. method CustEdArea::read {this object type} {
  263.  
  264.     eval "proc registerObject {spec} {$this createObject \$spec $type}"
  265.  
  266.     set custFile [CustFileUtilities::find $object [$this _curName] \
  267.         [$this _curType]]
  268.     if {"$custFile" == ""} return
  269.  
  270.     if {"$object" == "" || [$object isA Corporate]} {
  271.         $this source $custFile
  272.     } else {
  273.         set tmpFile [args_file {}]
  274.         $custFile downLoad $tmpFile
  275.         $this source $tmpFile
  276.         unlink $tmpFile
  277.     }
  278. }
  279.  
  280. method CustEdArea::deleteObjects {this objs} {
  281.  
  282.     foreach i $objs {
  283.         $i delete
  284.         $this isChanged 1
  285.     }
  286.  
  287.     .main selectionChanged
  288. }
  289.  
  290. method CustEdArea::redefineObject {this obj} {
  291.  
  292.     if {[$obj readOnly]} {
  293.         return "Object to redefine is read-only defined on level \
  294.                     [$obj specLevel]"
  295.     }
  296.  
  297.     set user 0
  298.     if {[$this _level] == "user"} {
  299.         set user 1
  300.     }
  301.  
  302.     # use as much of the scope of the redefined object
  303.     set scope [$this _scope]
  304.     for {set i [llength $scope]} {$i < [llength [$obj scope]]} {incr i} {
  305.         lappend scope [lindex [$obj scope] $i]
  306.     }
  307.  
  308.     # make a exact copy
  309.     set newObj [$this createObject "displayName \{[$obj displayName]\}
  310.                     scope        \{$scope\}
  311.                     specLevel      [$this _level]
  312.                     name         \{[$obj name]\}
  313.                     type         \{[$obj type]\}
  314.                     userDefined       $user
  315.                     visible         \{[$obj visible]\}
  316.                     objSpec         \{[$obj objSpec]\}" \
  317.                     [$this _level]]
  318.  
  319.     return $newObj
  320. }
  321.  
  322. method CustEdArea::adjustCreatedObject {this obj level} {
  323.  
  324.     if {![$this isReadOnly]} {
  325.         $obj editable 1
  326.         # if invalid scope (level) specified, set scope to corporate
  327.         if {$icaseLevel([llength [$obj scope]]) == ""} {
  328.             $obj scope ""
  329.         }
  330.     }
  331.  
  332.     if {$level == "user"} {
  333.         $obj userDefined 1
  334.     }
  335.     $obj specLevel $level
  336. }
  337.  
  338. method CustEdArea::setContext {this} {
  339.  
  340.     set cc [ClientContext::global]
  341.     set corp [$cc currentCorporate]
  342.     set proj [$cc currentProject]
  343.     set confV [$cc currentConfig]
  344.     set phaseV [$cc currentPhase]
  345.     set sysV [$cc currentSystem]
  346.  
  347.     set path ""
  348.     set scope ""
  349.     if {! [$corp isNil]} {
  350.         $this _level corporate
  351.         lappend path $corp
  352.         if {! [$proj isNil]} {
  353.             $this _level project
  354.             lappend path $proj
  355.             lappend scope *
  356.             if {! [$confV isNil]} {
  357.                 $this _level config
  358.                 lappend path $confV
  359.                 lappend scope *
  360.                 if {! [$phaseV isNil]} {
  361.                     $this _level phase
  362.                     lappend path $phaseV
  363.                     lappend scope *
  364.                     if {! [$sysV isNil]} {
  365.                         $this _level system
  366.                         lappend path $sysV
  367.                         lappend scope *
  368.                     }
  369.                 }
  370.             }
  371.         }
  372.     }
  373.  
  374.     $this _scope $scope
  375.     $this _path $path
  376. }
  377.  
  378. method CustEdArea::sortArea {this} {
  379.     # no sort done in general, only in specific cases
  380. }
  381.  
  382. method CustEdArea::source {this fileName} {
  383.  
  384.     if [catch {
  385.         set fid [open $fileName]
  386.         set l [List new -contents [read $fid]]
  387.         close $fid
  388.         set end [$l length]
  389.         for {set i 1} {$i <= $end} {incr i 2} {
  390.             registerObject [$l index $i]
  391.         }
  392.     } rsn] {
  393.         wmtkerror $rsn
  394.     }
  395. }
  396.  
  397. # Do not delete this line -- regeneration end marker
  398.  
  399. method CustEdArea::filter {this args} {
  400.     if {$args == ""} {
  401.         return [$this _filter]
  402.     }
  403.     set ref [$this _filter]
  404.     if {$ref != ""} {
  405.         $ref _editorArea ""
  406.     }
  407.     set obj [lindex $args 0]
  408.     if {$obj != ""} {
  409.         $obj _editorArea $this
  410.     }
  411.     $this _filter $obj
  412. }
  413.  
  414.