--- 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