|
128
|
1 |
"{ Package: 'stx:goodies/monticello' }"
|
|
|
2 |
|
|
|
3 |
MCCodeTool subclass:#MCSnapshotBrowser
|
|
|
4 |
instanceVariableNames:'categorySelection classSelection protocolSelection
|
|
|
5 |
methodSelection switch'
|
|
|
6 |
classVariableNames:''
|
|
|
7 |
poolDictionaries:''
|
|
597
|
8 |
category:'SCM-Monticello-UI'
|
|
128
|
9 |
!
|
|
|
10 |
|
|
|
11 |
|
|
|
12 |
!MCSnapshotBrowser class methodsFor:'as yet unclassified'!
|
|
|
13 |
|
|
|
14 |
forSnapshot: aSnapshot
|
|
|
15 |
^ self new snapshot: aSnapshot
|
|
|
16 |
! !
|
|
|
17 |
|
|
|
18 |
!MCSnapshotBrowser methodsFor:'accessing'!
|
|
|
19 |
|
|
|
20 |
allClassNames
|
|
|
21 |
^ (items
|
|
|
22 |
select: [:ea | ea isOrganizationDefinition not]
|
|
|
23 |
thenCollect: [:ea | ea className]) asSet.
|
|
|
24 |
!
|
|
|
25 |
|
|
|
26 |
extensionClassNames
|
|
|
27 |
^ (self allClassNames difference: self packageClassNames) asSortedCollection
|
|
|
28 |
!
|
|
|
29 |
|
|
|
30 |
extensionsCategory
|
|
|
31 |
^ '*Extensions'
|
|
|
32 |
!
|
|
|
33 |
|
|
|
34 |
methodsForSelectedClass
|
|
|
35 |
^ items select: [:ea | (ea className = classSelection)
|
|
|
36 |
and: [ea isMethodDefinition]
|
|
|
37 |
and: [ea classIsMeta = self switchIsClass]].
|
|
|
38 |
!
|
|
|
39 |
|
|
|
40 |
methodsForSelectedClassCategory
|
|
|
41 |
| visibleClasses |
|
|
|
42 |
visibleClasses _ self visibleClasses.
|
|
|
43 |
^ items select: [:ea | (visibleClasses includes: ea className)
|
|
|
44 |
and: [ea isMethodDefinition]
|
|
|
45 |
and: [ea classIsMeta = self switchIsClass]].
|
|
|
46 |
!
|
|
|
47 |
|
|
|
48 |
methodsForSelectedProtocol
|
|
|
49 |
| methods |
|
|
|
50 |
protocolSelection ifNil: [^ Array new].
|
|
|
51 |
methods _ self methodsForSelectedClass asOrderedCollection.
|
|
|
52 |
(protocolSelection = '-- all --')
|
|
|
53 |
ifFalse: [methods removeAllSuchThat: [:ea | ea category ~= protocolSelection]].
|
|
|
54 |
^ methods
|
|
|
55 |
|
|
|
56 |
|
|
|
57 |
!
|
|
|
58 |
|
|
|
59 |
packageClassNames
|
|
|
60 |
^ self packageClasses collect: [:ea | ea className]
|
|
|
61 |
!
|
|
|
62 |
|
|
|
63 |
packageClasses
|
|
|
64 |
^ items select: [:ea | ea isClassDefinition]
|
|
|
65 |
!
|
|
|
66 |
|
|
|
67 |
selectedClass
|
|
|
68 |
classSelection ifNil: [ ^nil ].
|
|
|
69 |
^Smalltalk at: classSelection ifAbsent: [ nil ].
|
|
|
70 |
!
|
|
|
71 |
|
|
|
72 |
selectedClassOrMetaClass
|
|
|
73 |
| class |
|
|
|
74 |
classSelection ifNil: [ ^nil ].
|
|
|
75 |
class _ Smalltalk at: classSelection ifAbsent: [ ^nil ].
|
|
|
76 |
^self switchIsClass ifTrue: [ class class ]
|
|
|
77 |
ifFalse: [ class ].
|
|
|
78 |
!
|
|
|
79 |
|
|
|
80 |
selectedMessageCategoryName
|
|
|
81 |
^protocolSelection
|
|
|
82 |
!
|
|
|
83 |
|
|
|
84 |
selectedMessageName
|
|
|
85 |
^methodSelection ifNotNil: [^ methodSelection selector ].
|
|
|
86 |
!
|
|
|
87 |
|
|
|
88 |
snapshot: aSnapshot
|
|
|
89 |
items _ aSnapshot definitions asSortedCollection.
|
|
|
90 |
self categorySelection: 0.
|
|
|
91 |
! !
|
|
|
92 |
|
|
|
93 |
!MCSnapshotBrowser methodsFor:'listing'!
|
|
|
94 |
|
|
|
95 |
categoryList
|
|
|
96 |
^ self visibleCategories
|
|
|
97 |
!
|
|
|
98 |
|
|
|
99 |
classList
|
|
|
100 |
^ self visibleClasses
|
|
|
101 |
!
|
|
|
102 |
|
|
|
103 |
methodList
|
|
|
104 |
^ self visibleMethods collect: [:ea | ea selector]
|
|
|
105 |
!
|
|
|
106 |
|
|
|
107 |
protocolList
|
|
|
108 |
^ self visibleProtocols
|
|
|
109 |
!
|
|
|
110 |
|
|
|
111 |
visibleCategories
|
|
|
112 |
^ (self packageClasses collect: [:ea | ea category])
|
|
|
113 |
asSet asSortedCollection add: self extensionsCategory; yourself.
|
|
|
114 |
!
|
|
|
115 |
|
|
|
116 |
visibleClasses
|
|
|
117 |
^ categorySelection = self extensionsCategory
|
|
|
118 |
ifTrue: [self extensionClassNames]
|
|
|
119 |
ifFalse: [self packageClasses
|
|
|
120 |
select: [:ea | ea category = categorySelection]
|
|
|
121 |
thenCollect: [:ea | ea className]].
|
|
|
122 |
!
|
|
|
123 |
|
|
|
124 |
visibleMethods
|
|
|
125 |
^ classSelection
|
|
|
126 |
ifNil: [#()]
|
|
|
127 |
ifNotNil: [self methodsForSelectedProtocol]
|
|
|
128 |
!
|
|
|
129 |
|
|
|
130 |
visibleProtocols
|
|
|
131 |
| methods protocols |
|
|
|
132 |
self switchIsComment ifTrue: [^ Array new].
|
|
|
133 |
methods _ self methodsForSelectedClass.
|
|
|
134 |
protocols _ (methods collect: [:ea | ea category]) asSet asSortedCollection.
|
|
|
135 |
(protocols size > 1) ifTrue: [protocols add: '-- all --'].
|
|
|
136 |
^ protocols
|
|
|
137 |
! !
|
|
|
138 |
|
|
|
139 |
!MCSnapshotBrowser methodsFor:'menus'!
|
|
|
140 |
|
|
|
141 |
categoryListMenu: aMenu
|
|
|
142 |
categorySelection
|
|
|
143 |
ifNotNil: [aMenu
|
|
|
144 |
add: (categorySelection = '*Extensions'
|
|
|
145 |
ifTrue: ['load all extension methods' translated]
|
|
|
146 |
ifFalse: ['load class category {1}' translated format: {categorySelection}])
|
|
|
147 |
action: #loadCategorySelection].
|
|
|
148 |
^ aMenu
|
|
|
149 |
!
|
|
|
150 |
|
|
|
151 |
classListMenu: aMenu
|
|
|
152 |
classSelection ifNil: [ ^aMenu ].
|
|
|
153 |
|
|
|
154 |
super classListMenu: aMenu.
|
|
|
155 |
|
|
|
156 |
aMenu
|
|
|
157 |
addLine;
|
|
|
158 |
add: ('load class {1}' translated format: {classSelection})
|
|
|
159 |
action: #loadClassSelection.
|
|
|
160 |
^ aMenu
|
|
|
161 |
!
|
|
|
162 |
|
|
|
163 |
inspectSelection
|
|
|
164 |
^ self methodSelection inspect
|
|
|
165 |
!
|
|
|
166 |
|
|
|
167 |
loadCategorySelection
|
|
|
168 |
"Load the entire selected category"
|
|
|
169 |
categorySelection ifNil: [ ^self ].
|
|
|
170 |
self methodsForSelectedClassCategory do: [ :m | m load ].
|
|
|
171 |
!
|
|
|
172 |
|
|
|
173 |
loadClassSelection
|
|
|
174 |
classSelection ifNil: [ ^self ].
|
|
|
175 |
(self packageClasses detect: [ :ea | ea className = classSelection ] ifNone: [ ^self ]) load.
|
|
|
176 |
self methodsForSelectedClass do: [ :m | m load ].
|
|
|
177 |
!
|
|
|
178 |
|
|
|
179 |
loadMethodSelection
|
|
|
180 |
methodSelection ifNil: [ ^self ].
|
|
|
181 |
methodSelection load.
|
|
|
182 |
!
|
|
|
183 |
|
|
|
184 |
loadProtocolSelection
|
|
|
185 |
protocolSelection ifNil: [ ^self ].
|
|
|
186 |
self methodsForSelectedProtocol do: [ :m | m load ].
|
|
|
187 |
!
|
|
|
188 |
|
|
|
189 |
methodListMenu: aMenu
|
|
|
190 |
super methodListMenu: aMenu.
|
|
|
191 |
self selectedMessageName
|
|
|
192 |
ifNotNilDo: [:msgName | aMenu addLine; add: 'load method' translated action: #loadMethodSelection].
|
|
|
193 |
^ aMenu
|
|
|
194 |
!
|
|
|
195 |
|
|
|
196 |
protocolListMenu: aMenu
|
|
|
197 |
protocolSelection
|
|
|
198 |
ifNotNil: [aMenu
|
|
|
199 |
add: ('load protocol ''{1}''' translated format: {protocolSelection})
|
|
|
200 |
action: #loadProtocolSelection ].
|
|
|
201 |
^ aMenu
|
|
|
202 |
! !
|
|
|
203 |
|
|
|
204 |
!MCSnapshotBrowser methodsFor:'morphic ui'!
|
|
|
205 |
|
|
|
206 |
buttonSpecs
|
|
|
207 |
^ #(('instance' switchBeInstance 'show instance' buttonEnabled switchIsInstance)
|
|
|
208 |
('?' switchBeComment 'show comment' buttonEnabled switchIsComment)
|
|
|
209 |
('class' switchBeClass 'show class' buttonEnabled switchIsClass))
|
|
|
210 |
!
|
|
|
211 |
|
|
|
212 |
defaultExtent
|
|
|
213 |
^ 650@400.
|
|
|
214 |
!
|
|
|
215 |
|
|
|
216 |
defaultLabel
|
|
|
217 |
^ 'Snapshot Browser'
|
|
|
218 |
!
|
|
|
219 |
|
|
|
220 |
widgetSpecs
|
|
|
221 |
|
|
|
222 |
Preferences annotationPanes ifFalse: [ ^#(
|
|
|
223 |
((listMorph: category) (0 0 0.25 0.4))
|
|
|
224 |
((listMorph: class) (0.25 0 0.50 0.4) (0 0 0 -30))
|
|
|
225 |
((listMorph: protocol) (0.50 0 0.75 0.4))
|
|
|
226 |
((listMorph:selection:menu:keystroke: methodList methodSelection methodListMenu: methodListKey:from:) (0.75 0 1 0.4))
|
|
|
227 |
((buttonRow) (0.25 0.4 0.5 0.4) (0 -30 0 0))
|
|
|
228 |
((textMorph: text) (0 0.4 1 1))
|
|
|
229 |
) ].
|
|
|
230 |
|
|
|
231 |
^#(
|
|
|
232 |
((listMorph: category) (0 0 0.25 0.4))
|
|
|
233 |
((listMorph: class) (0.25 0 0.50 0.4) (0 0 0 -30))
|
|
|
234 |
((listMorph: protocol) (0.50 0 0.75 0.4))
|
|
|
235 |
((listMorph:selection:menu:keystroke: methodList methodSelection methodListMenu: methodListKey:from:) (0.75 0 1 0.4))
|
|
|
236 |
|
|
|
237 |
((buttonRow) (0.25 0.4 0.5 0.4) (0 -30 0 0))
|
|
|
238 |
|
|
|
239 |
((textMorph: annotations) (0 0.4 1 0.4) (0 0 0 30))
|
|
|
240 |
((textMorph: text) (0 0.4 1 1) (0 30 0 0))
|
|
|
241 |
)
|
|
|
242 |
! !
|
|
|
243 |
|
|
|
244 |
!MCSnapshotBrowser methodsFor:'selecting'!
|
|
|
245 |
|
|
|
246 |
categorySelection
|
|
|
247 |
^ categorySelection ifNil: [0] ifNotNil: [self visibleCategories indexOf: categorySelection]
|
|
|
248 |
!
|
|
|
249 |
|
|
|
250 |
categorySelection: aNumber
|
|
|
251 |
categorySelection _ aNumber = 0 ifFalse: [self visibleCategories at: aNumber].
|
|
|
252 |
self classSelection: 0.
|
|
|
253 |
self changed: #categorySelection;
|
|
|
254 |
changed: #annotations;
|
|
|
255 |
changed: #classList.
|
|
|
256 |
!
|
|
|
257 |
|
|
|
258 |
classSelection
|
|
|
259 |
^ classSelection ifNil: [0] ifNotNil: [self visibleClasses indexOf: classSelection]
|
|
|
260 |
!
|
|
|
261 |
|
|
|
262 |
classSelection: aNumber
|
|
|
263 |
classSelection _ aNumber = 0 ifFalse: [self visibleClasses at: aNumber].
|
|
|
264 |
self protocolSelection: 0.
|
|
|
265 |
self changed: #classSelection;
|
|
|
266 |
changed: #protocolList;
|
|
|
267 |
changed: #annotations;
|
|
|
268 |
changed: #methodList.
|
|
|
269 |
!
|
|
|
270 |
|
|
|
271 |
methodSelection
|
|
|
272 |
^ methodSelection
|
|
|
273 |
ifNil: [0]
|
|
|
274 |
ifNotNil: [self visibleMethods indexOf: methodSelection]
|
|
|
275 |
!
|
|
|
276 |
|
|
|
277 |
methodSelection: aNumber
|
|
|
278 |
methodSelection _ aNumber = 0 ifFalse: [self visibleMethods at: aNumber].
|
|
|
279 |
self changed: #methodSelection; changed: #text; changed: #annotations
|
|
|
280 |
!
|
|
|
281 |
|
|
|
282 |
protocolSelection
|
|
|
283 |
^ protocolSelection
|
|
|
284 |
ifNil: [0]
|
|
|
285 |
ifNotNil: [self visibleProtocols indexOf: protocolSelection]
|
|
|
286 |
!
|
|
|
287 |
|
|
|
288 |
protocolSelection: anInteger
|
|
|
289 |
protocolSelection _ (anInteger = 0 ifFalse: [self visibleProtocols at: anInteger]).
|
|
|
290 |
self methodSelection: 0.
|
|
|
291 |
self changed: #protocolSelection;
|
|
|
292 |
changed: #methodList;
|
|
|
293 |
changed: #annotations
|
|
|
294 |
! !
|
|
|
295 |
|
|
|
296 |
!MCSnapshotBrowser methodsFor:'switch'!
|
|
|
297 |
|
|
|
298 |
signalSwitchChanged
|
|
|
299 |
self protocolSelection: 0.
|
|
|
300 |
self
|
|
|
301 |
changed: #switchIsInstance;
|
|
|
302 |
changed: #switchIsComment;
|
|
|
303 |
changed: #switchIsClass;
|
|
|
304 |
changed: #protocolList;
|
|
|
305 |
changed: #methodList;
|
|
|
306 |
changed: #text.
|
|
|
307 |
!
|
|
|
308 |
|
|
|
309 |
switchBeClass
|
|
|
310 |
switch _ #class.
|
|
|
311 |
self signalSwitchChanged.
|
|
|
312 |
!
|
|
|
313 |
|
|
|
314 |
switchBeComment
|
|
|
315 |
switch _ #comment.
|
|
|
316 |
self signalSwitchChanged.
|
|
|
317 |
!
|
|
|
318 |
|
|
|
319 |
switchBeInstance
|
|
|
320 |
switch _ #instance.
|
|
|
321 |
self signalSwitchChanged.
|
|
|
322 |
!
|
|
|
323 |
|
|
|
324 |
switchIsClass
|
|
|
325 |
^ switch = #class
|
|
|
326 |
!
|
|
|
327 |
|
|
|
328 |
switchIsComment
|
|
|
329 |
^ switch = #comment.
|
|
|
330 |
!
|
|
|
331 |
|
|
|
332 |
switchIsInstance
|
|
|
333 |
switch ifNil: [switch _ #instance].
|
|
|
334 |
^ switch = #instance.
|
|
|
335 |
! !
|
|
|
336 |
|
|
|
337 |
!MCSnapshotBrowser methodsFor:'text'!
|
|
|
338 |
|
|
|
339 |
annotations
|
|
|
340 |
methodSelection ifNotNil: [^ methodSelection annotations ].
|
|
|
341 |
^ ''
|
|
|
342 |
!
|
|
|
343 |
|
|
|
344 |
annotations: stuff
|
|
|
345 |
self changed: #annotations
|
|
|
346 |
!
|
|
|
347 |
|
|
|
348 |
classCommentString
|
|
|
349 |
^ (items
|
|
|
350 |
detect: [:ea | ea isClassDefinition and: [ea className = classSelection]]
|
|
|
351 |
ifNone: [^ '']) comment.
|
|
|
352 |
!
|
|
|
353 |
|
|
|
354 |
classDefinitionString
|
|
|
355 |
| defs |
|
|
|
356 |
defs _ items select: [:ea | (ea isClassDefinition or: [ea isClassDefinitionExtension])
|
|
|
357 |
and: [ea className = classSelection]].
|
|
|
358 |
|
|
|
359 |
defs isEmpty ifTrue: [^ 'This class is defined elsewhere.'].
|
|
|
360 |
|
|
|
361 |
^ String streamContents: [:stream |
|
|
|
362 |
defs asArray sort
|
|
|
363 |
do: [:ea | ea printDefinitionOn: stream]
|
|
|
364 |
separatedBy: [stream nextPut: $.; cr]
|
|
|
365 |
].
|
|
|
366 |
!
|
|
|
367 |
|
|
|
368 |
text
|
|
|
369 |
self switchIsComment ifTrue: [^ self classCommentString].
|
|
|
370 |
methodSelection ifNotNil: [^ methodSelection source].
|
|
|
371 |
protocolSelection ifNotNil: [^ ''].
|
|
|
372 |
classSelection ifNotNil: [^ self classDefinitionString].
|
|
|
373 |
^ ''
|
|
|
374 |
!
|
|
|
375 |
|
|
|
376 |
text: aTextOrString
|
|
|
377 |
self changed: #text
|
|
|
378 |
! !
|
|
|
379 |
|
|
|
380 |
!MCSnapshotBrowser class methodsFor:'documentation'!
|
|
|
381 |
|
|
|
382 |
version
|
|
597
|
383 |
^ '$Header: /cvs/stx/stx/goodies/monticello/MCSnapshotBrowser.st,v 1.2 2012-09-11 21:14:41 cg Exp $'
|
|
128
|
384 |
! !
|