MethodSelectionBrowser.st
changeset 771 905c3b4ba565
parent 680 49c81e9cc6f7
child 773 de5c99bd3078
--- a/MethodSelectionBrowser.st	Thu Apr 09 18:54:28 1998 +0200
+++ b/MethodSelectionBrowser.st	Thu Apr 09 21:12:59 1998 +0200
@@ -1,5 +1,5 @@
 "
- COPYRIGHT (c) 1997 by eXept Software AG
+ COPYRIGHT (c) 1997-1998 by eXept Software AG
               All Rights Reserved
 
  This software is furnished under a license and may be used
@@ -19,7 +19,7 @@
 	category:'Interface-Dialogs'
 !
 
-Object subclass:#Row
+Object subclass:#Method
 	instanceVariableNames:'selector protocol'
 	classVariableNames:''
 	poolDictionaries:''
@@ -30,7 +30,7 @@
 
 copyright
 "
- COPYRIGHT (c) 1997 by eXept Software AG
+ COPYRIGHT (c) 1997-1998 by eXept Software AG
               All Rights Reserved
 
  This software is furnished under a license and may be used
@@ -46,6 +46,9 @@
 
 documentation
 "
+    The MethodSelectionBrowser allows you to browse in class hierarchies
+    for selecting methods for you purposes.
+
     [start with:]
         MethodSelectionBrowser open
 
@@ -57,30 +60,36 @@
 
 !MethodSelectionBrowser class methodsFor:'instance creation'!
 
-request: aTitle onSuperclass: aSuperclass andClass: aClass andSelector: aSelector withTypes: aResourceTypes
+request: aTitle onSuperclass: aSuperclass andClass: aClass andSelector: aSelector withTypes: protocolTypes
+    "opens a MethodSelectionBrowser on 
+	aSuperclassOrSymbol, 
+	and aClassOrSymbol, 
+	and aSelector,
+	with allowed protocolTypes"
 
     "
     MethodSelectionBrowser
-        request: 'Select a Method'
-        onSuperclass: #ApplicationModel 
-        andClass: #ToolApplicationModel 
-        andSelector: #saveIcon 
-        withTypes: #(class)      
+	request: 'Select a Method'
+	onSuperclass: #ApplicationModel 
+	andClass: #ToolApplicationModel 
+	andSelector: #saveIcon 
+	withTypes: #(class)      
     "
 
     ^self new
-        title: aTitle;
-        openOnSuperclass: aSuperclass
-        andClass: aClass
-        andSelector: aSelector
-        withTypes: aResourceTypes
+	title: aTitle;
+	openOnSuperclass: aSuperclass
+	andClass: aClass
+	andSelector: aSelector
+	withTypes: protocolTypes
 
 
 ! !
 
 !MethodSelectionBrowser class methodsFor:'list specs'!
 
-columnsOfDataSetView
+resourceMethodColumns
+    "returns the columns for the table of the resource methods"
 
   ^ #(
    #(#DataSetColumnSpec
@@ -103,28 +112,33 @@
 
 !MethodSelectionBrowser methodsFor:'callbacks - user'!
 
-classSelected: anIndex
+classSelected
+    "after a class selection, read the class or/and instance methods of the selected class"
 
     self selectionOfClass value isNil ifTrue: [^nil].
     self withWaitCursorDo:
     [
-        |clsName|
+        |clsName contentsBlock|
         resourceTypes isNil ifTrue: [resourceTypes := #(instance class)].
-        clsName := ((self listOfClassesView list at: anIndex) upTo: $ ) asSymbol.
+        clsName := self selectionOfClass value name.
         self valueOfClassName value: clsName.
         self class lastSelection: clsName.
-        (resourceTypes includes: #instance) ifTrue: [
-        self listOfResources contents:
-            (((Smalltalk at: clsName) 
-                selectors
-                asOrderedCollection)
-             collect: [:sel| Row new selector: sel; protocol: 'instance'])].
-        (resourceTypes includes: #class) ifTrue: [
-        self listOfResources addAll:
-            (((Smalltalk at: clsName) 
-                class selectors
-                asOrderedCollection)
-             collect: [:sel| Row new selector: sel; protocol: 'class'])].
+        self listOfResourceMethods removeAll.
+        contentsBlock := 
+        [:protocol|
+            |cls|
+            (resourceTypes includes: protocol) 
+            ifTrue: 
+            [
+                cls := Smalltalk at: clsName.
+                cls := (protocol = #instance) ifTrue: [cls] ifFalse: [cls class].
+                self listOfResourceMethods addAll:
+                    (cls selectors asOrderedCollection
+                     collect: [:sel| Method new selector: sel; protocol: protocol asString])
+            ]
+        ].
+        contentsBlock value: #instance.
+        contentsBlock value: #class.
     ]
 
 
@@ -132,20 +146,26 @@
 
 !MethodSelectionBrowser methodsFor:'instance creation'!
 
-openOnSuperclass: aSuperclassOrSymbol andClass: aClassOrSymbol andSelector: aSelector withTypes: aResourceTypes
+openOnSuperclass: aSuperclassOrSymbol andClass: aClassOrSymbol andSelector: aSelector withTypes: protocolTypes
+    "opens a MethodSelectionBrowser on 
+	aSuperclassOrSymbol, 
+	and aClassOrSymbol, 
+	and aSelector,
+	with allowed protocolTypes"
 
     |message type row|
+
     message := super openOnSuperclass: aSuperclassOrSymbol 
-        andClass: aClassOrSymbol 
-        andSelector: aSelector 
-        withResourceTypes: aResourceTypes.
+	andClass: aClassOrSymbol 
+	andSelector: aSelector 
+	withResourceTypes: protocolTypes.
 
     (message notNil and:
-    [((row := self selectionOfResource value) notNil and:
-    [(type := row type) = 'class'])])
+    [((row := self selectionOfResourceMethod value) notNil and:
+    [(type := row protocol) = 'class'])])
     ifTrue:
     [   
-        message := message replChar:$  withString: ' class '
+	message := message replChar:$  withString: ' class '
     ].
     ^message
 
@@ -156,6 +176,7 @@
 !MethodSelectionBrowser methodsFor:'startup / release'!
 
 postBuildWith:aBuilder
+    "sets the correct title"
 
     title := 'Method Selection Browser'.
 
@@ -163,7 +184,7 @@
 
 ! !
 
-!MethodSelectionBrowser::Row methodsFor:'accessing'!
+!MethodSelectionBrowser::Method methodsFor:'accessing'!
 
 protocol