home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / groups.tcl < prev    next >
Text File  |  1997-01-09  |  4KB  |  142 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #    (c) Cadre Technologies Inc. 1995
  4. #
  5. #    File:        @(#)groups.tcl    /main/titanic/1
  6. #    Author:        Harm Leijendeckers
  7. #    Description:    Report on group versions
  8. #    Usage in:    SystemVersion
  9. #
  10. #---------------------------------------------------------------------------
  11. # SccsId = @(#)groups.tcl    /main/titanic/1    9 Jan 1997    Copyright 1995 Cadre Technologies Inc.
  12.  
  13.  
  14. Class ReportGroups : {ReportBase} {
  15.     constructor
  16.     method systemReport
  17.  
  18.     method explicitFiles
  19.     method explicitSubgroups
  20.     method filtersAndSelectors
  21. }
  22.  
  23.  
  24. constructor ReportGroups {class this} {
  25.     set this [ReportBase::constructor $class $this]
  26.     $this reportName "Contents of Group Versions"
  27.     return $this
  28. }
  29.  
  30.  
  31. method ReportGroups::systemReport {this} {
  32.     set allGroupVersions [[$this systemV] groupVersions]
  33.     if [lempty $allGroupVersions] { return 0 }
  34.  
  35.     set report [$this report]
  36.     $report header {
  37.     [$this report] print Group 20
  38.     [$this report] print Status 8
  39.     [$this report] print Link 8
  40.     [$this report] print "Explicit Files" 24
  41.     [$this report] print "Explicit Subs" 20
  42.     [$this report] print "Filters / Selectors" line
  43.     [$this report] line
  44.     }
  45.  
  46.     foreach groupV [osort group.name $allGroupVersions] {
  47.     $report print [[$groupV group] name].[$groupV versionName] 19
  48.     $report space
  49.     $report print [$groupV status] 7
  50.     $report space
  51.     set link [[$this systemV] findGroupVersionLink -byVersion $groupV]
  52.     if { ![$link isNil] } {
  53.         $report print [$link status] 7
  54.         $report space
  55.     } else {
  56.         $report space 8
  57.     }
  58.  
  59.     $report print [$this explicitFiles $groupV] 24
  60.     $report print [$this explicitSubgroups $groupV] 20
  61.     $report print [$this filtersAndSelectors $groupV] 51 line
  62.  
  63.     $report line
  64.     }
  65.  
  66.     $report page
  67.     $report remove header
  68.  
  69.     return 0
  70. }
  71.  
  72.  
  73. method ReportGroups::explicitFiles {this groupV} {
  74.     set files [osort type name [$groupV explicitFiles]]
  75.     set result ""
  76.     foreach file $files {
  77.     set name [string range [$file name].[$file type] 0 22]
  78.     set result [format "%s%-23s " $result $name]
  79.     }
  80.  
  81.     return $result;
  82. }
  83.  
  84.  
  85. method ReportGroups::explicitSubgroups {this groupV} {
  86.     set subgroups [osort name [$groupV explicitSubgroups]]
  87.     set result ""
  88.     foreach subgroup $subgroups {
  89.     set name [string range [$subgroup name] 0 18]
  90.     set result [format "%s%-19s " $result $name]
  91.     }
  92.  
  93.     return $result;
  94. }
  95.  
  96.  
  97. method ReportGroups::filtersAndSelectors {this groupV} {
  98.     set filters [osort filterType [$groupV filters]]
  99.     set fileSelectors [osort itemType [$groupV fileSelectors]]
  100.     set itemSelectors [osort itemType fileType [$groupV itemSelectors]]
  101.     set result ""
  102.  
  103.     foreach filter [osort filterType $filters] {
  104.     set str [list [$filter namePattern] [$filter typePattern] \
  105.               [$filter propName] [$filter propPattern]]
  106.     add result "F [string range [$filter filterType] 0 3]" $str
  107.     }
  108.  
  109.     foreach sel [osort itemType $fileSelectors] {
  110.     set str [list [$sel itemType] [$sel decompFlags] [$sel fileTypes]]
  111.     regsub -all decompFiles $str file str
  112.     regsub -all decompParents $str parent str
  113.     regsub -all decompComponents $str comp str
  114.     regsub -all decompLeafs $str leaf str
  115.     add result "S file" $str
  116.     }
  117.  
  118.     foreach sel [osort itemType fileType $itemSelectors] {
  119.     set str [list [$sel fileType] [$sel itemType] [$sel qualified]]
  120.     add result "S item" $str
  121.     }
  122.  
  123.     return $result;
  124. }
  125.  
  126.  
  127. proc add { result str1 str2 } {
  128.     upvar 1 $result res
  129.     while { [string length $str2] > 44 } {
  130.     set head [string range $str2 0 43]
  131.     set str2 [string range $str2 44 end]
  132.     set res [format "%s%-6s %-44s" $res $str1 $head]
  133.     set str1 "      "
  134.     }
  135.     set res [format "%s%-6s %-44s" $res $str1 $str2]
  136. }
  137.  
  138.  
  139. # ----------------------------------------------------------------------
  140. #
  141. set executeMe [ReportGroups new]
  142.