kentb@Apple.COM (Kent Beck) (10/07/89)
In the spirit of sharing source code, here is an implementation of version
browsing for Smalltalk/V Mac (although it should work equally well with
V/286). If you adapt this to Smalltalk-80 remember- you are modifying the
bowels of the system, proceed with caution and make lots of backups.
Kent
-----------slice-o dice-o--------------------------
"File in to add version support to Smalltalk/V Mac.
Goes with October 89 HOOPLA column.
Kent Beck, 8/29/89"!
MethodListBrowser subclass: #VersionBrowser
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''!
!VersionBrowser methods!
text
selectedMethod isNil
ifTrue: [ ^ '' ].
^ selectedMethod sourceString! !
Object subclass: #Behavior
instanceVariableNames:
'superClass messageDictionary structure name comment subclasses instances '
classVariableNames:
'InstPointerBit InstIndexedBit InstNumberMask OldMethods'
poolDictionaries: ''!
!Behavior methods!
addSelector: aSymbol withMethod: aCompiledMethod
Symbol mustBeSymbol: aSymbol.
(self includesSelector: aSymbol) & (aSymbol ~= #Doit)
ifTrue:
[OldMethods isNil ifTrue: [OldMethods := OrderedCollection new].
OldMethods addLast: (self compiledMethodAt: aSymbol)].
messageDictionary at: aSymbol put: aCompiledMethod!
versionsOf: aSymbol
| methods |
methods := OldMethods select:
[:each | each selector == aSymbol & (each classField == self)].
(self includesSelector: aSymbol)
ifTrue: [methods addLast: (self compiledMethodAt: aSymbol)].
^methods!
browseVersionsOf: aSymbol
| label extent classes methods |
label := 'Versions of ', self name, '>>', aSymbol.
extent := ((400 max: label size * LabelFont width + 6) min: Screen width) @ 300.
VersionBrowser new
openOn: (self versionsOf: aSymbol)
for: label! !
!ClassBrowser methods!
selectorMenu
^(Menu
labels: 'Senders\Implementors\Messages\Versions\File Out Method\New Method\Remove Method' breakLinesAtBackSlashes
lines: #(4)
selectors: #(senders implementors messages versions
fileOutMethod newMethod removeSelector))
title: 'Methods'!
versions
selectedMethod isNil ifTrue: [^self].
selectedDictionary browseVersionsOf: selectedMethod! !
!ClassHierarchyBrowser methods!
selectorMenu
^(Menu
labels: 'Senders\Implementors\Messages\Versions\File Out Method\New Method\Remove Method' breakLinesAtBackSlashes
lines: #(4)
selectors: #(senders implementors messages versions
fileOutMethod newMethod removeSelector))
title: 'Methods'!
versions
| class |
methodSelectedLast ifFalse: [^self].
class := instanceSelectedLast
ifTrue: [selectedClass]
ifFalse: [selectedClass class].
class browseVersionsOf: selectedMethod! !
!MethodListBrowser methods!
selectorMenu
^(Menu
labels: 'Senders\Implementors\Messages\Versions\Remove Method'
breakLinesAtBackSlashes
lines: #(4)
selectors: #(senders implementors messages versions removeSelector))
title: 'Methods'!
versions
selectedMethod isNil ifTrue: [^self].
selectedMethod classField browseVersionsOf: selectedMethod selector! !