home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / cbassoctex.tcl < prev    next >
Text File  |  1996-06-11  |  5KB  |  179 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cadre Technologies Inc.    1996
  4. #
  5. #      File:           @(#)cbassoctex.tcl    /main/2
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)cbassoctex.tcl    /main/2   11 Jun 1996 Copyright 1996 Cadre Technologies Inc.
  10.  
  11. # Start user added include file section
  12. # End user added include file section
  13.  
  14. require "cbclassinf.tcl"
  15.  
  16. Class CBAssocTextList : {CBClassInfoTextList} {
  17.     constructor
  18.     method destructor
  19.     method updateView
  20.     method collectAssociations
  21.     method collectInheritedAssociations
  22.     method getSelTextListEntry
  23.     method fillEntries
  24.     method browser
  25.     method addBinaryAssocIn
  26.     method removeBinaryAssocIn
  27.     method addBinaryAssocOut
  28.     method removeBinaryAssocOut
  29.     method addNAssocConn
  30.     method removeNAssocConn
  31.     attribute _browser
  32.     attribute binaryAssocInSet
  33.     attribute binaryAssocOutSet
  34.     attribute nAssocConnSet
  35. }
  36.  
  37. constructor CBAssocTextList {class this name} {
  38.     set this [CBClassInfoTextList::constructor $class $this $name]
  39.     $this binaryAssocInSet [List new]
  40.     $this binaryAssocOutSet [List new]
  41.     $this nAssocConnSet [List new]
  42.     # Start constructor user section
  43.     # End constructor user section
  44.     return $this
  45. }
  46.  
  47. method CBAssocTextList::destructor {this} {
  48.     set ref [$this _browser]
  49.     if {$ref != ""} {
  50.         $ref _assocTL ""
  51.     }
  52.     # Start destructor user section
  53.     # End destructor user section
  54.     $this CBClassInfoTextList::destructor
  55. }
  56.  
  57. method CBAssocTextList::updateView {this currentClass} {
  58.     $this removeTextListEntries
  59.     $this removeEntries
  60.     [$this binaryAssocInSet] contents ""
  61.     [$this binaryAssocOutSet] contents ""
  62.     [$this nAssocConnSet] contents ""
  63.  
  64.     if {[[$this browser] isInFlatViewMode]} {
  65.         set inFlatViewList [List new]
  66.         $inFlatViewList insert $currentClass
  67.         $this collectInheritedAssociations $currentClass $inFlatViewList 
  68.     }
  69.     $this collectAssociations $currentClass 
  70.  
  71.     [$this textListEntrySet] contents \
  72.         [concat [[$this binaryAssocInSet] contents] \
  73.         [[$this binaryAssocOutSet] contents] \
  74.         [[$this nAssocConnSet] contents]]
  75.     $this fillEntries
  76.     $this deselectEntries
  77. }
  78.  
  79. method CBAssocTextList::collectAssociations {this aClass} {
  80.     [$aClass binaryAssocInSet] foreach assoc {
  81.         [$this binaryAssocInSet] append $assoc
  82.     }
  83.     [$aClass binaryAssocOutSet] foreach assoc {
  84.         [$this binaryAssocOutSet] append $assoc
  85.     }
  86.     [$aClass nAssocConnSet] foreach nassocconn {
  87.         [$this nAssocConnSet] append $nassocconn
  88.     }
  89. }
  90.  
  91. method CBAssocTextList::collectInheritedAssociations {this aClass inFlatViewList} {
  92.     foreach superClass [$aClass getSuperClasses] {
  93.         if {[lsearch [$inFlatViewList contents] $superClass] != -1} {
  94.             continue
  95.         }
  96.         $inFlatViewList insert $superClass
  97.         $this collectInheritedAssociations $superClass $inFlatViewList
  98.         $this collectAssociations $superClass
  99.     }
  100. }
  101.  
  102. method CBAssocTextList::getSelTextListEntry {this} {
  103.     set idx [$this selectedIndexSet]
  104.     if {[llength $idx] == 0} {
  105.         return ""
  106.     }
  107.     set index [lindex $idx 0]
  108.     set assoc [[$this textListEntrySet] index $index]
  109.     set nrOfBinaryAssocIn [llength [[$this binaryAssocInSet] contents]]
  110.     set nrOfBinaryAssocOut [llength [[$this binaryAssocOutSet] contents]]
  111.     if {$index < $nrOfBinaryAssocIn} {
  112.         $assoc isInComing 1
  113.     } elseif {$index < [expr $nrOfBinaryAssocIn + $nrOfBinaryAssocOut]} {
  114.         $assoc isInComing 0
  115.     }
  116.     return $assoc
  117. }
  118.  
  119. method CBAssocTextList::fillEntries {this} {
  120.     set lst ""
  121.     [$this binaryAssocInSet] foreach assoc {
  122.         $assoc isInComing 1
  123.         lappend lst [$assoc format]
  124.     }
  125.     [$this binaryAssocOutSet] foreach assoc {
  126.         $assoc isInComing 0
  127.         lappend lst [$assoc format]
  128.     }
  129.     [$this nAssocConnSet] foreach nassocconn {
  130.         lappend lst [$nassocconn format]
  131.     }
  132.     $this entrySet $lst
  133. }
  134.  
  135. # Do not delete this line -- regeneration end marker
  136.  
  137. method CBAssocTextList::browser {this args} {
  138.     if {$args == ""} {
  139.         return [$this _browser]
  140.     }
  141.     set ref [$this _browser]
  142.     if {$ref != ""} {
  143.         $ref _assocTL ""
  144.     }
  145.     set obj [lindex $args 0]
  146.     if {$obj != ""} {
  147.         $obj _assocTL $this
  148.     }
  149.     $this _browser $obj
  150. }
  151.  
  152. method CBAssocTextList::addBinaryAssocIn {this newBinaryAssocIn} {
  153.     [$this binaryAssocInSet] append $newBinaryAssocIn
  154.  
  155. }
  156.  
  157. method CBAssocTextList::removeBinaryAssocIn {this oldBinaryAssocIn} {
  158.     [$this binaryAssocInSet] removeValue $oldBinaryAssocIn
  159. }
  160.  
  161. method CBAssocTextList::addBinaryAssocOut {this newBinaryAssocOut} {
  162.     [$this binaryAssocOutSet] append $newBinaryAssocOut
  163.  
  164. }
  165.  
  166. method CBAssocTextList::removeBinaryAssocOut {this oldBinaryAssocOut} {
  167.     [$this binaryAssocOutSet] removeValue $oldBinaryAssocOut
  168. }
  169.  
  170. method CBAssocTextList::addNAssocConn {this newNAssocConn} {
  171.     [$this nAssocConnSet] append $newNAssocConn
  172.  
  173. }
  174.  
  175. method CBAssocTextList::removeNAssocConn {this oldNAssocConn} {
  176.     [$this nAssocConnSet] removeValue $oldNAssocConn
  177. }
  178.  
  179.