MethodSelectionBrowser.st
changeset 771 905c3b4ba565
parent 680 49c81e9cc6f7
child 773 de5c99bd3078
equal deleted inserted replaced
770:96f106b0a61e 771:905c3b4ba565
     1 "
     1 "
     2  COPYRIGHT (c) 1997 by eXept Software AG
     2  COPYRIGHT (c) 1997-1998 by eXept Software AG
     3               All Rights Reserved
     3               All Rights Reserved
     4 
     4 
     5  This software is furnished under a license and may be used
     5  This software is furnished under a license and may be used
     6  only in accordance with the terms of that license and with the
     6  only in accordance with the terms of that license and with the
     7  inclusion of the above copyright notice. This software may not
     7  inclusion of the above copyright notice. This software may not
    17 	classVariableNames:''
    17 	classVariableNames:''
    18 	poolDictionaries:''
    18 	poolDictionaries:''
    19 	category:'Interface-Dialogs'
    19 	category:'Interface-Dialogs'
    20 !
    20 !
    21 
    21 
    22 Object subclass:#Row
    22 Object subclass:#Method
    23 	instanceVariableNames:'selector protocol'
    23 	instanceVariableNames:'selector protocol'
    24 	classVariableNames:''
    24 	classVariableNames:''
    25 	poolDictionaries:''
    25 	poolDictionaries:''
    26 	privateIn:MethodSelectionBrowser
    26 	privateIn:MethodSelectionBrowser
    27 !
    27 !
    28 
    28 
    29 !MethodSelectionBrowser class methodsFor:'documentation'!
    29 !MethodSelectionBrowser class methodsFor:'documentation'!
    30 
    30 
    31 copyright
    31 copyright
    32 "
    32 "
    33  COPYRIGHT (c) 1997 by eXept Software AG
    33  COPYRIGHT (c) 1997-1998 by eXept Software AG
    34               All Rights Reserved
    34               All Rights Reserved
    35 
    35 
    36  This software is furnished under a license and may be used
    36  This software is furnished under a license and may be used
    37  only in accordance with the terms of that license and with the
    37  only in accordance with the terms of that license and with the
    38  inclusion of the above copyright notice. This software may not
    38  inclusion of the above copyright notice. This software may not
    44 
    44 
    45 !
    45 !
    46 
    46 
    47 documentation
    47 documentation
    48 "
    48 "
       
    49     The MethodSelectionBrowser allows you to browse in class hierarchies
       
    50     for selecting methods for you purposes.
       
    51 
    49     [start with:]
    52     [start with:]
    50         MethodSelectionBrowser open
    53         MethodSelectionBrowser open
    51 
    54 
    52     [author:]
    55     [author:]
    53         Thomas Zwick
    56         Thomas Zwick
    55 
    58 
    56 ! !
    59 ! !
    57 
    60 
    58 !MethodSelectionBrowser class methodsFor:'instance creation'!
    61 !MethodSelectionBrowser class methodsFor:'instance creation'!
    59 
    62 
    60 request: aTitle onSuperclass: aSuperclass andClass: aClass andSelector: aSelector withTypes: aResourceTypes
    63 request: aTitle onSuperclass: aSuperclass andClass: aClass andSelector: aSelector withTypes: protocolTypes
       
    64     "opens a MethodSelectionBrowser on 
       
    65 	aSuperclassOrSymbol, 
       
    66 	and aClassOrSymbol, 
       
    67 	and aSelector,
       
    68 	with allowed protocolTypes"
    61 
    69 
    62     "
    70     "
    63     MethodSelectionBrowser
    71     MethodSelectionBrowser
    64         request: 'Select a Method'
    72 	request: 'Select a Method'
    65         onSuperclass: #ApplicationModel 
    73 	onSuperclass: #ApplicationModel 
    66         andClass: #ToolApplicationModel 
    74 	andClass: #ToolApplicationModel 
    67         andSelector: #saveIcon 
    75 	andSelector: #saveIcon 
    68         withTypes: #(class)      
    76 	withTypes: #(class)      
    69     "
    77     "
    70 
    78 
    71     ^self new
    79     ^self new
    72         title: aTitle;
    80 	title: aTitle;
    73         openOnSuperclass: aSuperclass
    81 	openOnSuperclass: aSuperclass
    74         andClass: aClass
    82 	andClass: aClass
    75         andSelector: aSelector
    83 	andSelector: aSelector
    76         withTypes: aResourceTypes
    84 	withTypes: protocolTypes
    77 
    85 
    78 
    86 
    79 ! !
    87 ! !
    80 
    88 
    81 !MethodSelectionBrowser class methodsFor:'list specs'!
    89 !MethodSelectionBrowser class methodsFor:'list specs'!
    82 
    90 
    83 columnsOfDataSetView
    91 resourceMethodColumns
       
    92     "returns the columns for the table of the resource methods"
    84 
    93 
    85   ^ #(
    94   ^ #(
    86    #(#DataSetColumnSpec
    95    #(#DataSetColumnSpec
    87       #label: ' Selector'
    96       #label: ' Selector'
    88       #'labelAlignment:' #left
    97       #'labelAlignment:' #left
   101 
   110 
   102 ! !
   111 ! !
   103 
   112 
   104 !MethodSelectionBrowser methodsFor:'callbacks - user'!
   113 !MethodSelectionBrowser methodsFor:'callbacks - user'!
   105 
   114 
   106 classSelected: anIndex
   115 classSelected
       
   116     "after a class selection, read the class or/and instance methods of the selected class"
   107 
   117 
   108     self selectionOfClass value isNil ifTrue: [^nil].
   118     self selectionOfClass value isNil ifTrue: [^nil].
   109     self withWaitCursorDo:
   119     self withWaitCursorDo:
   110     [
   120     [
   111         |clsName|
   121         |clsName contentsBlock|
   112         resourceTypes isNil ifTrue: [resourceTypes := #(instance class)].
   122         resourceTypes isNil ifTrue: [resourceTypes := #(instance class)].
   113         clsName := ((self listOfClassesView list at: anIndex) upTo: $ ) asSymbol.
   123         clsName := self selectionOfClass value name.
   114         self valueOfClassName value: clsName.
   124         self valueOfClassName value: clsName.
   115         self class lastSelection: clsName.
   125         self class lastSelection: clsName.
   116         (resourceTypes includes: #instance) ifTrue: [
   126         self listOfResourceMethods removeAll.
   117         self listOfResources contents:
   127         contentsBlock := 
   118             (((Smalltalk at: clsName) 
   128         [:protocol|
   119                 selectors
   129             |cls|
   120                 asOrderedCollection)
   130             (resourceTypes includes: protocol) 
   121              collect: [:sel| Row new selector: sel; protocol: 'instance'])].
   131             ifTrue: 
   122         (resourceTypes includes: #class) ifTrue: [
   132             [
   123         self listOfResources addAll:
   133                 cls := Smalltalk at: clsName.
   124             (((Smalltalk at: clsName) 
   134                 cls := (protocol = #instance) ifTrue: [cls] ifFalse: [cls class].
   125                 class selectors
   135                 self listOfResourceMethods addAll:
   126                 asOrderedCollection)
   136                     (cls selectors asOrderedCollection
   127              collect: [:sel| Row new selector: sel; protocol: 'class'])].
   137                      collect: [:sel| Method new selector: sel; protocol: protocol asString])
       
   138             ]
       
   139         ].
       
   140         contentsBlock value: #instance.
       
   141         contentsBlock value: #class.
   128     ]
   142     ]
   129 
   143 
   130 
   144 
   131 ! !
   145 ! !
   132 
   146 
   133 !MethodSelectionBrowser methodsFor:'instance creation'!
   147 !MethodSelectionBrowser methodsFor:'instance creation'!
   134 
   148 
   135 openOnSuperclass: aSuperclassOrSymbol andClass: aClassOrSymbol andSelector: aSelector withTypes: aResourceTypes
   149 openOnSuperclass: aSuperclassOrSymbol andClass: aClassOrSymbol andSelector: aSelector withTypes: protocolTypes
       
   150     "opens a MethodSelectionBrowser on 
       
   151 	aSuperclassOrSymbol, 
       
   152 	and aClassOrSymbol, 
       
   153 	and aSelector,
       
   154 	with allowed protocolTypes"
   136 
   155 
   137     |message type row|
   156     |message type row|
       
   157 
   138     message := super openOnSuperclass: aSuperclassOrSymbol 
   158     message := super openOnSuperclass: aSuperclassOrSymbol 
   139         andClass: aClassOrSymbol 
   159 	andClass: aClassOrSymbol 
   140         andSelector: aSelector 
   160 	andSelector: aSelector 
   141         withResourceTypes: aResourceTypes.
   161 	withResourceTypes: protocolTypes.
   142 
   162 
   143     (message notNil and:
   163     (message notNil and:
   144     [((row := self selectionOfResource value) notNil and:
   164     [((row := self selectionOfResourceMethod value) notNil and:
   145     [(type := row type) = 'class'])])
   165     [(type := row protocol) = 'class'])])
   146     ifTrue:
   166     ifTrue:
   147     [   
   167     [   
   148         message := message replChar:$  withString: ' class '
   168 	message := message replChar:$  withString: ' class '
   149     ].
   169     ].
   150     ^message
   170     ^message
   151 
   171 
   152 
   172 
   153 
   173 
   154 ! !
   174 ! !
   155 
   175 
   156 !MethodSelectionBrowser methodsFor:'startup / release'!
   176 !MethodSelectionBrowser methodsFor:'startup / release'!
   157 
   177 
   158 postBuildWith:aBuilder
   178 postBuildWith:aBuilder
       
   179     "sets the correct title"
   159 
   180 
   160     title := 'Method Selection Browser'.
   181     title := 'Method Selection Browser'.
   161 
   182 
   162     ^super postBuildWith:aBuilder
   183     ^super postBuildWith:aBuilder
   163 
   184 
   164 ! !
   185 ! !
   165 
   186 
   166 !MethodSelectionBrowser::Row methodsFor:'accessing'!
   187 !MethodSelectionBrowser::Method methodsFor:'accessing'!
   167 
   188 
   168 protocol
   189 protocol
   169 
   190 
   170     ^protocol
   191     ^protocol
   171 
   192