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