added browse-types item in variableList menu
authorClaus Gittinger <cg@exept.de>
Thu, 15 Feb 2001 12:00:58 +0100
changeset 2983 5d02e950f5f5
parent 2982 688784343acd
child 2984 c87f0d6528d0
added browse-types item in variableList menu
NewSystemBrowser.st
Tools__NewSystemBrowser.st
--- a/NewSystemBrowser.st	Wed Feb 14 15:00:38 2001 +0100
+++ b/NewSystemBrowser.st	Thu Feb 15 12:00:58 2001 +0100
@@ -8214,13 +8214,20 @@
             #label: '-'
           )
          #(#MenuItem
-            #label: 'Type info...'
+            #label: 'Show Type(s)...'
             #translateLabel: true
             #value: #variablesMenuTypeInfo
             #enabled: #hasSingleVariableSelectedHolder
             #showBusyCursorWhilePerforming: true
           )
          #(#MenuItem
+            #label: 'Browse Type(s)'
+            #translateLabel: true
+            #value: #variablesMenuTypeBrowe
+            #enabled: #hasSingleVariableSelectedHolder
+            #showBusyCursorWhilePerforming: true
+          )
+         #(#MenuItem
             #label: '-'
           )
          #(#MenuItem
@@ -17550,9 +17557,15 @@
                 classesWithMissingContainer:classesWithMissingContainer
                 classesWhichHaveBeenModified:classesWhichHaveBeenModified
                 classesWithNewerVersionInRepository:classesWithNewerVersionInRepository
+                needExtensionsContainer:needExtensionsContainer
+                hasExtensionContainer:hasExtensionContainer
 
     |bindings listOfObsoleteContainers listOfObsoleteContainerAssocs menuPerformer|
 
+needExtensionsContainer ~~ hasExtensionContainer ifTrue:[
+self halt.
+].
+
     listOfObsoleteContainers := OrderedCollection new.
     listOfObsoleteContainerAssocs := OrderedCollection new.
     obsoleteContainers do:[:eachAssoc |
@@ -17891,7 +17904,7 @@
 
     self withWaitCursorDo:[
         |classesToLoad classesToUnload classesWithMissingContainer classesWithRepositoryMismatches 
-         obsoleteContainers allChangeSets answer
+         obsoleteContainers allChangeSets answer needExtensionsContainer hasExtensionContainer
          classesWithNewerVersionInRepository classesWhichHaveBeenModified|
 
         classesWithRepositoryMismatches := OrderedCollection new.
@@ -17902,8 +17915,8 @@
 
         self selectedProjectsDo:[:packageToCheck |
             |containerModule containerPackage containers
-             hasLoadAll hasMakeProto hasNtMakefile hasAbbrev otherFiles
-             classesInProject |
+             hasLoadAll hasMakeProto hasNtMakefile hasAbbrev 
+             otherFiles classesInProject |
 
             containerModule := packageToCheck upTo:$:.
             containerPackage := packageToCheck copyFrom:(containerModule size + 2).
@@ -17917,16 +17930,21 @@
             hasMakeProto := containers includes:'Make.proto'.
             hasNtMakefile := containers includes:'nt.mak'.
             hasAbbrev := containers includes:'abbrev.stc'.
+            hasExtensionContainer := containers includes:'extensions.st'.
+
             containers removeAllFoundIn:#('loadAll' 'Make.proto' 'nt.mak' 'abbrev.stc' 'extensions.st').
             otherFiles := containers select:[:each | (each asFilename hasSuffix:'st') not].
             containers removeAllFoundIn:otherFiles.
 
             classesInProject := IdentitySet new.
+            needExtensionsContainer := false.
             Smalltalk allClassesDo:[:aClass |
                 (packageToCheck = aClass package) ifTrue:[
                     aClass isPrivate ifFalse:[
                         classesInProject add:aClass .
                     ]
+                ] ifFalse:[
+                    needExtensionsContainer := needExtensionsContainer or:[aClass hasExtensionsFrom:packageToCheck].
                 ]
             ].
 
@@ -18034,11 +18052,13 @@
                 ]
             ]
         ].
+
         (obsoleteContainers notEmpty
         or:[ classesWithRepositoryMismatches notEmpty
         or:[ classesWithMissingContainer notEmpty
         or:[ classesWhichHaveBeenModified notEmpty
-        or:[ classesWithNewerVersionInRepository notEmpty]]]])
+        or:[ classesWithNewerVersionInRepository notEmpty
+        or:[ needExtensionsContainer ~~ hasExtensionContainer ]]]]])
         ifTrue:[
             self 
                 openRepositoryConsistencyDialogForObsoleteContainers:obsoleteContainers
@@ -18046,6 +18066,8 @@
                 classesWithMissingContainer:classesWithMissingContainer
                 classesWhichHaveBeenModified:classesWhichHaveBeenModified
                 classesWithNewerVersionInRepository:classesWithNewerVersionInRepository
+                needExtensionsContainer:needExtensionsContainer
+                hasExtensionContainer:hasExtensionContainer
         ]
     ].
     self normalLabel
@@ -22414,9 +22436,23 @@
     ]
 !
 
+variablesMenuTypeBrowe
+    "browse typical types of a variable"
+
+    self variablesMenuTypeInfoOrBrowseTypes:true.
+
+!
+
 variablesMenuTypeInfo
     "show typical usage of a variable"
 
+    self variablesMenuTypeInfoOrBrowseTypes:false.
+
+!
+
+variablesMenuTypeInfoOrBrowseTypes:doBrowseTypes
+    "show typical usage of a variable"
+
     |name idx classes values value msg cut names instCount subInstCount box
      searchClass s canInspect canInspectMultiple showingInstVars showingClassVars currentClass
      nilIncluded commonSuperClass boxLabels boxValues answer|
@@ -22576,6 +22612,11 @@
         ]
     ].
 
+    doBrowseTypes ifTrue:[
+        self spawnClassBrowserFor:classes in:#newBuffer.
+        ^ self
+    ].
+
     boxLabels := #('ok').
     boxValues := #(true).
     (canInspect or:[canInspectMultiple]) ifTrue:[
@@ -47781,6 +47822,6 @@
 !NewSystemBrowser class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libtool/Attic/NewSystemBrowser.st,v 1.81 2001-02-14 14:00:38 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Attic/NewSystemBrowser.st,v 1.82 2001-02-15 11:00:58 cg Exp $'
 ! !
 NewSystemBrowser initialize!
--- a/Tools__NewSystemBrowser.st	Wed Feb 14 15:00:38 2001 +0100
+++ b/Tools__NewSystemBrowser.st	Thu Feb 15 12:00:58 2001 +0100
@@ -8214,13 +8214,20 @@
             #label: '-'
           )
          #(#MenuItem
-            #label: 'Type info...'
+            #label: 'Show Type(s)...'
             #translateLabel: true
             #value: #variablesMenuTypeInfo
             #enabled: #hasSingleVariableSelectedHolder
             #showBusyCursorWhilePerforming: true
           )
          #(#MenuItem
+            #label: 'Browse Type(s)'
+            #translateLabel: true
+            #value: #variablesMenuTypeBrowe
+            #enabled: #hasSingleVariableSelectedHolder
+            #showBusyCursorWhilePerforming: true
+          )
+         #(#MenuItem
             #label: '-'
           )
          #(#MenuItem
@@ -17550,9 +17557,15 @@
                 classesWithMissingContainer:classesWithMissingContainer
                 classesWhichHaveBeenModified:classesWhichHaveBeenModified
                 classesWithNewerVersionInRepository:classesWithNewerVersionInRepository
+                needExtensionsContainer:needExtensionsContainer
+                hasExtensionContainer:hasExtensionContainer
 
     |bindings listOfObsoleteContainers listOfObsoleteContainerAssocs menuPerformer|
 
+needExtensionsContainer ~~ hasExtensionContainer ifTrue:[
+self halt.
+].
+
     listOfObsoleteContainers := OrderedCollection new.
     listOfObsoleteContainerAssocs := OrderedCollection new.
     obsoleteContainers do:[:eachAssoc |
@@ -17891,7 +17904,7 @@
 
     self withWaitCursorDo:[
         |classesToLoad classesToUnload classesWithMissingContainer classesWithRepositoryMismatches 
-         obsoleteContainers allChangeSets answer
+         obsoleteContainers allChangeSets answer needExtensionsContainer hasExtensionContainer
          classesWithNewerVersionInRepository classesWhichHaveBeenModified|
 
         classesWithRepositoryMismatches := OrderedCollection new.
@@ -17902,8 +17915,8 @@
 
         self selectedProjectsDo:[:packageToCheck |
             |containerModule containerPackage containers
-             hasLoadAll hasMakeProto hasNtMakefile hasAbbrev otherFiles
-             classesInProject |
+             hasLoadAll hasMakeProto hasNtMakefile hasAbbrev 
+             otherFiles classesInProject |
 
             containerModule := packageToCheck upTo:$:.
             containerPackage := packageToCheck copyFrom:(containerModule size + 2).
@@ -17917,16 +17930,21 @@
             hasMakeProto := containers includes:'Make.proto'.
             hasNtMakefile := containers includes:'nt.mak'.
             hasAbbrev := containers includes:'abbrev.stc'.
+            hasExtensionContainer := containers includes:'extensions.st'.
+
             containers removeAllFoundIn:#('loadAll' 'Make.proto' 'nt.mak' 'abbrev.stc' 'extensions.st').
             otherFiles := containers select:[:each | (each asFilename hasSuffix:'st') not].
             containers removeAllFoundIn:otherFiles.
 
             classesInProject := IdentitySet new.
+            needExtensionsContainer := false.
             Smalltalk allClassesDo:[:aClass |
                 (packageToCheck = aClass package) ifTrue:[
                     aClass isPrivate ifFalse:[
                         classesInProject add:aClass .
                     ]
+                ] ifFalse:[
+                    needExtensionsContainer := needExtensionsContainer or:[aClass hasExtensionsFrom:packageToCheck].
                 ]
             ].
 
@@ -18034,11 +18052,13 @@
                 ]
             ]
         ].
+
         (obsoleteContainers notEmpty
         or:[ classesWithRepositoryMismatches notEmpty
         or:[ classesWithMissingContainer notEmpty
         or:[ classesWhichHaveBeenModified notEmpty
-        or:[ classesWithNewerVersionInRepository notEmpty]]]])
+        or:[ classesWithNewerVersionInRepository notEmpty
+        or:[ needExtensionsContainer ~~ hasExtensionContainer ]]]]])
         ifTrue:[
             self 
                 openRepositoryConsistencyDialogForObsoleteContainers:obsoleteContainers
@@ -18046,6 +18066,8 @@
                 classesWithMissingContainer:classesWithMissingContainer
                 classesWhichHaveBeenModified:classesWhichHaveBeenModified
                 classesWithNewerVersionInRepository:classesWithNewerVersionInRepository
+                needExtensionsContainer:needExtensionsContainer
+                hasExtensionContainer:hasExtensionContainer
         ]
     ].
     self normalLabel
@@ -22414,9 +22436,23 @@
     ]
 !
 
+variablesMenuTypeBrowe
+    "browse typical types of a variable"
+
+    self variablesMenuTypeInfoOrBrowseTypes:true.
+
+!
+
 variablesMenuTypeInfo
     "show typical usage of a variable"
 
+    self variablesMenuTypeInfoOrBrowseTypes:false.
+
+!
+
+variablesMenuTypeInfoOrBrowseTypes:doBrowseTypes
+    "show typical usage of a variable"
+
     |name idx classes values value msg cut names instCount subInstCount box
      searchClass s canInspect canInspectMultiple showingInstVars showingClassVars currentClass
      nilIncluded commonSuperClass boxLabels boxValues answer|
@@ -22576,6 +22612,11 @@
         ]
     ].
 
+    doBrowseTypes ifTrue:[
+        self spawnClassBrowserFor:classes in:#newBuffer.
+        ^ self
+    ].
+
     boxLabels := #('ok').
     boxValues := #(true).
     (canInspect or:[canInspectMultiple]) ifTrue:[
@@ -47781,6 +47822,6 @@
 !NewSystemBrowser class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.81 2001-02-14 14:00:38 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.82 2001-02-15 11:00:58 cg Exp $'
 ! !
 NewSystemBrowser initialize!