tz@646: "
tz@771:  COPYRIGHT (c) 1997-1998 by eXept Software AG
tz@646:               All Rights Reserved
tz@646: 
tz@646:  This software is furnished under a license and may be used
tz@646:  only in accordance with the terms of that license and with the
tz@646:  inclusion of the above copyright notice. This software may not
tz@646:  be provided or otherwise made available to, or used by, any
tz@646:  other person. No title to or ownership of the software is
tz@646:  hereby transferred.
tz@646: "
tz@646: 
tz@646: 
tz@646: 
cg@1979: "{ Package: 'stx:libtool2' }"
cg@1979: 
tz@646: ResourceSelectionBrowser subclass:#MethodSelectionBrowser
tz@646: 	instanceVariableNames:''
tz@646: 	classVariableNames:''
tz@646: 	poolDictionaries:''
tz@646: 	category:'Interface-Dialogs'
tz@646: !
tz@646: 
tz@771: Object subclass:#Method
tz@665: 	instanceVariableNames:'selector protocol'
tz@646: 	classVariableNames:''
tz@646: 	poolDictionaries:''
tz@646: 	privateIn:MethodSelectionBrowser
tz@646: !
tz@646: 
tz@646: !MethodSelectionBrowser class methodsFor:'documentation'!
tz@646: 
tz@646: copyright
tz@646: "
tz@771:  COPYRIGHT (c) 1997-1998 by eXept Software AG
tz@646:               All Rights Reserved
tz@646: 
tz@646:  This software is furnished under a license and may be used
tz@646:  only in accordance with the terms of that license and with the
tz@646:  inclusion of the above copyright notice. This software may not
tz@646:  be provided or otherwise made available to, or used by, any
tz@646:  other person. No title to or ownership of the software is
tz@646:  hereby transferred.
tz@646: "
tz@646: 
tz@646: 
tz@646: !
tz@646: 
tz@646: documentation
tz@646: "
tz@771:     The MethodSelectionBrowser allows you to browse in class hierarchies
tz@771:     for selecting methods for you purposes.
tz@771: 
tz@646:     [start with:]
tz@646:         MethodSelectionBrowser open
tz@646: 
tz@646:     [author:]
tz@646:         Thomas Zwick
tz@646: "
tz@646: 
tz@646: ! !
tz@646: 
tz@646: !MethodSelectionBrowser class methodsFor:'instance creation'!
tz@646: 
tz@771: request: aTitle onSuperclass: aSuperclass andClass: aClass andSelector: aSelector withTypes: protocolTypes
tz@771:     "opens a MethodSelectionBrowser on 
tz@908:         aSuperclassOrSymbol, 
tz@908:         and aClassOrSymbol, 
tz@908:         and aSelector,
tz@908:         with allowed protocolTypes"
tz@646: 
cg@1979:     ^ self new
cg@1979:         title: aTitle;
cg@1979:         openOnSuperclass: aSuperclass
cg@1979:         andClass: aClass
cg@1979:         andSelector: aSelector
cg@1979:         withTypes: protocolTypes
cg@1979: 
tz@650:     "
cg@1979:      MethodSelectionBrowser
tz@908:         request: 'Select a Method'
tz@908:         onSuperclass: #ApplicationModel 
tz@908:         andClass: #MenuEditor 
tz@908:         andSelector: #menuItemImage
tz@908:         withTypes: #(class)      
tz@646:     "
tz@646: ! !
tz@646: 
tz@646: !MethodSelectionBrowser class methodsFor:'list specs'!
tz@646: 
tz@823: tableColumnsForResourceMethodAttributes
tz@821:     "This resource specification was automatically generated
tz@821:      by the DataSetBuilder of ST/X."
tz@646: 
tz@821:     "Do not manually edit this!! If it is corrupted,
tz@821:      the DataSetBuilder may not be able to read the specification."
tz@821: 
tz@821:     "
tz@823:      DataSetBuilder new openOnClass:MethodSelectionBrowser andSelector:#tableColumnsForResourceMethodAttributes
tz@821:     "
tz@821: 
tz@821:     <resource: #tableColumns>
tz@646: 
tz@646: 
tz@821:     ^ #(
tz@821:         #(#DataSetColumnSpec
tz@821:            #label: ' Selector'
tz@821:            #labelAlignment: #left
tz@821:            #model: #selector
tz@821:            #canSelect: false
tz@821:        )
tz@821:         #(#DataSetColumnSpec
tz@821:            #label: ' Protocol'
tz@821:            #labelAlignment: #left
tz@821:            #model: #protocol
tz@821:            #canSelect: false
tz@821:        )
tz@821:      )
tz@646: ! !
tz@646: 
tz@773: !MethodSelectionBrowser methodsFor:'aspects'!
tz@773: 
tz@773: helpEnabled
tz@773:     "returns whether there is a documentation file"
tz@773: 
tz@773:     ^false
tz@773: 
tz@773: ! !
tz@773: 
tz@646: !MethodSelectionBrowser methodsFor:'callbacks - user'!
tz@646: 
tz@771: classSelected
tz@771:     "after a class selection, read the class or/and instance methods of the selected class"
tz@646: 
tz@908:     ClassPresentation = #'Class Hierarchy'
tz@908:         ifTrue:  [self selectionOfClassHierarchy  value isNil ifTrue: [^nil]]
tz@908:         ifFalse: [self selectionOfClassCategories value isNil ifTrue: [^nil]].
tz@908: 
tz@646:     self withWaitCursorDo:
tz@646:     [
tz@771:         |clsName contentsBlock|
tz@646:         resourceTypes isNil ifTrue: [resourceTypes := #(instance class)].
tz@908:         ClassPresentation = #'Class Hierarchy'
tz@908:             ifTrue:  [clsName := (self selectionOfClassHierarchy  value name upTo: $ ) asSymbol]
tz@908:             ifFalse: [clsName := (self selectionOfClassCategories value name upTo: $ ) asSymbol].
tz@646:         self valueOfClassName value: clsName.
tz@646:         self class lastSelection: clsName.
tz@771:         self listOfResourceMethods removeAll.
tz@771:         contentsBlock := 
tz@771:         [:protocol|
tz@771:             |cls|
tz@771:             (resourceTypes includes: protocol) 
tz@771:             ifTrue: 
tz@771:             [
tz@771:                 cls := Smalltalk at: clsName.
tz@771:                 cls := (protocol = #instance) ifTrue: [cls] ifFalse: [cls class].
tz@771:                 self listOfResourceMethods addAll:
tz@771:                     (cls selectors asOrderedCollection
tz@771:                      collect: [:sel| Method new selector: sel; protocol: protocol asString])
tz@771:             ]
tz@771:         ].
tz@771:         contentsBlock value: #instance.
tz@771:         contentsBlock value: #class.
tz@646:     ]
tz@646: 
tz@646: 
tz@646: ! !
tz@646: 
tz@646: !MethodSelectionBrowser methodsFor:'instance creation'!
tz@646: 
tz@771: openOnSuperclass: aSuperclassOrSymbol andClass: aClassOrSymbol andSelector: aSelector withTypes: protocolTypes
tz@771:     "opens a MethodSelectionBrowser on 
cg@1979:         aSuperclassOrSymbol, 
cg@1979:         and aClassOrSymbol, 
cg@1979:         and aSelector,
cg@1979:         with allowed protocolTypes"
tz@646: 
tz@650:     |message type row|
tz@771: 
cg@1979:     message := self 
cg@1979:         openOnSuperclass: aSuperclassOrSymbol 
cg@1979:         andClass: aClassOrSymbol 
cg@1979:         andSelector: aSelector 
cg@1979:         withResourceTypes: protocolTypes.
tz@650: 
tz@650:     (message notNil and:
tz@771:     [((row := self selectionOfResourceMethod value) notNil and:
tz@771:     [(type := row protocol) = 'class'])])
tz@650:     ifTrue:
tz@650:     [   
cg@1979:         message := message replChar:$  withString: ' class '
tz@650:     ].
tz@650:     ^message
tz@646: ! !
tz@646: 
tz@646: !MethodSelectionBrowser methodsFor:'startup / release'!
tz@646: 
tz@646: postBuildWith:aBuilder
tz@771:     "sets the correct title"
tz@646: 
tz@646:     title := 'Method Selection Browser'.
tz@646: 
tz@646:     ^super postBuildWith:aBuilder
tz@646: 
tz@646: ! !
tz@646: 
tz@771: !MethodSelectionBrowser::Method methodsFor:'accessing'!
tz@646: 
tz@665: protocol
tz@773:     "returns the protocol of the method (#instance or #class)"
tz@665: 
tz@665:     ^protocol
tz@665: 
tz@665: 
tz@665: !
tz@665: 
tz@773: protocol: aSymbol
tz@773:     "sets the protocol of the method (#instance or #class)"
tz@665: 
tz@773:     protocol := aSymbol
tz@665: 
tz@665: 
tz@665: !
tz@665: 
tz@646: selector
tz@773:     "returns the selector of the method"
tz@646: 
tz@646:     ^selector
tz@646: 
tz@646: !
tz@646: 
tz@646: selector: aSymbol
tz@773:     "sets the selector of the method"
tz@646: 
tz@646:     selector := aSymbol
tz@646: 
tz@646: ! !
tz@646: 
tz@646: !MethodSelectionBrowser class methodsFor:'documentation'!
tz@646: 
tz@646: version
tz@646:     ^ '$Header$'
tz@646: ! !