home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / stcategories.tcl < prev    next >
Encoding:
Text File  |  1997-01-09  |  3.2 KB  |  122 lines
  1. #--------------------------------------------------------------------------->"
  2. #
  3. #    (c) Cayenne Software 1996
  4. #
  5. #    File:        @(#)stcategories.tcl    /main/titanic/2
  6. #    Description:    Report on categories (for Smalltalk)
  7. #
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)stcategories.tcl    /main/titanic/2 9 Jan 1997    Copyright 1996 Cayenne Software
  10.  
  11.  
  12. Class ReportSTCategories : {ReportBase} {
  13.     constructor
  14.     method systemReport
  15.     method fileReport
  16.  
  17.     method doReport
  18.     attribute categoryToClass
  19. }
  20.  
  21.  
  22. constructor ReportSTCategories {class this} {
  23.     set this [ReportBase::constructor $class $this]
  24.     $this reportName Categories
  25.     $this categoryToClass [Dictionary new]
  26.     return $this
  27. }
  28.  
  29.  
  30. method ReportSTCategories::systemReport {this} {
  31.     set allClassItems [query -s file.item \
  32.                  "file.type == cdm" \
  33.                  [[$this systemV] localFileVersions]]
  34.     return [$this doReport $allClassItems]
  35. }
  36.  
  37.  
  38. method ReportSTCategories::fileReport {this} {
  39.     set allClassItems [query -u -s labels.itemRefs.item \
  40.                  "type == cad_class" \
  41.                  [[$this fileV] nodes]]
  42.     return [$this doReport $allClassItems]
  43. }
  44.  
  45.  
  46. method ReportSTCategories::doReport {this classItems} {
  47.     if [lempty $classItems] { return 0 }
  48.  
  49.     set class_props [lvarpop Options]
  50.     set report [$this report]
  51.     set cv [$this configV]
  52.     set sv [$this systemV]
  53.     set pv [$this phaseV]
  54.  
  55.     # sort out default category
  56.     set defaultCategory [m4_var get M4_st_default_category]
  57.  
  58.     foreach classItem [osort name $classItems] {
  59.     set name [$classItem name]
  60.  
  61.     # find category
  62.     #
  63.     set wi [$sv findDeclaration $classItem $cv]
  64.     set category ""
  65.     if { ![$wi isNil] && ![[$wi properties] isNil] } {
  66.         foreach property [[$wi properties] properties] {
  67.         if { [$property name] == "classCategory" } {    
  68.             set category [$property value]
  69.             }    
  70.         }
  71.     }
  72.  
  73.     # use system or diagram name as default
  74.     if { $category == "" } {
  75.         if { $defaultCategory == "Diagram" } {
  76.         $pv getDecompositions $classItem [$this configV] \
  77.             {decompComponents decompParents decompLeafs} \
  78.             "" systemVersions fileVersions
  79.  
  80.         if { $fileVersions != "" } {
  81.             set category [[[lindex $fileVersions 0] file] name]
  82.         }
  83.         } else {
  84.         set category [[$sv system] name]
  85.         }
  86.         set name "$name (by default)"
  87.     }
  88.     
  89.     if { ![[$this categoryToClass] exists $category] } {
  90.         [$this categoryToClass] set $category [List new]
  91.     }
  92.     [[$this categoryToClass] set $category] append $name
  93.     }
  94.  
  95.     foreach category [lsort [[$this categoryToClass] names]]  {
  96.     set nameList [[$this categoryToClass] set $category]
  97.     if { $category == "" } {
  98.         set categoryDescription "Default Category"
  99.     } else {    
  100.         set categoryDescription "Category $category"
  101.     }
  102.     $report print $categoryDescription\: line
  103.     $report print = [string length $categoryDescription] fill line
  104.     $report line
  105.     $nameList foreach className {
  106.         $report print "$className "
  107.         $report line
  108.     }
  109.     $report line
  110.     $report line
  111.     }
  112.  
  113.     if { [[$executeMe report] pageno] || [[$executeMe report] lineno] } {
  114.     $report page
  115.     }
  116.  
  117.     return 0
  118. }
  119.  
  120.  
  121. set executeMe [ReportSTCategories new]
  122.