home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / classbrows.tcl < prev    next >
Text File  |  1997-11-26  |  24KB  |  936 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cayenne Software Inc.    1997
  4. #
  5. #      File:           @(#)classbrows.tcl    /main/titanic/11
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)classbrows.tcl    /main/titanic/11   26 Nov 1997 Copyright 1997 Cayenne Software Inc.
  10.  
  11. # Start user added include file section
  12. require "cbwmtarea.tcl"
  13. require "cbsupercla.tcl"
  14. require "cbsubclass.tcl"
  15. require "cbclasstex.tcl"
  16. require "cbfeaturet.tcl"
  17. require "cbassoctex.tcl"
  18.  
  19. require "cbcadphase.tcl"
  20. require "cbcadsyste.tcl"
  21. require "cbclasssta.tcl"
  22.  
  23. require "classselha.tcl"
  24. require "diagramsel.tcl"
  25. require "workitemse.tcl"
  26.  
  27. require "cbpropview.tcl"
  28. require "cbfindclas.tcl"
  29. require "cbfindfeat.tcl"
  30. require "cbattrfilt.tcl"
  31. require "cboperfilt.tcl"
  32. require "cbfilterfe.tcl"
  33. require "cbfontchoo.tcl"
  34. require "tooloption.tcl"
  35.  
  36. require "cb2url.tcl"
  37. require "showversio.tcl"
  38. require "closeexitd.tcl"
  39. # End user added include file section
  40.  
  41. require "wmttool.tcl"
  42.  
  43. Class ClassBrowser : {WmtTool MainWindow} {
  44.     method destructor
  45.     constructor
  46.     method fileReloadClasses
  47.     method fileOpen
  48.     method fileClose
  49.     method fileFindClass
  50.     method fileFindFeature
  51.     method filePrintView
  52.     method fileExit
  53.     method itemShowProperties
  54.     method itemShowScope
  55.     method viewFlat
  56.     method viewFilterFeatures
  57.     method optionsSortCaseSensitive
  58.     method optionsFont
  59.     method optionsPrinterSetup
  60.     method utilEditCAD
  61.     method helpOnContext
  62.     method popUp
  63.     method initView
  64.     method selTextListChanged
  65.     method getSelTextListEntry
  66.     method getSelectedSet
  67.     method getCBClass
  68.     method getCurrentOpenedClassIndex
  69.     method updateClientContext
  70.     method addFileHistory
  71.     method renumberFileHistory
  72.     method updateFileHistory
  73.     method setFileHistory
  74.     method saveFileHistory
  75.     method addContextArea
  76.     method updateToolBar
  77.     method updateWmtArea
  78.     method updateTitle
  79.     method updateWmtAreaClass
  80.     method popupCloseExit
  81.     method doClose
  82.     method setFont
  83.     method helpOnName
  84.     method classTL
  85.     method superClassTL
  86.     method subClassTL
  87.     method featureTL
  88.     method assocTL
  89.     method startEditCADHandler
  90.     attribute projectName
  91.     attribute configurationName
  92.     attribute phaseName
  93.     attribute systemName
  94.     attribute className
  95.     attribute historyCount
  96.     attribute isInFlatViewMode
  97.     attribute showVisibility
  98.     attribute umlLook
  99.     attribute phaseLevelPathIds
  100.     attribute _classTL
  101.     attribute _superClassTL
  102.     attribute _subClassTL
  103.     attribute _featureTL
  104.     attribute _assocTL
  105.     attribute propertyViewer
  106.     attribute propKnowledgeDB
  107.     attribute filterFeaturesDialog
  108.     attribute options
  109.     attribute moduleHdlr
  110.     attribute fileHistorySet
  111.     attribute showScopeHandler
  112.     attribute closeExit
  113.     attribute menuHandler
  114.     attribute _startEditCADHandler
  115.     attribute editCADHandler
  116.     attribute openHandler
  117.     attribute selTextList
  118.     attribute currentOpenedClass
  119.     attribute openHistory
  120.     attribute ccontext
  121.     attribute model
  122.     attribute wmtArea
  123. }
  124.  
  125. global ClassBrowser::attrFilter
  126. set ClassBrowser::attrFilter ""
  127.  
  128. global ClassBrowser::operFilter
  129. set ClassBrowser::operFilter ""
  130.  
  131.  
  132. method ClassBrowser::destructor {this} {
  133.     set ref [$this _classTL]
  134.     if {$ref != ""} {
  135.         $ref _browser ""
  136.     }
  137.     set ref [$this _superClassTL]
  138.     if {$ref != ""} {
  139.         $ref _browser ""
  140.     }
  141.     set ref [$this _subClassTL]
  142.     if {$ref != ""} {
  143.         $ref _browser ""
  144.     }
  145.     set ref [$this _featureTL]
  146.     if {$ref != ""} {
  147.         $ref _browser ""
  148.     }
  149.     set ref [$this _assocTL]
  150.     if {$ref != ""} {
  151.         $ref _browser ""
  152.     }
  153.     set ref [$this _startEditCADHandler]
  154.     if {$ref != ""} {
  155.         $ref _browser ""
  156.     }
  157.     # Start destructor user section
  158.     $this saveFileHistory
  159.     $this saveToolBarPresence classbrowser
  160.     $this saveContextAreaPresence classbrowser
  161.     $this saveMessageAreaPresence classbrowser
  162.     $this saveWindowGeometry classbrowser
  163.     [$this moduleHdlr] delete
  164.     if {[$this model] != ""} {
  165.         [$this model] delete
  166.     }
  167.     GCControl collect
  168.     # End destructor user section
  169.     $this WmtTool::destructor
  170. }
  171.  
  172. constructor ClassBrowser {class this name ccontext} {
  173.     set this [MainWindow::constructor $class $this $name]
  174.     set this [WmtTool::constructor $class $this $name]
  175.     $this ccontext $ccontext
  176.  
  177.     # Initialize some attributes
  178.     #
  179.     $this model ""
  180.     global globalModuleHandler
  181.     set globalModuleHandler [ModuleHandler new \
  182.         -moduleSpecSetChanged {
  183.         set d_modules [%this deselectedModuleSpecSet]
  184.         foreach file [%this getFiles tcl d_clbrowser.tcl $d_modules] {
  185.             source $file
  186.         }
  187.         set s_modules [%this selectedModuleSpecSet]
  188.         foreach file [%this getFiles tcl s_clbrowser.tcl $s_modules] {
  189.             source $file
  190.         }
  191.         # clear dictionary, used in proc module_promoter in proc.tcl
  192.         global modulePromoterSet
  193.         $modulePromoterSet contents ""
  194.         }]
  195.     $this moduleHdlr $globalModuleHandler
  196.     $this isInFlatViewMode \
  197.         [expr {([m4_var get M4_flat_view] == "1") ? 1 : 0}]
  198.     set phaseType [[[$ccontext currentPhase] phase] type]
  199.     $this showVisibility [expr {([m4_var get \
  200.         M4_show_visibility -context $phaseType] == "1") ? 1 : 0}]
  201.     $this umlLook [expr {([m4_var get M4_diagram_look ] == "UML") ? 1 : 0}]
  202.  
  203.     # Initialize graphical stuff
  204.     #
  205.     $this config \
  206.         -title "ObjectTeam Class Browser" \
  207.         -fileHistorySet [List new] \
  208.         -historyCount 0 \
  209.         -closed {%this fileExit} \
  210.         -exitButton $this.bar.file.menu.exit \
  211.         -icon clbrowser \
  212.         -iconTitle "ObjectTeam Class Browser"
  213.  
  214.     global classCount
  215.     set classCount 1
  216.     MenuBar new $this.bar
  217.     $this menuHandler [CustCBMenuHandler new class [$this moduleHdlr]]
  218.     $this setToolBarPresence classbrowser
  219.     [$this menuHandler] setCurrentContext
  220.     # Initialize the two menucheckbuttons if they exist
  221.     if {[isCommand $this.bar.view.menu.flat]} {
  222.         $this.bar.view.menu.flat state \
  223.             [expr {([m4_var get M4_flat_view] == "1") ? 1 : 0}]
  224.     }
  225.     if {[isCommand $this.bar.options.menu.sortcasesensitive]} {
  226.         $this.bar.options.menu.sortcasesensitive state [expr \
  227.             {([m4_var get M4_sort_case_sensitive] == "1") ? 1 : 0}]
  228.     }
  229.  
  230.     DlgColumn new $this.c
  231.     $this setContextAreaPresence classbrowser
  232.     HorSeparator new $this.c.sep
  233.     interface VerSplitter $this.c.vs {
  234.         DlgRow r1 {
  235.         HorSplitter hs1 {
  236.             DlgColumn c1 {
  237.             Label superClassesLab {
  238.                 text "Superclasses"
  239.             }
  240.             CBSuperClassTextList superClasses {
  241.                 selectionPolicy BROWSE
  242.                 rowCount 3
  243.             }
  244.             }
  245.             DlgColumn c2 {
  246.             Label classesLab {
  247.                 text "Classes"
  248.             }
  249.             CBClassTextList classes {
  250.                 selectionPolicy BROWSE
  251.                 rowCount 7
  252.                 justification FILLED
  253.             }
  254.             }
  255.             DlgColumn c3 {
  256.             Label subClassesLab {
  257.                 text "Subclasses"
  258.             }
  259.             CBSubClassTextList subClasses {
  260.                 selectionPolicy BROWSE
  261.                 rowCount  3
  262.             }
  263.             }
  264.         }
  265.         }
  266.         DlgRow r2 {
  267.         HorSplitter hs2 {
  268.             DlgColumn c1 {
  269.             Label featuresLab {
  270.                 text "Features"
  271.             }
  272.             CBFeatureTextlist features {
  273.                 selectionPolicy BROWSE
  274.                 rowCount 12
  275.                 justification FILLED
  276.             }
  277.             }
  278.             DlgColumn c2 {
  279.             Label associationsLab {
  280.                 text "Associations"
  281.             }
  282.             CBAssocTextList associations {
  283.                 selectionPolicy BROWSE
  284.                 rowCount 3
  285.             }
  286.             }
  287.         }
  288.         }
  289.     }
  290.     # hack start
  291.     # give label SuperClassesLab extra spaces
  292.     # so that it determines the width of the column
  293.     # which is to small default
  294.     # real solution: add columnWidth to TextList 
  295.     set hackLbl $this.c.vs.r1.hs1.c1.superClassesLab
  296.     $hackLbl text "Superclasses                      "
  297.     # hack end
  298.     $this projectName [[[$this ccontext] currentProject] name]
  299.     set confName [[[[$this ccontext] currentConfig] config] name]
  300.     set confVersion [[[$this ccontext] currentConfig] versionNumber]
  301.     $this configurationName "$confName (V$confVersion)"
  302.     $this phaseName [[[[$this ccontext] currentPhase] phase] name]
  303.     $this updateWmtArea
  304.  
  305.         $this superClassTL $this.c.vs.r1.hs1.c1.superClasses
  306.         $this classTL $this.c.vs.r1.hs1.c2.classes
  307.         $this subClassTL $this.c.vs.r1.hs1.c3.subClasses
  308.         $this featureTL $this.c.vs.r2.hs2.c1.features
  309.         $this assocTL $this.c.vs.r2.hs2.c2.associations
  310.  
  311.     $this setMessageAreaPresence classbrowser
  312.  
  313.     $this setFont [m4_var get M4_font -context classbrowser]
  314.  
  315.     $this options [ToolOptions new $this.options]
  316.  
  317.     # Set phaseLevelPathIds attribute with LevelIds upto Phase level.
  318.     # would like to use LevelPath::parentAt ... (not available in TCL!!)
  319.     set levelPathObj [LevelPath new [$ccontext currentLevelIdString]]
  320.     while {[$levelPathObj depth] != "Phase"} {
  321.         $levelPathObj removeTail
  322.     }
  323.     $this phaseLevelPathIds $levelPathObj
  324.  
  325.     # Create PropKnowledgeDB and PropertyViewer.
  326.     #
  327.     $this propKnowledgeDB [PropKnowledgeDB new \
  328.         $this.propKnowledgeDB [$this moduleHdlr]]
  329.     $this propertyViewer [CBPropViewer new $this.propViewer \
  330.         [$this propKnowledgeDB]]
  331.  
  332.     # Create global attribute and operation filters
  333.     #
  334.     global ClassBrowser::attrFilter
  335.     set ClassBrowser::attrFilter [CBAttrFilter new \
  336.         .attrFilter [$this propKnowledgeDB]]
  337.     global ClassBrowser::operFilter
  338.     set ClassBrowser::operFilter [CBOperFilter new \
  339.         .operFilter [$this propKnowledgeDB]]
  340.  
  341.     # Initialize handlers/dialogs
  342.     #
  343.     $this openHandler [ClassSelHandler new $this.openHandler \
  344.         -title "Open Class" \
  345.         -message "Select Class:" \
  346.         -command open]
  347.     $this showScopeHandler [WorkItemSelHandler new $this.showScopeHandler \
  348.         -title "Show Scope" \
  349.         -message "Select Item:" \
  350.         -command showScope]
  351.     $this editCADHandler [ClassSelHandler new $this.editCADHandler \
  352.         -title "Edit Class" \
  353.         -message "Select Class:" \
  354.         -command editCAD]
  355.     $this startEditCADHandler [DiagramSelHandler new \
  356.         $this.startEditCADHandler \
  357.         -title "Edit [ShortLongName::longName $CAD_TYPE]" \
  358.         -message "Select [ShortLongName::longName $CAD_TYPE]:" \
  359.         -command editCAD]
  360.     $this filterFeaturesDialog ""
  361.  
  362.     $this setWindowGeometry classbrowser
  363.  
  364.     ClassMaker::extend CustMenuPushButton HistMenuButton {cbClass nameItem}
  365.  
  366.     return $this
  367. }
  368.  
  369. method ClassBrowser::fileReloadClasses {this} {
  370.     $this initView 1
  371. }
  372.  
  373. method ClassBrowser::fileOpen {this} {
  374.     busy {
  375.         set textListEntry [$this getSelTextListEntry]
  376.         if {$textListEntry != ""} {
  377.             $textListEntry open
  378.         }
  379.     }
  380. }
  381.  
  382. method ClassBrowser::fileClose {this} {
  383.     if {[[$this openHistory] size] == 0} {
  384.         $this popupCloseExit "$this fileExit"
  385.     } else {
  386.         $this doClose
  387.     }
  388. }
  389.  
  390. method ClassBrowser::fileFindClass {this} {
  391.     if {![isCommand $this.findClassDialog]} {
  392.         CBFindClassDialog new $this.findClassDialog
  393.     }
  394.     $this.findClassDialog popUp
  395. }
  396.  
  397. method ClassBrowser::fileFindFeature {this} {
  398.     if {![isCommand $this.findFeatureDialog]} {
  399.         CBFindFeatureDialog new $this.findFeatureDialog
  400.     }
  401.     $this.findFeatureDialog popUp
  402. }
  403.  
  404. method ClassBrowser::filePrintView {this} {
  405.     set printer [m4_var get M4_a_printer]
  406.     set tmpFile [args_file {}]
  407.     set fid [open $tmpFile w]
  408.  
  409.     puts $fid "View of:"
  410.     puts $fid "  Project: [$this projectName]"
  411.     puts $fid "  Configuration Version: [$this configurationName]"
  412.     puts $fid "  Phase Version: [$this phaseName]"
  413.     puts $fid "  System Version: [$this systemName]"
  414.     puts $fid "  Class: [$this className]"
  415.     puts $fid "\n-- Superclasses --"
  416.     foreach entry [[$this superClassTL] entrySet] {
  417.         puts $fid "  $entry"
  418.     }
  419.     puts $fid "\n-- Subclasses --"
  420.     foreach entry [[$this subClassTL] entrySet] {
  421.         puts $fid "  $entry"
  422.     }
  423.     puts $fid "\n-- Features --"
  424.     foreach entry [[$this featureTL] entrySet] {
  425.         puts $fid "  $entry"
  426.     }
  427.     puts $fid "\n-- Associations --"
  428.     foreach entry [[$this assocTL] entrySet] {
  429.         puts $fid "  $entry"
  430.     }
  431.  
  432.     close $fid
  433.     $this startCommand extern \
  434.         "$printer $tmpFile" "[list BasicFS::removeFile $tmpFile]" \
  435.         "Sending output to $printer..." \
  436.         {0 0} 0
  437. }
  438.  
  439. method ClassBrowser::fileExit {this} {
  440.     $this delete
  441.     exit
  442. }
  443.  
  444. method ClassBrowser::itemShowProperties {this} {
  445.     busy {
  446.         set textListEntry [$this getSelTextListEntry]
  447.         if {$textListEntry != ""} {
  448.             [$this propertyViewer] showProperties $textListEntry
  449.         }
  450.     }
  451. }
  452.  
  453. method ClassBrowser::itemShowScope {this} {
  454.     busy {
  455.         set textListEntry [$this getSelTextListEntry]
  456.         if {$textListEntry != ""} {
  457.             $textListEntry showScope
  458.         }
  459.     }
  460. }
  461.  
  462. method ClassBrowser::viewFlat {this checkButton} {
  463.     if {[catch {m4_var set M4_flat_view [$checkButton state]}]} {
  464.         wmtkerror "Unable to set Display Flat View"
  465.         $checkButton state [expr ![$checkButton state]]
  466.         return
  467.     }
  468.     $this isInFlatViewMode [$checkButton state]
  469.  
  470.     set currentClass [$this currentOpenedClass]
  471.     if {$currentClass == ""} {
  472.         return
  473.     }
  474.     busy {
  475.         [$this superClassTL] updateView $currentClass
  476.         [$this featureTL] updateView $currentClass
  477.         [$this assocTL] updateView $currentClass
  478.     }
  479. }
  480.  
  481. method ClassBrowser::viewFilterFeatures {this} {
  482.     if {[$this filterFeaturesDialog] == ""} {
  483.         $this filterFeaturesDialog [CBFilterFeaturesDialog \
  484.             new $this.filterFeaturesDialog]
  485.     }
  486.     $this.filterFeaturesDialog popUp
  487. }
  488.  
  489. method ClassBrowser::optionsSortCaseSensitive {this checkButton} {
  490.     if {[catch {m4_var set M4_sort_case_sensitive [$checkButton state]}]} {
  491.         wmtkerror "Unable to set Sort Case Sensitive"
  492.         $checkButton state [expr ![$checkButton state]]
  493.         return
  494.     }
  495.  
  496.     busy {
  497.         [$this superClassTL] sort
  498.         [$this classTL] sort
  499.         [$this subClassTL] sort
  500.     }
  501. }
  502.  
  503. method ClassBrowser::optionsFont {this} {
  504.     busy {
  505.         if {![isCommand $this.fontChooser]} {
  506.             CBFontChooser new $this.fontChooser
  507.         }
  508.     }
  509.     $this.fontChooser popUp
  510. }
  511.  
  512. method ClassBrowser::optionsPrinterSetup {this} {
  513.     [$this options] aPrinterSetup
  514. }
  515.  
  516. method ClassBrowser::utilEditCAD {this} {
  517.     busy {
  518.         set textListEntry [$this getSelTextListEntry]
  519.         if {$textListEntry != ""} {
  520.             $textListEntry editCAD
  521.         }
  522.     }
  523. }
  524.  
  525. method ClassBrowser::helpOnContext {this} {
  526.     set selTextList [$this selTextList]
  527.     if {$selTextList == ""} {
  528.         $this helpOnName context
  529.         return
  530.     }
  531.     set idx [expr {[string last "." $selTextList] + 1}]
  532.     set name [string range $selTextList $idx end]TL
  533.     $this helpOnName $name
  534. }
  535.  
  536. method ClassBrowser::popUp {this} {
  537.     $this MainWindow::popUp
  538.     $this ready
  539. }
  540.  
  541. method ClassBrowser::initView {this {reload 0}} {
  542.     busy {
  543.         # (Re)Initialize attributes
  544.         #
  545.         $this openHistory [CBClassStack new]
  546.         $this currentOpenedClass ""
  547.         $this updateWmtAreaClass ""
  548.  
  549.         if {[$this model] != ""} {
  550.             [$this model] delete
  551.         }
  552.         if {[[$this ccontext] currentLevel] == "Phase"} {
  553.             $this model [CBCADPhaseModel new \
  554.                 [[$this ccontext] currentConfig] \
  555.                 [[$this ccontext] currentPhase]]
  556.         } else {
  557.             $this model [CBCADSystemModel new \
  558.                 [[$this ccontext] currentConfig] \
  559.                 [[$this ccontext] currentSystem]]
  560.         }
  561.  
  562.         # Reinitialise findClassDialog and findFeatureDialog
  563.         #
  564.         if {[isCommand $this.findClassDialog]} {
  565.             $this.findClassDialog initialisedView
  566.         }
  567.         if {[isCommand $this.findFeatureDialog]} {
  568.             $this.findFeatureDialog initialisedView
  569.         }
  570.  
  571.         # Do GC
  572.         #
  573.         GCControl collect
  574.         #puts "GCControl lastNrOfColl: [GCControl lastNrOfCollected]"
  575.  
  576.         # (Re)Load
  577.         #
  578.         if {!$reload} {
  579.             wmtkmessage "Loading Classes ..."
  580.         } else {
  581.             wmtkmessage "Reloading Classes ..."
  582.         }
  583.         [$this model] load
  584.         [$this superClassTL] initView
  585.         [$this subClassTL] initView
  586.         [$this classTL] initView
  587.         [$this featureTL] initView
  588.         [$this assocTL] initView
  589.         $this selTextList ""
  590.         wmtkmessage ""
  591.  
  592.         if {!$reload} {
  593.             $this setFileHistory
  594.         } else {
  595.             $this updateFileHistory
  596.         }
  597.  
  598.         # notify the menuhandler of the selectionChange
  599.         [$this menuHandler] selectionChanged
  600.     }
  601. }
  602.  
  603. method ClassBrowser::selTextListChanged {this newSelTextList} {
  604.     set selTextList [$this selTextList]
  605.     if {$selTextList == $newSelTextList} {
  606.         [$this menuHandler] selectionChanged
  607.         return
  608.     }
  609.     if {$selTextList != ""} {
  610.         $selTextList deselectEntries
  611.     }
  612.     $this selTextList $newSelTextList
  613.     [$this menuHandler] selectionChanged
  614. }
  615.  
  616. method ClassBrowser::getSelTextListEntry {this} {
  617.     set selTextList [$this selTextList]
  618.     if {$selTextList == ""} {
  619.         return ""
  620.     }
  621.     return [$selTextList getSelTextListEntry]
  622. }
  623.  
  624.  
  625. # Used by Menu Customization Mechanism
  626. #
  627. method ClassBrowser::getSelectedSet {this} {
  628.     return [$this getSelTextListEntry]
  629. }
  630.  
  631. method ClassBrowser::getCBClass {this nameItem} {
  632.     [[$this classTL] textListEntrySet] foreach class {
  633.         if {[$nameItem isSame [$class getNameItem]]} {
  634.             return $class
  635.         }
  636.     }
  637.     return ""
  638. }
  639.  
  640. method ClassBrowser::getCurrentOpenedClassIndex {this} {
  641.     set currentClass [$this currentOpenedClass]
  642.     if {$currentClass == ""} {
  643.         return 0
  644.     }
  645.     set classList [[[$this classTL] textListEntrySet] contents]
  646.     set idx [lsearch -exact $classList $currentClass]
  647.     if {$idx == -1} {
  648.         return 0
  649.     }
  650.     return $idx
  651. }
  652.  
  653. method ClassBrowser::updateClientContext {this cbClass} {
  654.     set newLevelPathIds [LevelPath new [[$this phaseLevelPathIds] asString]]
  655.     if {$cbClass != ""} {
  656.         set sysV [$cbClass getDefiningSystemVersion]
  657.         if ![$sysV isNil] {
  658.             $newLevelPathIds append [$sysV identity]
  659.         }
  660.     }
  661.     set cc [ClientContext::global]
  662.     set currentLevelPathIds [LevelPath new [$cc currentLevelIdString]]
  663.     if {[$currentLevelPathIds compare $newLevelPathIds] != 0} {
  664.         $cc setLevelIds [$newLevelPathIds asString]
  665.         [$this moduleHdlr] setCurrentContext
  666.     }
  667. }
  668.  
  669. method ClassBrowser::addFileHistory {this cbClass} {
  670.     set index [expr [[$this exitButton] index] - 1 - \
  671.             [[$this fileHistorySet] length]]
  672.     [$this fileHistorySet] foreach entry {
  673.         if {$cbClass != [$entry cbClass]} {
  674.             continue
  675.         }
  676.         [$this fileHistorySet] removeValue $entry
  677.         [$this fileHistorySet] insert $entry
  678.         $this renumberFileHistory
  679.         $entry index $index
  680.         return
  681.     }
  682.  
  683.     set latest [expr [$this historyCount] + 1]
  684.     HistMenuButton new [$this menuBar].file.menu.his$latest \
  685.         -label "1 [$cbClass name]" -mnemonic 1 -index $index \
  686.         -cbClass $cbClass -nameItem [$cbClass getNameItem] \
  687.         -hintText "Opens class [$cbClass name]." \
  688.         -activated "$cbClass open"
  689.     [$this fileHistorySet] insert [$this menuBar].file.menu.his$latest
  690.     $this historyCount $latest
  691.     $this renumberFileHistory
  692.  
  693.     if {[[$this fileHistorySet] length] > 5} {
  694.         [[$this fileHistorySet] index end] delete
  695.         [$this fileHistorySet] remove end
  696.     } elseif {[[$this fileHistorySet] length] == 1} {
  697.         CustMenuSeparator new [$this menuBar].file.menu.histsep \
  698.             -index $index
  699.     }
  700. }
  701.  
  702. method ClassBrowser::renumberFileHistory {this} {
  703.     set m 1
  704.     [$this fileHistorySet] foreach entry {
  705.         $entry config -mnemonic $m -label "$m [[$entry cbClass] name]"
  706.         incr m
  707.     }
  708. }
  709.  
  710. method ClassBrowser::updateFileHistory {this} {
  711.     [$this fileHistorySet] foreach entry {
  712.         set cbClass [$this getCBClass [$entry nameItem]]
  713.         if {$cbClass != ""} { 
  714.             $entry config -cbClass $cbClass \
  715.                 -activated "$cbClass open"
  716.         } else {
  717.             $entry delete
  718.             [$this fileHistorySet] removeValue $entry
  719.             if {[[$this fileHistorySet] length] == 0} {
  720.                 [$this menuBar].file.menu.histsep delete
  721.             } else {
  722.                 $this updateFileHistory
  723.             }
  724.             return
  725.         }
  726.     }
  727.     $this renumberFileHistory
  728. }
  729.  
  730. method ClassBrowser::setFileHistory {this} {
  731.     set history [m4_var get M4_file_history -context classbrowser]
  732.     if {"$history" == ""} {
  733.         return
  734.     }
  735.     foreach itemId $history {
  736.         set cbClass [$this getCBClass [Item new $itemId]]
  737.         if {$cbClass != ""} {
  738.             $this addFileHistory $cbClass
  739.         }
  740.     }
  741. }
  742.  
  743. method ClassBrowser::saveFileHistory {this} {
  744.     set history ""
  745.     [$this fileHistorySet] foreach entry {
  746.         set history [linsert $history 0 [[$entry nameItem] identity]]
  747.     }
  748.     if {$history != [m4_var get M4_file_history -context classbrowser]} {
  749.         m4_var set M4_file_history $history -context classbrowser
  750.     }
  751. }
  752.  
  753. method ClassBrowser::addContextArea {this} {
  754.     $this wmtArea [CBWmtArea new $this.c.wmtArea]
  755. }
  756.  
  757. method ClassBrowser::updateToolBar {this} {
  758.     [$this menuHandler] setCurrentContext
  759. }
  760.  
  761. method ClassBrowser::updateWmtArea {this} {
  762.     if [isCommand [$this wmtArea]] {
  763.         [$this wmtArea] projectNm [$this projectName]
  764.         [$this wmtArea] configurationNm [$this configurationName]
  765.         [$this wmtArea] phaseNm [$this phaseName]
  766.         if {[$this systemName] != ""} {
  767.             [$this wmtArea] systemNm [$this systemName]
  768.         } else {
  769.             # Reserve some space for the 'System Version'
  770.             # and 'Class' fields
  771.             [$this wmtArea] systemNm "              "
  772.         }
  773.         [$this wmtArea] classNm [$this className]
  774.     }
  775. }
  776.  
  777. method ClassBrowser::updateTitle {this currentClass} {
  778.     set title [$this title]
  779.     set hyphen [string first "-" $title]
  780.     if {$hyphen < 0} {
  781.     append title " -"
  782.     } else {
  783.     set title [string range $title 0 $hyphen]
  784.     }
  785.     set iconTitle [$currentClass name]
  786.     append title " $iconTitle"
  787.     $this config \
  788.     -title $title \
  789.     -iconTitle $iconTitle
  790. }
  791.  
  792. method ClassBrowser::updateWmtAreaClass {this currentClass} {
  793.     if {$currentClass == ""} {
  794.         $this systemName ""
  795.         $this className ""
  796.     } else {
  797.         set systemV [$currentClass getDefiningSystemVersion]
  798.         if {[$systemV isNil]} {
  799.             $this systemName ""
  800.         } else {
  801.             $this systemName [[$systemV system] name]
  802.         }
  803.         $this className [$currentClass name]
  804.     }
  805.     $this updateWmtArea
  806. }
  807.  
  808. method ClassBrowser::popupCloseExit {this action} {
  809.     set closeExit [$this closeExit]
  810.     if {$closeExit == ""} {
  811.         set closeExit [CloseExitDialog new $this.closeExit]
  812.         $this closeExit $closeExit
  813.     }
  814.     $closeExit action $action
  815.     $closeExit popUp
  816. }
  817.  
  818. method ClassBrowser::doClose {this} {
  819.     busy {
  820.         set previousClass [[$this openHistory] pop]
  821.         if {$previousClass != ""} {
  822.             $previousClass doOpen
  823.         }
  824.     }
  825. }
  826.  
  827. method ClassBrowser::setFont {this newFont} {
  828.     [$this superClassTL] font $newFont
  829.     [$this subClassTL] font $newFont
  830.     [$this classTL] font $newFont
  831.     [$this featureTL] font $newFont
  832.     [$this assocTL] font $newFont
  833. }
  834.  
  835. method ClassBrowser::helpOnName {this name} {
  836.     global short2url
  837.     if [catch {set url $short2url($name)}] {
  838.         wmtkerror "Sorry, no help available for '$name'"
  839.     } else {
  840.         showHelp $url
  841.     }
  842. }
  843.  
  844. # Do not delete this line -- regeneration end marker
  845.  
  846. method ClassBrowser::classTL {this args} {
  847.     if {$args == ""} {
  848.         return [$this _classTL]
  849.     }
  850.     set ref [$this _classTL]
  851.     if {$ref != ""} {
  852.         $ref _browser ""
  853.     }
  854.     set obj [lindex $args 0]
  855.     if {$obj != ""} {
  856.         $obj _browser $this
  857.     }
  858.     $this _classTL $obj
  859. }
  860.  
  861. method ClassBrowser::superClassTL {this args} {
  862.     if {$args == ""} {
  863.         return [$this _superClassTL]
  864.     }
  865.     set ref [$this _superClassTL]
  866.     if {$ref != ""} {
  867.         $ref _browser ""
  868.     }
  869.     set obj [lindex $args 0]
  870.     if {$obj != ""} {
  871.         $obj _browser $this
  872.     }
  873.     $this _superClassTL $obj
  874. }
  875.  
  876. method ClassBrowser::subClassTL {this args} {
  877.     if {$args == ""} {
  878.         return [$this _subClassTL]
  879.     }
  880.     set ref [$this _subClassTL]
  881.     if {$ref != ""} {
  882.         $ref _browser ""
  883.     }
  884.     set obj [lindex $args 0]
  885.     if {$obj != ""} {
  886.         $obj _browser $this
  887.     }
  888.     $this _subClassTL $obj
  889. }
  890.  
  891. method ClassBrowser::featureTL {this args} {
  892.     if {$args == ""} {
  893.         return [$this _featureTL]
  894.     }
  895.     set ref [$this _featureTL]
  896.     if {$ref != ""} {
  897.         $ref _browser ""
  898.     }
  899.     set obj [lindex $args 0]
  900.     if {$obj != ""} {
  901.         $obj _browser $this
  902.     }
  903.     $this _featureTL $obj
  904. }
  905.  
  906. method ClassBrowser::assocTL {this args} {
  907.     if {$args == ""} {
  908.         return [$this _assocTL]
  909.     }
  910.     set ref [$this _assocTL]
  911.     if {$ref != ""} {
  912.         $ref _browser ""
  913.     }
  914.     set obj [lindex $args 0]
  915.     if {$obj != ""} {
  916.         $obj _browser $this
  917.     }
  918.     $this _assocTL $obj
  919. }
  920.  
  921. method ClassBrowser::startEditCADHandler {this args} {
  922.     if {$args == ""} {
  923.         return [$this _startEditCADHandler]
  924.     }
  925.     set ref [$this _startEditCADHandler]
  926.     if {$ref != ""} {
  927.         $ref _browser ""
  928.     }
  929.     set obj [lindex $args 0]
  930.     if {$obj != ""} {
  931.         $obj _browser $this
  932.     }
  933.     $this _startEditCADHandler $obj
  934. }
  935.  
  936.