MethodSelectionBrowser.st
author Patrik Svestka <patrik.svestka@gmail.com>
Wed, 14 Nov 2018 12:07:51 +0100
branchjv
changeset 3630 5e718e0a754e
parent 3305 6cfecdd561c1
permissions -rw-r--r--
Issue #239: Fix all Smalltak/X source files to be in unicode (UTF8 without BOM) and prefixed by "{ Encoding: utf8 }" when any unicode character is present

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