home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / components.tcl < prev    next >
Encoding:
Text File  |  1997-08-27  |  4.1 KB  |  171 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #    (c) Cadre Technologies Inc. 1995
  4. #
  5. #    File:        @(#)components.tcl    /main/titanic/2
  6. #    Author:        Harm Leijendeckers
  7. #    Description:    Report on Components and properties
  8. #    Usage in:    SystemVersion and FileVersion
  9. #
  10. #---------------------------------------------------------------------------
  11. # SccsId = @(#)components.tcl    /main/titanic/2    27 Aug 1997    Copyright 1996 Cadre Technologies Inc.
  12.  
  13.  
  14. Class ReportCompObject : {GCObject} {
  15.     constructor
  16.  
  17.     attribute component
  18.     attribute name
  19. }
  20.  
  21.  
  22. constructor ReportCompObject {class this component name} {
  23.     set this [GCObject::constructor $class $this]
  24.     $this component $component
  25.     $this name      $name
  26.     return $this
  27. }
  28.  
  29.  
  30. Class ReportComponents : {ReportBase} {
  31.     constructor
  32.  
  33.     attribute printProps
  34.  
  35.     method systemReport
  36.     method fileReport
  37.  
  38.     method doReport
  39.     method getName
  40. }
  41.  
  42.  
  43. constructor ReportComponents {class this} {
  44.     set this [ReportBase::constructor $class $this]
  45.     if { [lsearch $Options "properties"] != -1 } {
  46.         $this printProps 1
  47.     } else {
  48.         $this printProps 0
  49.     }
  50.     $this reportName "Components"
  51.     return $this
  52. }
  53.  
  54.  
  55. method ReportComponents::systemReport {this} {
  56.     GCControl collectInterval 9999
  57.     if { [[[$this phaseV] phase] type] == "Implementation" } return
  58.      
  59.     set components [query -s components "file.type != cdm" \
  60.                 [[$this systemV] localFileVersions]]
  61.     return [$this doReport components 1]
  62. }
  63.  
  64.  
  65. method ReportComponents::fileReport {this} {
  66.     set components [[$this fileV] components]
  67.     return [$this doReport components 0]
  68. }
  69.  
  70.  
  71. method ReportComponents::doReport {this v_components onSystemLevel} {
  72.     upvar $v_components components
  73.     if [lempty $components] { return 0 }
  74.  
  75.     foreach comp $components {
  76.     lappend compobjects [ReportCompObject new $comp [$this getName $comp]]
  77.     }
  78.  
  79.     set report [$this report]
  80.  
  81.     $report header {
  82.     [$this report] print Component 46
  83.     [$this report] print Type 22
  84.     if $onSystemLevel {
  85.         [$this report] print Diagram
  86.     }
  87.     [$this report] line
  88.     [$this report] line
  89.     }
  90.  
  91.     # Sorting order can be changed here (component.type <-> name).
  92.     foreach compobj [osort component.type name $compobjects] {
  93.         set comp [$compobj component]
  94.     $report print [$compobj name] 45
  95.     $report space
  96.     $report print [$comp type] 21
  97.     if $onSystemLevel {
  98.         $report space
  99.         $report print [[$comp diagram] text]
  100.     }
  101.     $report line
  102.  
  103.     # print properties
  104.         if [$this printProps] {
  105.         $this showProperties $comp
  106.     } else {
  107.             # elseif ![lempty $Options]  to show no props with no options
  108.         $this showProperties $comp "$Options"
  109.     }
  110.     }
  111.  
  112.     $report page
  113.     $report remove header
  114.  
  115.     return 0
  116. }
  117.  
  118.  
  119. method ReportComponents::getName {this comp} {
  120.     set queryConstraint "type in {name name_type event}"
  121.     case [$comp objType] in {
  122.     Node
  123.         { return [query -s value $queryConstraint $comp.labels] }
  124.  
  125.     ConnectedNode
  126.         {
  127.         set from [$comp from]
  128.         if {[$from isA Segment] &&
  129.             "[[$from connector] type]" == "nary_link_conn"} {
  130.             set name [query -s value $queryConstraint \
  131.             $from.connector.from.labels]
  132.         } else {
  133.             set name  [query -s value $queryConstraint $from.labels]
  134.             set value [query -s value $queryConstraint $comp.labels]
  135.         }
  136.         return "($name) $value"
  137.         }
  138.  
  139.     Connector
  140.         {
  141.         set name [query -s value $queryConstraint $comp.labels]
  142.         if {"$name" != ""} {
  143.             return $name
  144.         }
  145.         if [[$comp from] isA Segment] {
  146.             set from [query -s value $queryConstraint \
  147.             $comp.from.connector.labels]
  148.         } else {
  149.             set from [query -s value $queryConstraint \
  150.             $comp.from.labels]
  151.         }
  152.         if [[$comp to] isA Segment] {
  153.             set to [query -s value $queryConstraint \
  154.             $comp.to.connector.labels]
  155.         } else {
  156.             set to [query -s value $queryConstraint \
  157.             $comp.to.labels]
  158.         }
  159.         return "($from - $to)"
  160.         }
  161.  
  162.     { Segment Row Cell }
  163.         {
  164.         # should not occur
  165.         return ""
  166.         }
  167.     }
  168. }
  169.  
  170. set executeMe [ReportComponents new]
  171.