home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / events.tcl < prev    next >
Encoding:
Text File  |  1996-12-16  |  4.7 KB  |  179 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #    (c) Cadre Technologies Inc. 1995
  4. #
  5. #    File:        @(#)events.tcl    /main/hindenburg/7
  6. #    Author:        Harm Leijendeckers
  7. #    Description:    Report on events
  8. #    Usage in:    SystemVersion, CCD, ETD, STD and UCD editor
  9. #
  10. #---------------------------------------------------------------------------
  11. # SccsId = @(#)events.tcl    /main/hindenburg/7    16 Dec 1996    Copyright 1995 Cadre Technologies Inc.
  12.  
  13.  
  14. eval [$cc getCustomFileContents semanticbase tcl reports]
  15.  
  16.  
  17. Class ReportEvents : {SemanticBase} {
  18.     constructor
  19.     method doReport
  20.     method getNameAndType
  21. }
  22.  
  23.  
  24. constructor ReportEvents {class this} {
  25.     set this [SemanticBase::constructor $class $this]
  26.     $this reportName Events
  27.     return $this
  28. }
  29.  
  30.  
  31. method ReportEvents::doReport {this model} {
  32.     # get all CCD Classes
  33.     set events [concat [$model getSMObjects $OMT_Event] \
  34.                [$model getSMObjects $OMT_STD_StateEvent]]
  35.     if [lempty $events] { return 0 }
  36.  
  37.     set report [$this report]
  38.     $report header {
  39.     [$this report] print "From Component" 32
  40.     [$this report] print Event 32
  41.     [$this report] print "To Component" 32
  42.     [$this report] print Diagram line
  43.     [$this report] line
  44.     }
  45.  
  46.     set sortedEvents [concat [query "getItem.isNil == 1" $events] \
  47.     [osort getItem.name [query "getItem.isNil == 0" $events]]]
  48.     foreach event $sortedEvents {
  49.     # From Component
  50.     #
  51.     case [[$event getComponents] type] in {
  52.         event_msg {
  53.         set from [$event getFrom $OMT_STD_Event]
  54.         }
  55.  
  56.         state_action {
  57.         set from [$event getSuperiorObjects $OMT_STD_State]
  58.         }
  59.  
  60.         default {
  61.         set from [$event getFrom $OMT_EventSender]
  62.         }
  63.     }
  64.     set fromText [$this getNameAndType $from]
  65.  
  66.     # Event
  67.     #
  68.     set eventText [$this getNameAndType $event]
  69.     if { $eventText == "?" } {
  70.         # skip events with no name
  71.         continue
  72.     }
  73.  
  74.     # To Component
  75.     #
  76.     case [[$event getComponents] type] in {
  77.         state_action {
  78.         set to [$event getSuperiorObjects $OMT_STD_State]
  79.         }
  80.  
  81.         default {
  82.         set to [$event getTo $OMT_EventReceiver]
  83.         }
  84.     }
  85.     set toText [$this getNameAndType $to]
  86.  
  87.     # Diagram
  88.     #
  89.     if { $from != "" } {
  90.         set diagText [$this fullFileName [$from getDefiningDiagram]]
  91.     } elseif { $to != "" } {
  92.         set diagText [$this fullFileName [$to getDefiningDiagram]]
  93.     } else {
  94.         set diagText ?
  95.     }
  96.  
  97.     $report print $fromText 31
  98.     $report space
  99.     $report print $eventText 31
  100.     $report space
  101.     $report print $toText 31
  102.     $report space
  103.     $report print $diagText 35
  104.     $report line
  105.     }
  106.  
  107.     $report page
  108.     $report remove header
  109.  
  110.     return 0
  111. }
  112.  
  113.  
  114. method ReportEvents::getNameAndType {this smObject} {
  115.     if { $smObject == "" } {
  116.     return ?
  117.     }
  118.     set wi [$smObject getItem]
  119.     if ![$wi isNil] {
  120.     return "[$wi name] ([$wi type])"
  121.     }
  122.  
  123.     set qi [ORB::nil]
  124.     case [[$smObject getComponents] type] in {
  125.     ccd_actor    { set wi [$smObject getItem 0 name cl] }
  126.     ccd_class    { set wi [$smObject getItem 0 name cl] }
  127.     ccd_class_ref    { set wi [$smObject getItem 0 name cl] }
  128.     ccd_container    { set wi [$smObject getItem 0 name cl] }
  129.     com_message    { set wi [$smObject getItem 0 name pe] }
  130.     dir_com_assoc    { set wi [$smObject getItem 0 name pe] }
  131.     etd_event    { set wi [$smObject getItem 0 event pe] }
  132.     etd_initiator    { set wi [$smObject getItem 0 name_type de]
  133.               set qi [$smObject getItem 0 name_type cl] }
  134.     etd_object    { set wi [$smObject getItem 0 name_type de]
  135.               set qi [$smObject getItem 0 name_type cl] }
  136.     event_msg    { set wi [$smObject getItem 0 event pe] }
  137.     final_state    { set wi [$smObject getItem 0 name pe] }
  138.     state        { set wi [$smObject getItem 0 name st] }
  139.     start_state    { set wi [$smObject getItem 0 name st] }
  140.     state_action    { set wi [$smObject getItem 0 name cl] }
  141.     std_state    { set wi [$smObject getItem 0 name cl] }
  142.     std_class    { set wi [$smObject getItem 0 name cl] }
  143.     subject        { set wi [$smObject getItem 0 name cl] }
  144.     super_state    { set wi [$smObject getItem 0 name st] }
  145.     transition    { set wi [$smObject getItem 0 event pe] }
  146.     ucd_actor    { set wi [$smObject getItem 0 name cl] }
  147.     und_com_assoc    { set wi [$smObject getItem 0 name pe] }
  148.     use_case    { set wi [$smObject getItem 0 name cl] }
  149.  
  150.     default        { error "assert 'ReportEvents::getNameAndType'\
  151.                     [[$smObject getComponents] type]" }
  152.     }
  153.  
  154.     set result ""
  155.     if ![$wi isNil] {
  156.     lappend result [$wi name] ([$wi type])
  157.     if ![$qi isNil] {
  158.         lappend result :
  159.     }
  160.     }
  161.     if ![$qi isNil] {
  162.     lappend result [$qi name] ([$qi type])
  163.     }
  164.     if [lempty $result] {
  165.     set result ?
  166.     set label [$smObject getLabel]
  167.     if ![$label isNil] {
  168.         set result [$label value]
  169.     }
  170.     }
  171.  
  172.     return $result
  173. }
  174.  
  175.  
  176. # ----------------------------------------------------------------------
  177. #
  178. set executeMe [ReportEvents new]
  179.