home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / semanticbase.tcl < prev    next >
Text File  |  1997-08-27  |  3KB  |  147 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #    (c) Cadre Technologies Inc. 1995
  4. #
  5. #    File:        @(#)semanticbase.tcl    /main/titanic/2
  6. #    Author:        Harm Leijendeckers
  7. #    Description:    Base of all report classes which use the
  8. #            semantic model
  9. #
  10. #---------------------------------------------------------------------------
  11. # SccsId = @(#)semanticbase.tcl    /main/titanic/2    27 Aug 1997    Copyright 1995 Cadre Technologies Inc.
  12.  
  13.  
  14. Class SemanticBase : {ReportBase} {
  15.     method destructor
  16.     constructor
  17.     method phaseReport
  18.     method systemReport
  19.     method fileReport
  20.  
  21.     method doReport
  22.  
  23.     method objName
  24.     method objType
  25.     method labelValue
  26.     method fullFileName
  27. }
  28.  
  29.  
  30. constructor SemanticBase {class this} {
  31.     set this [ReportBase::constructor $class $this]
  32.     OTShRegister::semanticModel
  33.     defineTypes
  34.     return $this
  35. }
  36.  
  37.  
  38. method SemanticBase::destructor {this} {
  39.     [$this report] delete
  40. }
  41.  
  42.  
  43. method SemanticBase::phaseReport {this} {
  44.     set model  [SMPhaseModel new [$this configV] [$this phaseV]]
  45.     set result [$this doReport $model]
  46.     $model delete
  47.     return $result
  48. }
  49.  
  50.  
  51. method SemanticBase::systemReport {this} {
  52.     set model  [SMSystemModel new [$this configV] [$this systemV]]
  53.     set result [$this doReport $model]
  54.     $model delete
  55.     return $result
  56. }
  57.  
  58.  
  59. method SemanticBase::fileReport {this} {
  60.     set model  [SMFileModel new [$this configV] [$this fileV]]
  61.     set result [$this doReport $model]
  62.     $model delete
  63.     return $result
  64. }
  65.  
  66.  
  67. method SemanticBase::objName {this smObj} {
  68.     set class "SMConnector SMNode"
  69.  
  70.     if { [lsearch $class [$smObj objType]] != -1 } {
  71.         set label [$smObj getLabel]
  72.         if ![$label isNil] {
  73.             set name [$label value]
  74.             if ![lempty $name] {
  75.         return $name
  76.         }
  77.         }
  78.     }
  79.  
  80.     set item [$smObj getItem]
  81.     if ![$item isNil] {
  82.     return [$item name]
  83.     }
  84.     return "?"
  85. }
  86.  
  87.  
  88. method SemanticBase::objType {this smObj} {
  89.     return [[$smObj getSemType] name]
  90. }
  91.  
  92.  
  93. method SemanticBase::labelValue {this smObj} {
  94.     set label [$smObj getLabel]
  95.     if [$label isNil] {
  96.     return ""
  97.     }
  98.     set result ""
  99.     foreach item [query $label.itemRefs.item] {
  100.     if [lempty $result] {
  101.         set result [$item name]
  102.     } else {
  103.         set result [concat [$item name] ,$result]
  104.     }
  105.     }
  106.  
  107.     return $result
  108. }
  109.  
  110.  
  111. method SemanticBase::fullFileName {this fileVersion} {
  112.     if { [$fileVersion isNil] } { return "unknown" }
  113.     set file [$fileVersion file]
  114.     set result [$file qualifiedName].[$file type].[$fileVersion versionName]
  115.     set cc [ClientContext::global]
  116.     if { [$cc currentLevel] == "Phase" } {
  117.     append result " in system [[$file system] name]"
  118.     }
  119.     return $result
  120. }
  121.  
  122.  
  123. # ----------------------------------------------------------------------
  124. # initialization procedures
  125.  
  126. proc makeTypeName {method type} {
  127.     regsub -all "\[ \t]\[ \t]*" $type "_" type
  128.     return "[string toupper $method]_$type"
  129. }
  130.  
  131.  
  132. proc defineTypes {} {
  133.     set typeIter [SMTypeIter new]
  134.     while {[$typeIter current] != ""} {
  135.     set name [makeTypeName OMT [[$typeIter current] name]]
  136.     global $name
  137.     set $name [$typeIter current]
  138.     $typeIter next
  139.     }
  140.     $typeIter delete
  141.  
  142.     global ANY; set ANY [SMTypeDB::any]
  143.     global NIL; set NIL [SMTypeDB::nil]
  144.  
  145.     return
  146. }
  147.