home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / browsuiobj.tcl < prev    next >
Encoding:
Text File  |  1997-09-29  |  8.3 KB  |  364 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cayenne Software Inc.    1997
  4. #
  5. #      File:           @(#)browsuiobj.tcl    /main/titanic/12
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)browsuiobj.tcl    /main/titanic/12   29 Sep 1997 Copyright 1997 Cayenne Software Inc.
  10.  
  11. # Start user added include file section
  12. # End user added include file section
  13.  
  14.  
  15. Class BrowsUiObj : {Object} {
  16.     method destructor
  17.     constructor
  18.     method promoter
  19.     method allowsDrop
  20.     method browserObjType
  21.     method browserType
  22.     method canBeDragged
  23.     method canBeMoved
  24.     method cleanup
  25.     method customLevelVersion
  26.     method displayName
  27.     method filterType
  28.     method getIndentation
  29.     method getParent
  30.     method hasChildren
  31.     method initializeChildSet
  32.     method initializeInfo
  33.     method makeUpToDate
  34.     method recursiveIdSet
  35.     method recursiveObjSet
  36.     method rules
  37.     method setIndentation
  38.     method typeInLabel
  39.     method uiClass
  40.     method uiIdentity
  41.     method versionInLabel
  42.     method infoObject
  43.     method getChildSet
  44.     method setChildSet
  45.     method removeChildSet
  46.     method getInfo
  47.     method setInfo
  48.     method removeInfo
  49.     attribute uiName
  50.     attribute uiPrefix
  51.     attribute uiText
  52.     attribute treeNode
  53.     attribute _infoObject
  54.     attribute parent
  55.     attribute childSet
  56.     attribute info
  57. }
  58.  
  59. method BrowsUiObj::destructor {this} {
  60.     set ref [$this _infoObject]
  61.     if {$ref != ""} {
  62.         $ref _browsUiObj ""
  63.     }
  64.     # Start destructor user section
  65.     # End destructor user section
  66. }
  67.  
  68. constructor BrowsUiObj {class this name} {
  69.     set this [Object::constructor $class $this $name]
  70.     $this promoter
  71.     return $this
  72. }
  73.  
  74. method BrowsUiObj::promoter {this} {
  75.     if {! [isCommand [$this info]]} {
  76.     $this info [Dictionary new]
  77.     }
  78.     if {! [isCommand [$this childSet]]} {
  79.     $this childSet [Dictionary new]
  80.     }
  81.  
  82.     if [info exists ${this}::treeNode] {
  83.     BrowserProcs::initializeInfo $this [set ${this}::treeNode]
  84.     }
  85. }
  86.  
  87. method BrowsUiObj::allowsDrop {this uiClass} {
  88.     return 0
  89. }
  90.  
  91. method BrowsUiObj::browserObjType {this} {
  92.     return "[$this objType]"
  93. }
  94.  
  95. method BrowsUiObj::browserType {this} {
  96.     return "[$this uiClass]"
  97. }
  98.  
  99. method BrowsUiObj::canBeDragged {this} {
  100.     return 0
  101. }
  102.  
  103. method BrowsUiObj::canBeMoved {this} {
  104.     return 0
  105. }
  106.  
  107. method BrowsUiObj::cleanup {this association} {
  108.     if [isCommand [$this $association]] {
  109.     [$this $association] delete
  110.     $this $association ""
  111.     }
  112.     $this removeChildSet $association
  113. }
  114.  
  115. method BrowsUiObj::customLevelVersion {this} {
  116.     set dbObj [$this getParent BrowsDbObj]
  117.     if {"$dbObj" == ""} {
  118.     return [ORB::nil]
  119.     }
  120.     return [$dbObj customLevelVersion]
  121. }
  122.  
  123. method BrowsUiObj::displayName {this} {
  124.     return "[$this uiName]"
  125. }
  126.  
  127. method BrowsUiObj::filterType {this} {
  128.     return [$this browserType]
  129. }
  130.  
  131. method BrowsUiObj::getIndentation {this} {
  132.     set uiPrefix "[$this uiPrefix]"
  133.     if {"$uiPrefix" == "-"} {
  134.     set indent -1
  135.     } else {
  136.     set indent [expr [string length "$uiPrefix"] / 4]
  137.     }
  138.     return $indent
  139. }
  140.  
  141. method BrowsUiObj::getParent {this type} {
  142.     for {set obj [$this parent]} \
  143.     {"$obj" != ""} \
  144.     {set obj [$obj parent]} {
  145.     if {[$obj isA $type]} {
  146.         return $obj
  147.     }
  148.     }
  149.     return ""
  150. }
  151.  
  152. method BrowsUiObj::hasChildren {this} {
  153.     return 1
  154. }
  155.  
  156. method BrowsUiObj::initializeChildSet {this assocList} {
  157.     [$this childSet] contents ""
  158.     set errorStack ""
  159.  
  160.     if [lempty $assocList] {
  161.     set assocList [[$this browserObjType]::associations]
  162.     }
  163.     foreach association $assocList {
  164.     if [catch {$this setChildSet $association [$this $association]} msg] {
  165.         if {"$errorStack" != ""} {
  166.         append errorStack "\n"
  167.         }
  168.         append errorStack $msg
  169.     }
  170.     }
  171.  
  172.     return $errorStack
  173. }
  174.  
  175. method BrowsUiObj::initializeInfo {this arg} {
  176.     [$this info] contents [list \
  177.     Name "[$this displayName]" \
  178.     Type "[$this browserType]" \
  179.     Identity "[$this uiIdentity]" \
  180.     Text "[$this uiText]" \
  181.     ]
  182. }
  183.  
  184. method BrowsUiObj::makeUpToDate {this} {
  185.     # dummy call to server
  186. }
  187.  
  188. method BrowsUiObj::recursiveIdSet {this skipList} {
  189.     set idList ""
  190.     foreach browsUiObj [$this recursiveObjSet $skipList] {
  191.     lappend idList [$browsUiObj getInfo Identity]
  192.     }
  193.     return "$idList"
  194. }
  195.  
  196. method BrowsUiObj::recursiveObjSet {this skipList} {
  197.     set objList ""
  198.     set found 0
  199.     foreach obj [[$wmttoolObj flatView] objectSet] {
  200.     set browsUiObj [$obj browsUiObj]
  201.     if {"$browsUiObj" != "$this" && (! $found)} continue
  202.     if {$browsUiObj == $this} {
  203.         set found 1
  204.         set indentation [$browsUiObj getIndentation]
  205.         if {$indentation < 0} break
  206.     } elseif {[$browsUiObj getIndentation] <= $indentation} {
  207.         break
  208.     }
  209.  
  210.     set skip 0
  211.     foreach type $skipList {
  212.         if [$browsUiObj isA $type] {
  213.         set skip 1
  214.         break
  215.         }
  216.     }
  217.     if $skip continue
  218.  
  219.     lappend objList $browsUiObj
  220.     }
  221.     return "$objList"
  222. }
  223.  
  224. method BrowsUiObj::rules {this} {
  225.     # Check if the related BrowsDbObj is a Controlled
  226.     if [$this isA BrowsDbObj] {
  227.     set dbObj $this
  228.     } else {
  229.     set dbObj [$this getParent BrowsDbObj]
  230.     }
  231.     if {! [$dbObj isA Controlled]} {
  232.     return ""
  233.     }
  234.  
  235.     # Make the access attribute for each RuleUiObj empty
  236.     foreach ruleUiObj [[$this RuleUiObj] values] {
  237.     $ruleUiObj access ""
  238.     }
  239.  
  240.     # Update or create one RuleUiObj
  241.     # for each controlled action of each RoleRight
  242.     if [$dbObj isA ControlledList] {
  243.     set roleRightList [concat [$dbObj newChildRights] [$dbObj rights]]
  244.     } else {
  245.     set roleRightList [$dbObj rights]
  246.     }
  247.     foreach roleRight $roleRightList {
  248.     set role [[$roleRight role] name]
  249.     set type [$roleRight type]
  250.     if {"$type" == "childRight"} {
  251.         set actionList "[BrowserProcs::action2String 1023]"
  252.         set prefix "new elements of "
  253.     } else {
  254.         set actionList [$dbObj getInfo "Controlled Actions"]
  255.         set prefix ""
  256.     }
  257.     foreach action $actionList {
  258.         if [$roleRight allows $action] {
  259.         set access "Allowed"
  260.         } elseif [$roleRight prohibits $action] {
  261.         set access "Prohibited"
  262.         } else {
  263.         set access "Undefined"
  264.         }
  265.         regsub -all " |\\." "${role}${action}${type}" "" ruleId
  266.         set ruleUiObj [$this getRuleUiObj $ruleId]
  267.         if {"$ruleUiObj" == ""} {
  268.         set ruleUiObj \
  269.             [RuleUiObj new $this.${RuleUiObj::uiClass}:$ruleId \
  270.             -parent $this \
  271.             -uiName $action \
  272.             -uiText "$action access rule for role '$role' \
  273.                  on ${prefix}[$dbObj getInfo Text]" \
  274.             -roleName "$role" \
  275.             -type $type \
  276.             -access "$access" \
  277.             ]
  278.         $this setRuleUiObj $ruleId $ruleUiObj
  279.         } else {
  280.         $ruleUiObj access $access
  281.         }
  282.     }
  283.     }
  284.  
  285.     # Remove all RuleUiObj objects with an empty access attribute
  286.     foreach ruleId [[$this RuleUiObj] names] {
  287.     if {"[[$this getRuleUiObj $ruleId] access]" == ""} {
  288.         $this removeRuleUiObj $ruleId
  289.     }
  290.     }
  291.  
  292.     return [[$this RuleUiObj] values]
  293. }
  294.  
  295. method BrowsUiObj::setIndentation {this indent} {
  296.     if {$indent < 0} {
  297.     set uiPrefix "-"
  298.     } else {
  299.     set uiPrefix ""
  300.     for {set i 0} {$i < $indent} {incr i 1} {
  301.         set uiPrefix "$uiPrefix    "
  302.     }
  303.     }
  304.     $this uiPrefix "$uiPrefix"
  305. }
  306.  
  307. method BrowsUiObj::typeInLabel {this} {
  308.     return 0
  309. }
  310.  
  311. method BrowsUiObj::uiClass {this} {
  312.     return [set [$this browserObjType]::uiClass]
  313. }
  314.  
  315. method BrowsUiObj::uiIdentity {this} {
  316.     return "[string range $this [expr [string last . $this] + 1] end]"
  317. }
  318.  
  319. method BrowsUiObj::versionInLabel {this} {
  320.     return 0
  321. }
  322.  
  323. # Do not delete this line -- regeneration end marker
  324.  
  325. method BrowsUiObj::infoObject {this args} {
  326.     if {$args == ""} {
  327.         return [$this _infoObject]
  328.     }
  329.     set ref [$this _infoObject]
  330.     if {$ref != ""} {
  331.         $ref _browsUiObj ""
  332.     }
  333.     set obj [lindex $args 0]
  334.     if {$obj != ""} {
  335.         $obj _browsUiObj $this
  336.     }
  337.     $this _infoObject $obj
  338. }
  339.  
  340. method BrowsUiObj::getChildSet {this association} {
  341.     return [[$this childSet] set $association]
  342. }
  343.  
  344. method BrowsUiObj::setChildSet {this association newChildSet} {
  345.     [$this childSet] set $association $newChildSet
  346. }
  347.  
  348. method BrowsUiObj::removeChildSet {this association} {
  349.     [$this childSet] unset $association
  350. }
  351.  
  352. method BrowsUiObj::getInfo {this header} {
  353.     return [[$this info] set $header]
  354. }
  355.  
  356. method BrowsUiObj::setInfo {this header newInfo} {
  357.     [$this info] set $header $newInfo
  358. }
  359.  
  360. method BrowsUiObj::removeInfo {this header} {
  361.     [$this info] unset $header
  362. }
  363.  
  364.