MethodSelectionBrowser.st
author Claus Gittinger <cg@exept.de>
Wed, 29 Jul 2009 20:02:02 +0200
changeset 2570 4e663bc64364
parent 1979 7b14d02e8ed1
child 3305 6cfecdd561c1
permissions -rw-r--r--
changed #requestPackage
tz@646
     1
"
tz@771
     2
 COPYRIGHT (c) 1997-1998 by eXept Software AG
tz@646
     3
              All Rights Reserved
tz@646
     4
tz@646
     5
 This software is furnished under a license and may be used
tz@646
     6
 only in accordance with the terms of that license and with the
tz@646
     7
 inclusion of the above copyright notice. This software may not
tz@646
     8
 be provided or otherwise made available to, or used by, any
tz@646
     9
 other person. No title to or ownership of the software is
tz@646
    10
 hereby transferred.
tz@646
    11
"
tz@646
    12
tz@646
    13
tz@646
    14
cg@1979
    15
"{ Package: 'stx:libtool2' }"
cg@1979
    16
tz@646
    17
ResourceSelectionBrowser subclass:#MethodSelectionBrowser
tz@646
    18
	instanceVariableNames:''
tz@646
    19
	classVariableNames:''
tz@646
    20
	poolDictionaries:''
tz@646
    21
	category:'Interface-Dialogs'
tz@646
    22
!
tz@646
    23
tz@771
    24
Object subclass:#Method
tz@665
    25
	instanceVariableNames:'selector protocol'
tz@646
    26
	classVariableNames:''
tz@646
    27
	poolDictionaries:''
tz@646
    28
	privateIn:MethodSelectionBrowser
tz@646
    29
!
tz@646
    30
tz@646
    31
!MethodSelectionBrowser class methodsFor:'documentation'!
tz@646
    32
tz@646
    33
copyright
tz@646
    34
"
tz@771
    35
 COPYRIGHT (c) 1997-1998 by eXept Software AG
tz@646
    36
              All Rights Reserved
tz@646
    37
tz@646
    38
 This software is furnished under a license and may be used
tz@646
    39
 only in accordance with the terms of that license and with the
tz@646
    40
 inclusion of the above copyright notice. This software may not
tz@646
    41
 be provided or otherwise made available to, or used by, any
tz@646
    42
 other person. No title to or ownership of the software is
tz@646
    43
 hereby transferred.
tz@646
    44
"
tz@646
    45
tz@646
    46
tz@646
    47
!
tz@646
    48
tz@646
    49
documentation
tz@646
    50
"
tz@771
    51
    The MethodSelectionBrowser allows you to browse in class hierarchies
tz@771
    52
    for selecting methods for you purposes.
tz@771
    53
tz@646
    54
    [start with:]
tz@646
    55
        MethodSelectionBrowser open
tz@646
    56
tz@646
    57
    [author:]
tz@646
    58
        Thomas Zwick
tz@646
    59
"
tz@646
    60
tz@646
    61
! !
tz@646
    62
tz@646
    63
!MethodSelectionBrowser class methodsFor:'instance creation'!
tz@646
    64
tz@771
    65
request: aTitle onSuperclass: aSuperclass andClass: aClass andSelector: aSelector withTypes: protocolTypes
tz@771
    66
    "opens a MethodSelectionBrowser on 
tz@908
    67
        aSuperclassOrSymbol, 
tz@908
    68
        and aClassOrSymbol, 
tz@908
    69
        and aSelector,
tz@908
    70
        with allowed protocolTypes"
tz@646
    71
cg@1979
    72
    ^ self new
cg@1979
    73
        title: aTitle;
cg@1979
    74
        openOnSuperclass: aSuperclass
cg@1979
    75
        andClass: aClass
cg@1979
    76
        andSelector: aSelector
cg@1979
    77
        withTypes: protocolTypes
cg@1979
    78
tz@650
    79
    "
cg@1979
    80
     MethodSelectionBrowser
tz@908
    81
        request: 'Select a Method'
tz@908
    82
        onSuperclass: #ApplicationModel 
tz@908
    83
        andClass: #MenuEditor 
tz@908
    84
        andSelector: #menuItemImage
tz@908
    85
        withTypes: #(class)      
tz@646
    86
    "
tz@646
    87
! !
tz@646
    88
tz@646
    89
!MethodSelectionBrowser class methodsFor:'list specs'!
tz@646
    90
tz@823
    91
tableColumnsForResourceMethodAttributes
tz@821
    92
    "This resource specification was automatically generated
tz@821
    93
     by the DataSetBuilder of ST/X."
tz@646
    94
tz@821
    95
    "Do not manually edit this!! If it is corrupted,
tz@821
    96
     the DataSetBuilder may not be able to read the specification."
tz@646
    97
tz@821
    98
    "
tz@823
    99
     DataSetBuilder new openOnClass:MethodSelectionBrowser andSelector:#tableColumnsForResourceMethodAttributes
tz@821
   100
    "
tz@646
   101
tz@821
   102
    <resource: #tableColumns>
tz@646
   103
tz@646
   104
tz@821
   105
    ^ #(
tz@821
   106
        #(#DataSetColumnSpec
tz@821
   107
           #label: ' Selector'
tz@821
   108
           #labelAlignment: #left
tz@821
   109
           #model: #selector
tz@821
   110
           #canSelect: false
tz@821
   111
       )
tz@821
   112
        #(#DataSetColumnSpec
tz@821
   113
           #label: ' Protocol'
tz@821
   114
           #labelAlignment: #left
tz@821
   115
           #model: #protocol
tz@821
   116
           #canSelect: false
tz@821
   117
       )
tz@821
   118
     )
tz@646
   119
! !
tz@646
   120
tz@773
   121
!MethodSelectionBrowser methodsFor:'aspects'!
tz@773
   122
tz@773
   123
helpEnabled
tz@773
   124
    "returns whether there is a documentation file"
tz@773
   125
tz@773
   126
    ^false
tz@773
   127
tz@773
   128
! !
tz@773
   129
tz@646
   130
!MethodSelectionBrowser methodsFor:'callbacks - user'!
tz@646
   131
tz@771
   132
classSelected
tz@771
   133
    "after a class selection, read the class or/and instance methods of the selected class"
tz@646
   134
tz@908
   135
    ClassPresentation = #'Class Hierarchy'
tz@908
   136
        ifTrue:  [self selectionOfClassHierarchy  value isNil ifTrue: [^nil]]
tz@908
   137
        ifFalse: [self selectionOfClassCategories value isNil ifTrue: [^nil]].
tz@908
   138
tz@646
   139
    self withWaitCursorDo:
tz@646
   140
    [
tz@771
   141
        |clsName contentsBlock|
tz@646
   142
        resourceTypes isNil ifTrue: [resourceTypes := #(instance class)].
tz@908
   143
        ClassPresentation = #'Class Hierarchy'
tz@908
   144
            ifTrue:  [clsName := (self selectionOfClassHierarchy  value name upTo: $ ) asSymbol]
tz@908
   145
            ifFalse: [clsName := (self selectionOfClassCategories value name upTo: $ ) asSymbol].
tz@646
   146
        self valueOfClassName value: clsName.
tz@646
   147
        self class lastSelection: clsName.
tz@771
   148
        self listOfResourceMethods removeAll.
tz@771
   149
        contentsBlock := 
tz@771
   150
        [:protocol|
tz@771
   151
            |cls|
tz@771
   152
            (resourceTypes includes: protocol) 
tz@771
   153
            ifTrue: 
tz@771
   154
            [
tz@771
   155
                cls := Smalltalk at: clsName.
tz@771
   156
                cls := (protocol = #instance) ifTrue: [cls] ifFalse: [cls class].
tz@771
   157
                self listOfResourceMethods addAll:
tz@771
   158
                    (cls selectors asOrderedCollection
tz@771
   159
                     collect: [:sel| Method new selector: sel; protocol: protocol asString])
tz@771
   160
            ]
tz@771
   161
        ].
tz@771
   162
        contentsBlock value: #instance.
tz@771
   163
        contentsBlock value: #class.
tz@646
   164
    ]
tz@646
   165
tz@646
   166
tz@646
   167
! !
tz@646
   168
tz@646
   169
!MethodSelectionBrowser methodsFor:'instance creation'!
tz@646
   170
tz@771
   171
openOnSuperclass: aSuperclassOrSymbol andClass: aClassOrSymbol andSelector: aSelector withTypes: protocolTypes
tz@771
   172
    "opens a MethodSelectionBrowser on 
cg@1979
   173
        aSuperclassOrSymbol, 
cg@1979
   174
        and aClassOrSymbol, 
cg@1979
   175
        and aSelector,
cg@1979
   176
        with allowed protocolTypes"
tz@646
   177
tz@650
   178
    |message type row|
tz@771
   179
cg@1979
   180
    message := self 
cg@1979
   181
        openOnSuperclass: aSuperclassOrSymbol 
cg@1979
   182
        andClass: aClassOrSymbol 
cg@1979
   183
        andSelector: aSelector 
cg@1979
   184
        withResourceTypes: protocolTypes.
tz@650
   185
tz@650
   186
    (message notNil and:
tz@771
   187
    [((row := self selectionOfResourceMethod value) notNil and:
tz@771
   188
    [(type := row protocol) = 'class'])])
tz@650
   189
    ifTrue:
tz@650
   190
    [   
cg@1979
   191
        message := message replChar:$  withString: ' class '
tz@650
   192
    ].
tz@650
   193
    ^message
tz@646
   194
! !
tz@646
   195
tz@646
   196
!MethodSelectionBrowser methodsFor:'startup / release'!
tz@646
   197
tz@646
   198
postBuildWith:aBuilder
tz@771
   199
    "sets the correct title"
tz@646
   200
tz@646
   201
    title := 'Method Selection Browser'.
tz@646
   202
tz@646
   203
    ^super postBuildWith:aBuilder
tz@646
   204
tz@646
   205
! !
tz@646
   206
tz@771
   207
!MethodSelectionBrowser::Method methodsFor:'accessing'!
tz@646
   208
tz@665
   209
protocol
tz@773
   210
    "returns the protocol of the method (#instance or #class)"
tz@665
   211
tz@665
   212
    ^protocol
tz@665
   213
tz@665
   214
tz@665
   215
!
tz@665
   216
tz@773
   217
protocol: aSymbol
tz@773
   218
    "sets the protocol of the method (#instance or #class)"
tz@665
   219
tz@773
   220
    protocol := aSymbol
tz@665
   221
tz@665
   222
tz@665
   223
!
tz@665
   224
tz@646
   225
selector
tz@773
   226
    "returns the selector of the method"
tz@646
   227
tz@646
   228
    ^selector
tz@646
   229
tz@646
   230
!
tz@646
   231
tz@646
   232
selector: aSymbol
tz@773
   233
    "sets the selector of the method"
tz@646
   234
tz@646
   235
    selector := aSymbol
tz@646
   236
tz@646
   237
! !
tz@646
   238
tz@646
   239
!MethodSelectionBrowser class methodsFor:'documentation'!
tz@646
   240
tz@646
   241
version
tz@646
   242
    ^ '$Header$'
tz@646
   243
! !