[comp.lang.smalltalk] source code- version browser for ST V

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! !