home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / infoview.tcl < prev    next >
Text File  |  1996-11-11  |  14KB  |  493 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cadre Technologies Inc.    1996
  4. #
  5. #      File:           @(#)infoview.tcl    /main/hindenburg/4
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)infoview.tcl    /main/hindenburg/4   11 Nov 1996 Copyright 1996 Cadre Technologies Inc.
  10.  
  11. # Start user added include file section
  12. require "infoheader.tcl"
  13. require "infoobject.tcl"
  14. # End user added include file section
  15.  
  16.  
  17. Class InfoView : {DlgRow} {
  18.     method destructor
  19.     constructor
  20.     method clear
  21.     method display
  22.     method print
  23.     method saveContents
  24.     method setCurrentObj
  25.     method sort
  26.     method updateToolBarEntries
  27.     method addNewObject
  28.     method removeNewObject
  29.     method addOldObject
  30.     method removeOldObject
  31.     method getVisible
  32.     method setVisible
  33.     method removeVisible
  34.     attribute area
  35.     attribute currentObj
  36.     attribute currentViewName
  37.     attribute currentViewObj
  38.     attribute currentViewProperties
  39.     attribute currentViewToolBarEntries
  40.     attribute count
  41.     attribute newObjectSet
  42.     attribute oldObjectSet
  43.     attribute currentSpec
  44.     attribute visible
  45. }
  46.  
  47. method InfoView::destructor {this} {
  48.     # Start destructor user section
  49.     # End destructor user section
  50. }
  51.  
  52. constructor InfoView {class this name} {
  53.     set this [DlgRow::constructor $class $this $name]
  54.     $this visible [Dictionary new]
  55.     $this oldObjectSet [List new]
  56.     $this newObjectSet [List new]
  57.  
  58.     # Initialize attributes
  59.     $this count 0
  60.     $this currentViewName "Default"
  61.  
  62.     return $this
  63. }
  64.  
  65. method InfoView::clear {this} {
  66.     [$this newObjectSet] foreach object {
  67.     $object delete
  68.     }
  69.     [$this newObjectSet] contents ""
  70.     foreach header [[$this area] headerSet] {
  71.     $header delete
  72.     }
  73. }
  74.  
  75. method InfoView::display {this viewName} {
  76.     if {! [isCommand [$this currentObj]]}  {
  77.     $this clear
  78.     return
  79.     }
  80.  
  81.     # Determine current view specification
  82.     set obj [[$this currentObj] browsUiObj]
  83.     set objType [$obj uiClass]
  84.     set browserType [$obj browserType]
  85.     if {"$viewName" == ""} {
  86.     set viewName "[$this currentViewName]"
  87.     }
  88.     $this currentSpec [[$wmttoolObj viewHdlr] getViewSpec \
  89.     "$objType" "$browserType" "$viewName" \
  90.     ]
  91.  
  92.     # Clear view and return if view-spec could not be found
  93.     if {! [isCommand [$this currentSpec]]} {
  94.     if {"$viewName" != "Default"} {
  95.         $this display Default
  96.         return
  97.     }
  98.     $this currentViewName $viewName
  99.     $this currentViewObj $obj
  100.     $this currentViewProperties ""
  101.     $this clear
  102.     wmtkerror \
  103.         "Could not find default view specification '$objType $browserType'"
  104.     return
  105.     }
  106.  
  107.     # Determine if headers should be removed
  108.     if {"[$this currentViewProperties]" == "[[$this currentSpec] properties]"} {
  109.     set removeHeaders 0
  110.     } else {
  111.     set removeHeaders 1
  112.     }
  113.     $this currentViewProperties [[$this currentSpec] properties]
  114.  
  115.     # Need to update the toolBarEntries when changing view only
  116.     if {[isCommand [$wmttoolObj toolBar]] &&
  117.     "$obj" == "[$this currentViewObj]" &&
  118.     "$viewName" != "[$this currentViewName]"} {
  119.     $this updateToolBarEntries 1
  120.     }
  121.  
  122.     $this currentViewName $viewName
  123.     $this currentViewObj $obj
  124.     if [isCommand [$wmttoolObj wmtArea]] {
  125.     [$wmttoolObj wmtArea] updateViewInfo
  126.     }
  127.  
  128.     busy {
  129.     # Initialize document if necessary
  130.     if [$obj isA Document] {
  131.         $obj initialize [$obj getParent ConfigVersion]
  132.     }
  133.  
  134.     # Retrieve the children repository objects
  135.     set errorStack \
  136.         [$obj initializeChildSet [[$this currentSpec] associations]]
  137.     if {"$errorStack" != ""} {
  138.         if [info exists errorInfo] {
  139.         set errorTrace $errorInfo
  140.         set errorCodeCopy $errorCode
  141.         } else {
  142.         set errorTrace ""
  143.         set errorCodeCopy ""
  144.         }
  145.     }
  146.  
  147.     # Initialize
  148.     set childSet ""
  149.     foreach association [[$this currentSpec] associations] {
  150.         append childSet " [$obj getChildSet $association]"
  151.     }
  152.     foreach objectType [[$this visible] names] {
  153.         $this removeVisible $objectType
  154.     }
  155.     set objectTypes [[$this currentSpec] objectTypes]
  156.     if [lempty $objectTypes] {
  157.         set checkObjectTypes 0
  158.     } else {
  159.         set checkObjectTypes 1
  160.         foreach objectType $objectTypes {
  161.         $this setVisible $objectType 1
  162.         }
  163.     }
  164.     set headerCount 0
  165.     foreach headerSpec [$this currentViewProperties] {
  166.         set j 0
  167.         foreach element $headerSpec {
  168.         set headerMatrix($headerCount,$j) $element
  169.         incr j 1
  170.         }
  171.         incr headerCount 1
  172.     }
  173.  
  174.     # Create header row
  175.     if $removeHeaders {
  176.         $this clear
  177.         for {set id 0} {$id < $headerCount} {incr id 1} {
  178.         set header [$this area].header$id
  179.         InfoHeader new $header \
  180.             -label "$headerMatrix($id,0)" \
  181.             -width "$headerMatrix($id,1)" \
  182.             -type "$headerMatrix($id,2)" \
  183.             -sortPolicy "[lindex $headerMatrix($id,3) 0]" \
  184.             -sortIndex [lindex $headerMatrix($id,3) 1]
  185.         }
  186.     }
  187.  
  188.     # Create rows
  189.     set index 0
  190.     set count [$this count]
  191.     [$this oldObjectSet] contents [[$this area] objectSet]
  192.     [$this newObjectSet] contents ""
  193.     foreach child $childSet {
  194.         set object [$child infoObject]
  195.         $child parent $obj
  196.         BrowserProcs::initializeInfo $child $child
  197.  
  198.         # Create row, skip if child's type is invisible
  199.         set uiType "[$child browserType]"
  200.         if {$checkObjectTypes &&
  201.         "[$this getVisible $uiType]" == ""} continue
  202.         if {"$object" == ""} {
  203.         set object [$this area].object$count
  204.         incr count
  205.         InfoObject new $object $child
  206.         } else {
  207.         $this removeOldObject $object
  208.         }
  209.         $this addNewObject $object
  210.  
  211.         # Determine label and details
  212.         set label ""
  213.         set details ""
  214.         for {set i 0} {$i < $headerCount} {incr i 1} {
  215.         set column "$headerMatrix($i,0)"
  216.         set value "[$child getInfo $column]"
  217.         if {"$column" == "Name"} {
  218.             set value "[$child uiPrefix]$value"
  219.         }
  220.         if {$i == 0} {
  221.             set label "$value"
  222.         } else {
  223.             lappend details "$value"
  224.         }
  225.         }
  226.  
  227.         # Update row
  228.         set childType "[$child uiClass]"
  229.         set typeSpec \
  230.         [getObjectSpec [$wmttoolObj objectHdlr] "$childType" "$uiType"]
  231.         if {"$typeSpec" != ""} {
  232.         set smallIcon "[$typeSpec smallIcon]"
  233.         set largeIcon "[$typeSpec largeIcon]"
  234.         set activated "[$typeSpec defaultAction]"
  235.         } else {
  236.         set smallIcon ""
  237.         set largeIcon ""
  238.         set activated ""
  239.         }
  240.         $object config \
  241.         -index $index \
  242.         -smallIcon "$smallIcon" \
  243.         -largeIcon "$largeIcon" \
  244.         -label "$label" \
  245.         -details "$details" \
  246.         -activated "$activated"
  247.  
  248.         incr index 1
  249.     }
  250.     $this count $count
  251.  
  252.     [$this oldObjectSet] foreach object {
  253.         $object delete
  254.     }
  255.     if [isCommand [$wmttoolObj filterHdlr]] {
  256.         [$wmttoolObj filterHdlr] filter
  257.     }
  258.  
  259.     # Sort the view
  260.     $this sort
  261.     }
  262.  
  263.     if {"$errorStack" != ""} {
  264.     global errorInfo errorCode
  265.     set errorInfo $errorTrace
  266.     set errorCode $errorCodeCopy
  267.     wmtkerror $errorStack
  268.     }
  269. }
  270.  
  271. method InfoView::print {this} {
  272.     set printer [m4_var get M4_a_printer]
  273.     set printfile [args_file {}]
  274.     $this saveContents $printfile
  275.     $wmttoolObj startCommand extern \
  276.     "$printer $printfile" [list BasicFS::removeFile $printfile] \
  277.     "Sending output to $printer..." \
  278.     {0 0} 0
  279. }
  280.  
  281. method InfoView::saveContents {this printFile} {
  282.     set fid [open $printFile w]
  283.     set limit [m4_var get M4_a_printer_llen]
  284.  
  285.     # Print level information
  286.     if [isCommand [$wmttoolObj wmtArea]] {
  287.     set arrayList ""
  288.     set projectInfo [[$wmttoolObj wmtArea] projectInfo]
  289.     lappend arrayList "\
  290.         \"[$projectInfo labelText]\" \"[$projectInfo valueText]\""
  291.     set configInfo [[$wmttoolObj wmtArea] configInfo]
  292.     lappend arrayList "\
  293.         \"[$configInfo labelText]\" \"[$configInfo valueText]\""
  294.     set phaseInfo [[$wmttoolObj wmtArea] phaseInfo]
  295.     lappend arrayList "\
  296.         \"[$phaseInfo labelText]\" \"[$phaseInfo valueText]\""
  297.     set systemInfo [[$wmttoolObj wmtArea] systemInfo]
  298.     lappend arrayList "\
  299.         \"[$systemInfo labelText]\" \"[$systemInfo valueText]\""
  300.     set viewInfo [[$wmttoolObj wmtArea] viewInfo]
  301.     lappend arrayList "\
  302.         \"[$viewInfo labelText]\" \"[$viewInfo valueText]\""
  303.     set filterInfo [[$wmttoolObj wmtArea] filterInfo]
  304.     lappend arrayList "\
  305.         \"[$filterInfo labelText]\" \"[$filterInfo valueText]\""
  306.     set lengths [maxLengthList $arrayList]
  307.     set formatString "%-*.*s  %-*.*s"
  308.     foreach array $arrayList {
  309.         set line [format "$formatString" \
  310.         [lindex $lengths 0] [lindex $lengths 0] [lindex $array 0] \
  311.         [lindex $lengths 1] [lindex $lengths 1] [lindex $array 1]]
  312.         foreach part [lineBreak $line $limit " "] {puts $fid $part}
  313.     }
  314.     puts $fid "\n"
  315.     }
  316.  
  317.     # Print view information
  318.     set i 0
  319.     set line ""
  320.     foreach header [[$this area] headerSet] {
  321.     set len($i) [expr [$header width] + 1]
  322.     append line [format "%-*.*s" $len($i) $len($i) [$header label]]
  323.     incr i 1
  324.     }
  325.     if {$i == 0} {
  326.     close $fid
  327.     return
  328.     }
  329.     foreach part [lineBreak $line $limit " "] {puts $fid $part}
  330.     set line ""
  331.     for {set count 0} {$count < $i} {incr count 1} {
  332.     for {set column 0} {$column < $len($count)} {incr column 1} {
  333.         append line "="
  334.     }
  335.     }
  336.     foreach part [lineBreak $line $limit " "] {puts $fid $part}
  337.  
  338.     foreach object [[$this area] objectSet] {
  339.     set line ""
  340.     if [$object filteredOutState] continue
  341.     append line [format "%-*.*s" $len(0) $len(0) [$object label]]
  342.     set i 1
  343.     foreach detail [$object details] {
  344.         append line [format "%-*.*s" $len($i) $len($i) $detail]
  345.         incr i 1
  346.     }
  347.     foreach part [lineBreak $line $limit " "] {puts $fid $part}
  348.     }
  349.  
  350.     close $fid
  351. }
  352.  
  353. method InfoView::setCurrentObj {this newObject} {
  354.     $this currentObj $newObject
  355.     $this display [$this currentViewName]
  356. }
  357.  
  358. method InfoView::sort {this} {
  359.     if [[$this newObjectSet] empty] {
  360.     return
  361.     }
  362.  
  363.     foreach header [[$this area] headerSet] {
  364.     if {"[$header sortPolicy]" == "none"} continue
  365.     set index [$header sortIndex]
  366.     if {("$index" == "") || ($index < 1)} continue
  367.     set sortSpec($index) \
  368.         "-column {$header [$header type] [$header sortPolicy]}"
  369.     }
  370.  
  371.     set sortSpecList ""
  372.     if [catch {set indices [lsort -integer [array names sortSpec]]}] {
  373.     global errorInfo
  374.     set errorInfo ""
  375.     global errorCode
  376.     set errorCode ""
  377.     } else {
  378.     foreach index $indices {
  379.         append sortSpecList " $sortSpec($index)"
  380.     }
  381.     }
  382.     set sortProc [[$this currentSpec] sortScript]
  383.     if {"$sortProc" != ""} {
  384.     set sortSpecList "$sortSpecList -command $sortProc"
  385.     }
  386.  
  387.     if [lempty $sortSpecList] {
  388.     set sortSpecList "-command InfoObject::sort"
  389.     }
  390.  
  391.     eval [$this area] sort $sortSpecList
  392. }
  393.  
  394. method InfoView::updateToolBarEntries {this {removeEntries 0}} {
  395.     # ToolBar entries are added:
  396.     # - in the customizehandler when a menu entry has inToolBar set to 1
  397.     # - here, according to toolBarEntries of viewSpec
  398.  
  399.     if {! [isCommand [$wmttoolObj toolBar]]} {
  400.     return
  401.     }
  402.  
  403.     # Determine current toolBar entries
  404.     # - remove toolBar entries specified in previous view
  405.     # - add toolBar entries specified in current view
  406.     set oldEntrySet [[$wmttoolObj toolBar] entrySet]
  407.     if $removeEntries {
  408.     foreach entry [$this currentViewToolBarEntries] {
  409.         set removeEntry($entry) 1
  410.     }
  411.     foreach entry $oldEntrySet {
  412.         if [info exists removeEntry($entry)] continue
  413.         lappend toolBarEntries $entry
  414.     }
  415.     } else {
  416.     set toolBarEntries $oldEntrySet
  417.     }
  418.     if [isCommand [$this currentSpec]] {
  419.     foreach entry [[$this currentSpec] toolBarEntries] {
  420.         if {"$entry" != "SEPARATOR"} {
  421.         set entry "[$wmttoolObj menuBar]$entry"
  422.         set viewEntry($entry) 1
  423.         }
  424.         lappend toolBarEntries $entry
  425.     }
  426.     }
  427.  
  428.     # Check toolBar entries
  429.     # - skip entries of non-existing buttons
  430.     # - skip double entries
  431.     # - skip dummy separators
  432.     set separator 0
  433.     set entrySet ""
  434.     set viewToolBarEntries ""
  435.     foreach entry $toolBarEntries {
  436.     if {"$entry" == "SEPARATOR" && $separator == 0} {
  437.         lappend entrySet "$entry"
  438.         set separator 1
  439.     } else {
  440.         if {! [isCommand $entry]} continue
  441.         if [info exists toolBarEntry($entry)] continue
  442.         lappend entrySet "$entry"
  443.         if [info exists viewEntry($entry)] {
  444.         lappend viewToolBarEntries $entry
  445.         }
  446.         set toolBarEntry($entry) 1
  447.         set separator 0
  448.     }
  449.     }
  450.     if {[llength $toolBarEntries] > 0 && "$entry" == "SEPARATOR"} {
  451.     set entrySet [lreplace $entrySet [expr [llength $entrySet] - 1] end]
  452.     }
  453.     $this currentViewToolBarEntries $viewToolBarEntries
  454.  
  455.     # Set toolBar entries if necessary
  456.     if {$entrySet != $oldEntrySet} {
  457.     [$wmttoolObj toolBar] entrySet $entrySet
  458.     }
  459. }
  460.  
  461. # Do not delete this line -- regeneration end marker
  462.  
  463. method InfoView::addNewObject {this newNewObject} {
  464.     [$this newObjectSet] append $newNewObject
  465.  
  466. }
  467.  
  468. method InfoView::removeNewObject {this oldNewObject} {
  469.     [$this newObjectSet] removeValue $oldNewObject
  470. }
  471.  
  472. method InfoView::addOldObject {this newOldObject} {
  473.     [$this oldObjectSet] append $newOldObject
  474.  
  475. }
  476.  
  477. method InfoView::removeOldObject {this oldOldObject} {
  478.     [$this oldObjectSet] removeValue $oldOldObject
  479. }
  480.  
  481. method InfoView::getVisible {this objectType} {
  482.     return [[$this visible] set $objectType]
  483. }
  484.  
  485. method InfoView::setVisible {this objectType newVisible} {
  486.     [$this visible] set $objectType $newVisible
  487. }
  488.  
  489. method InfoView::removeVisible {this objectType} {
  490.     [$this visible] unset $objectType
  491. }
  492.  
  493.