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