'From Jasmine-rc1 of 7 October 2004 [latest update: #201] on 16 January 2005 at 11:11:10 am'! "Change Set: MethodAnnotationsBrowser Date: 16 January 2005 Author: Robert Hirschfeld Version: 0.1.1 Prerequisite: Jamsmine-rc1-#201 w/ Tweak-1.1-alpha-#447 Web: http://www.prakinf.tu-ilmenau.de/~hirsch/Projects/Squeak/AnnotationsBrowser/ A tool that lets you navigate all method annotations in the system. doIt: [AnnotationsBrowser new openAsMorph] doIt: [CAnnotationsBrowser open]"! CodeHolder subclass: #AnnotationsBrowser instanceVariableNames: 'annotations propertyListIndex selectedProperty valueListIndex selectedValue methodListIndex selectedMethod ' classVariableNames: '' poolDictionaries: '' category: 'Tools-Annotations Browser'! Object subclass: #AnnotationsProperty instanceVariableNames: 'property values methods ' classVariableNames: '' poolDictionaries: '' category: 'Tools-Annotations Browser'! CCodeHolder subclass: #CAnnotationsBrowser instanceVariableNames: 'annotationspropertyListselectedPropertyvalueListselectedValuemethodListselectedMethod' classVariableNames: '' poolDictionaries: '' category: 'Tools-Annotations Browser'! !AnnotationsBrowser methodsFor: 'accessing' stamp: 'rhi 1/10/2005 17:34'! annotations "^ " ^ annotations! ! !AnnotationsBrowser methodsFor: 'accessing' stamp: 'rhi 1/10/2005 17:34'! annotations: aSortedCollection annotations _ aSortedCollection.! ! !AnnotationsBrowser methodsFor: 'code pane' stamp: 'rhi 1/11/2005 19:32'! contents: aString notifying: aController "Copied from MessageSet!!" | category selector class oldSelector | self okayToAccept ifFalse: [^ false]. self setClassAndSelectorIn: [:c :os | class _ c. oldSelector _ os]. class ifNil: [^ false]. (oldSelector ~~ nil and: [oldSelector first isUppercase]) ifTrue: [oldSelector = #Comment ifTrue: [class comment: aString stamp: Utilities changeStamp. self changed: #annotation. self clearUserEditFlag. ^ false]. oldSelector = #Definition ifTrue: ["self defineClass: aString notifying: aController." class subclassDefinerClass evaluate: aString notifying: aController logged: true. self clearUserEditFlag. ^ false]. oldSelector = #Hierarchy ifTrue: [self inform: 'To change the hierarchy, edit the class definitions'. ^ false]]. "Normal method accept" category _ class organization categoryOfElement: oldSelector. selector _ class compile: aString classified: category notifying: aController. selector == nil ifTrue: [^ false]. self noteAcceptanceOfCodeFor: selector. selector == oldSelector ifFalse: [self reformulateListNoting: selector]. contents _ aString copy. self changed: #annotation. ^ true! ! !AnnotationsBrowser methodsFor: 'code pane' stamp: 'rhi 1/11/2005 19:27'! selectedClass ^ self selectedClassOrMetaClass theNonMetaClass! ! !AnnotationsBrowser methodsFor: 'code pane' stamp: 'rhi 1/11/2005 19:08'! selectedClassOrMetaClass ^ self selectedMethod ifNotNil: [self selectedMethod actualClass]! ! !AnnotationsBrowser methodsFor: 'code pane' stamp: 'rhi 1/11/2005 19:04'! selectedMessageName ^ self selectedMethod ifNotNil: [self selectedMethod methodSymbol]! ! !AnnotationsBrowser methodsFor: 'code pane' stamp: 'rhi 1/11/2005 19:46'! updateCurrentCompiledMethod currentCompiledMethod _ self selectedMethod ifNotNil: [self selectedMethod compiledMethod].! ! !AnnotationsBrowser methodsFor: 'initialization' stamp: 'rhi 1/12/2005 12:39'! initAnnotations | annos | self flag: #rhi. "Take advantage of CompiledMethod class MethodProperties!!" annos _ Set new. self systemNavigation allBehaviorsDo: [:beh | beh methodDict keysAndValuesDo: [:sel :cm | | props | (props _ cm properties) ifNotNil: [ props associationsDo: [:ass | | prop | prop _ (annos detect: [:anno | anno property == ass key] ifNone: [annos add: (AnnotationsProperty new property: ass key)]). prop values add: ass value. prop methods add: (MethodReference class: beh selector: sel)]]]]. self annotations: (annos asSortedCollection: [:a :b | a property <= b property]).! ! !AnnotationsBrowser methodsFor: 'initialization' stamp: 'rhi 1/12/2005 14:23'! initialize CompiledMethod removeDependent: self; addDependent: self. self initAnnotations; propertyListIndex: 0.! ! !AnnotationsBrowser methodsFor: 'interface opening' stamp: 'rhi 1/12/2005 13:01'! openAsMorph | window | (window _ SystemWindow labelled: 'Annotations Browser') model: self; addMorph: self propertyListMorph frame: (0@0 corner: 0.33@0.4); addMorph: self valueListMorph frame: (0.33@0 corner: 0.66@0.4); addMorph: self methodListMorph frame: (0.66@0 corner: 1@0.4). self addLowerPanesTo: window at: (0@0.4 corner: 1@1) with: nil. ^ window setUpdatablePanesFrom: #(propertyListNames valueListNames methodListNames); openInWorld! ! !AnnotationsBrowser methodsFor: 'method list' stamp: 'rhi 1/11/2005 20:03'! addExtraShiftedItemsTo: aMenu "Copied from Browser!!"! ! !AnnotationsBrowser methodsFor: 'method list' stamp: 'rhi 1/11/2005 20:01'! messageListMenu: aMenu shifted: shifted "Copied from Browser!!" shifted ifTrue: [^ self shiftedMessageListMenu: aMenu]. aMenu addList:#( ('what to show...' offerWhatToShowMenu) - ('browse full (b)' browseMethodFull) ('browse hierarchy (h)' classHierarchy) ('browse method (O)' openSingleMessageBrowser) ('browse protocol (p)' browseFullProtocol) - ('fileOut (o)' fileOutMessage) ('printOut' printOutMessage) ('copy selector (c)' copySelector) - ('senders of... (n)' browseSendersOfMessages) ('implementors of... (m)' browseMessages) ('inheritance (i)' methodHierarchy) ('versions (v)' browseVersions) - ('inst var refs...' browseInstVarRefs) ('inst var defs...' browseInstVarDefs) ('class var refs...' browseClassVarRefs) ('class variables' browseClassVariables) ('class refs (N)' browseClassRefs) - ('remove method (x)' removeMessage) - ('more...' shiftedYellowButtonActivity)). ^ aMenu! ! !AnnotationsBrowser methodsFor: 'method list' stamp: 'rhi 1/11/2005 16:31'! methodList | list anno | list _ Set new. self selectedProperty ifNil: [self annotations do: [:each | list addAll: each methods]] ifNotNil: [ anno _ self annotations detect: [:each | each property = self selectedProperty property]. self selectedValue ifNil: [list addAll: anno methods] ifNotNil: [anno methods do: [:mref | ((mref actualClass compiledMethodAt: mref methodSymbol) valueOfProperty: self selectedProperty property) = self selectedValue ifTrue: [list add: mref]]]]. ^ list asSortedCollection: [:a :b | a stringVersion <= b stringVersion]! ! !AnnotationsBrowser methodsFor: 'method list' stamp: 'rhi 1/10/2005 14:40'! methodListIndex "^ " ^ methodListIndex! ! !AnnotationsBrowser methodsFor: 'method list' stamp: 'rhi 1/11/2005 20:20'! methodListIndex: anInteger methodListIndex _ anInteger. self selectedMethod: (self methodList at: anInteger ifAbsent: [nil]); updateCurrentCompiledMethod; decorateButtons; contents: (self methodListIndex ~= 0 ifTrue: [self selectedMethod sourceCode] ifFalse: [String new]); changed: #methodListIndex; setContentsToForceRefetch; contentsChanged.! ! !AnnotationsBrowser methodsFor: 'method list' stamp: 'rhi 1/11/2005 19:19'! methodListMorph ^ PluggableListMorph on: self list: #methodListNames selected: #methodListIndex changeSelected: #methodListIndex: menu: #messageListMenu:shifted: keystroke: #messageListKey:from:! ! !AnnotationsBrowser methodsFor: 'method list' stamp: 'rhi 1/11/2005 20:04'! methodListNames ^ self methodList collect: [:each | each stringVersion]! ! !AnnotationsBrowser methodsFor: 'method list' stamp: 'rhi 1/10/2005 14:44'! selectedMethod "^ " ^ selectedMethod! ! !AnnotationsBrowser methodsFor: 'method list' stamp: 'rhi 1/10/2005 15:24'! selectedMethod: aMethodReference selectedMethod _ aMethodReference.! ! !AnnotationsBrowser methodsFor: 'method list' stamp: 'rhi 1/11/2005 20:02'! shiftedMessageListMenu: aMenu "Copied from Browser!!" Smalltalk isMorphic ifTrue: [aMenu addStayUpItem]. aMenu addList: #( ('method pane' makeIsolatedCodePane) ('tile scriptor' openSyntaxView) ('toggle diffing (D)' toggleDiffing) ('implementors of sent messages' browseAllMessages) - ('local senders of...' browseLocalSendersOfMessages) ('local implementors of...' browseLocalImplementors) - ('spawn sub-protocol' spawnProtocol) ('spawn full protocol' spawnFullProtocol) - ('sample instance' makeSampleInstance) ('inspect instances' inspectInstances) ('inspect subinstances' inspectSubInstances)). self addExtraShiftedItemsTo: aMenu. aMenu addList: #( - ('change category...' changeCategory)). self canShowMultipleMessageCategories ifTrue: [aMenu addList: #(('show category (C)' showHomeCategory))]. aMenu addList: #( - ('change sets with this method' findMethodInChangeSets) ('revert to previous version' revertToPreviousVersion) ('remove from current change set' removeFromCurrentChanges) ('revert & remove from changes' revertAndForget) ('add to current change set' adoptMessageInCurrentChangeset) ('copy up or copy down...' copyUpOrCopyDown) - ('fetch documentation' fetchDocPane) ('more...' unshiftedYellowButtonActivity)). ^ aMenu! ! !AnnotationsBrowser methodsFor: 'property list' stamp: 'rhi 1/12/2005 11:40'! propertyList ^ self annotations! ! !AnnotationsBrowser methodsFor: 'property list' stamp: 'rhi 1/10/2005 14:40'! propertyListIndex "^ " ^ propertyListIndex! ! !AnnotationsBrowser methodsFor: 'property list' stamp: 'rhi 1/11/2005 15:42'! propertyListIndex: anInteger propertyListIndex _ anInteger. self selectedProperty: (self propertyList at: anInteger ifAbsent: [nil]); valueListIndex: 0; changed: #propertyListIndex; changed: #valueListNames.! ! !AnnotationsBrowser methodsFor: 'property list' stamp: 'rhi 1/11/2005 20:10'! propertyListMorph ^ PluggableListMorph on: self list: #propertyListNames selected: #propertyListIndex changeSelected: #propertyListIndex:! ! !AnnotationsBrowser methodsFor: 'property list' stamp: 'rhi 1/16/2005 00:29'! propertyListNames ^ self propertyList collect: [:each | each printString]! ! !AnnotationsBrowser methodsFor: 'property list' stamp: 'rhi 1/11/2005 15:45'! selectedProperty "^ " ^ selectedProperty! ! !AnnotationsBrowser methodsFor: 'property list' stamp: 'rhi 1/11/2005 15:45'! selectedProperty: aSymbol selectedProperty _ aSymbol.! ! !AnnotationsBrowser methodsFor: 'updating' stamp: 'rhi 1/12/2005 15:13'! update: aSymbol aSymbol == #properties ifTrue: [self initAnnotations]. super update: aSymbol.! ! !AnnotationsBrowser methodsFor: 'updating' stamp: 'rhi 1/12/2005 11:35'! windowIsClosing CompiledMethod removeDependent: self.! ! !AnnotationsBrowser methodsFor: 'value list' stamp: 'rhi 1/11/2005 15:45'! selectedValue "^ " ^ selectedValue! ! !AnnotationsBrowser methodsFor: 'value list' stamp: 'rhi 1/11/2005 15:46'! selectedValue: anObject selectedValue _ anObject.! ! !AnnotationsBrowser methodsFor: 'value list' stamp: 'rhi 1/11/2005 16:25'! valueList | list anno | list _ Set new. self selectedProperty ifNotNil: [ anno _ self annotations detect: [:each | each property = self selectedProperty property]. list addAll: anno values]. ^ list asSortedCollection: [:a :b | a printString <= b printString]! ! !AnnotationsBrowser methodsFor: 'value list' stamp: 'rhi 1/10/2005 14:40'! valueListIndex "^ " ^ valueListIndex! ! !AnnotationsBrowser methodsFor: 'value list' stamp: 'rhi 1/11/2005 14:59'! valueListIndex: anInteger valueListIndex _ anInteger. self selectedValue: (self valueList at: anInteger ifAbsent: [nil]); methodListIndex: 0; changed: #valueListIndex; changed: #methodListNames.! ! !AnnotationsBrowser methodsFor: 'value list' stamp: 'rhi 1/11/2005 20:10'! valueListMorph ^ PluggableListMorph on: self list: #valueListNames selected: #valueListIndex changeSelected: #valueListIndex:! ! !AnnotationsBrowser methodsFor: 'value list' stamp: 'rhi 1/11/2005 20:05'! valueListNames ^ self valueList collect: [:each | each printString]! ! !AnnotationsProperty methodsFor: 'accessing' stamp: 'rhi 1/10/2005 15:52'! methods "^ " ^ methods! ! !AnnotationsProperty methodsFor: 'accessing' stamp: 'rhi 1/10/2005 15:52'! methods: aSet methods _ aSet.! ! !AnnotationsProperty methodsFor: 'accessing' stamp: 'rhi 1/10/2005 15:50'! property "^ " ^ property! ! !AnnotationsProperty methodsFor: 'accessing' stamp: 'rhi 1/10/2005 15:50'! property: aSymbol property _ aSymbol.! ! !AnnotationsProperty methodsFor: 'accessing' stamp: 'rhi 1/10/2005 17:37'! values "^ " ^ values! ! !AnnotationsProperty methodsFor: 'accessing' stamp: 'rhi 1/10/2005 15:52'! values: aSet values _ aSet.! ! !AnnotationsProperty methodsFor: 'initialization' stamp: 'rhi 1/10/2005 16:04'! initialize self values: Set new; methods: Set new.! ! !AnnotationsProperty methodsFor: 'printing' stamp: 'rhi 1/14/2005 23:01'! printOn: aStream self flag: #rhi. "none vs. asString vs. printString" aStream nextPutAll: self property printString, ' (', self values size printString, ', ', self methods size printString, ')'.! ! !Behavior methodsFor: 'private' stamp: 'rhi 1/16/2005 00:09'! removeSelectorSimply: selector "Assuming that the argument, selector (a Symbol), is a message selector in my method dictionary, remove it and its method." | oldMethod | oldMethod _ self methodDict at: selector ifAbsent: [^ self]. self methodDict removeKey: selector. "Now flush Squeak's method cache, either by selector or by method" oldMethod flushCache. selector flushCache. CompiledMethod changed: #properties. CompiledMethod signal: #propertiesChanged.! ! !CAnnotationsBrowser methodsFor: 'accessing' stamp: 'rhi 1/14/2005 11:36'! annotations "Answer the annotations of the receiver" ^self propertyValueAt: #annotations! ! !CAnnotationsBrowser methodsFor: 'accessing' stamp: 'rhi 1/14/2005 11:36'! annotations: aValue "Modify the receiver's annotations" ^self propertyValueAt: #annotations put: aValue with: #annotationsChanged! ! !CAnnotationsBrowser methodsFor: 'accessing' stamp: 'rhi 1/14/2005 18:53'! methodList "Answer the methodList of the receiver" ^self propertyValueAt: #methodList! ! !CAnnotationsBrowser methodsFor: 'accessing' stamp: 'rhi 1/14/2005 18:53'! methodList: aValue "Modify the receiver's methodList" ^self propertyValueAt: #methodList put: aValue with: #methodListChanged! ! !CAnnotationsBrowser methodsFor: 'accessing' stamp: 'rhi 1/14/2005 20:41'! propertyList "Answer the propertyList of the receiver" ^self propertyValueAt: #propertyList! ! !CAnnotationsBrowser methodsFor: 'accessing' stamp: 'rhi 1/14/2005 20:41'! propertyList: aValue "Modify the receiver's propertyList" ^self propertyValueAt: #propertyList put: aValue with: #propertyListChanged! ! !CAnnotationsBrowser methodsFor: 'accessing' stamp: 'rhi 1/14/2005 11:36'! selectedMethod "Answer the selectedMethod of the receiver" ^self propertyValueAt: #selectedMethod! ! !CAnnotationsBrowser methodsFor: 'accessing' stamp: 'rhi 1/14/2005 11:36'! selectedMethod: aValue "Modify the receiver's selectedMethod" ^self propertyValueAt: #selectedMethod put: aValue with: #selectedMethodChanged! ! !CAnnotationsBrowser methodsFor: 'accessing' stamp: 'rhi 1/14/2005 11:36'! selectedProperty "Answer the selectedProperty of the receiver" ^self propertyValueAt: #selectedProperty! ! !CAnnotationsBrowser methodsFor: 'accessing' stamp: 'rhi 1/14/2005 11:36'! selectedProperty: aValue "Modify the receiver's selectedProperty" ^self propertyValueAt: #selectedProperty put: aValue with: #selectedPropertyChanged! ! !CAnnotationsBrowser methodsFor: 'accessing' stamp: 'rhi 1/14/2005 11:36'! selectedValue "Answer the selectedValue of the receiver" ^self propertyValueAt: #selectedValue! ! !CAnnotationsBrowser methodsFor: 'accessing' stamp: 'rhi 1/14/2005 11:36'! selectedValue: aValue "Modify the receiver's selectedValue" ^self propertyValueAt: #selectedValue put: aValue with: #selectedValueChanged! ! !CAnnotationsBrowser methodsFor: 'accessing' stamp: 'rhi 1/14/2005 18:53'! valueList "Answer the valueList of the receiver" ^self propertyValueAt: #valueList! ! !CAnnotationsBrowser methodsFor: 'accessing' stamp: 'rhi 1/14/2005 18:53'! valueList: aValue "Modify the receiver's valueList" ^self propertyValueAt: #valueList put: aValue with: #valueListChanged! ! !CAnnotationsBrowser methodsFor: 'annotations' stamp: 'rhi 1/16/2005 11:05'! onPropertiesChangedInCompiledMethod self initAnnotations.! ! !CAnnotationsBrowser methodsFor: 'annotations' stamp: 'rhi 1/16/2005 11:01'! onWindowCloseRequest self okToChange ifTrue: [window destroy].! ! !CAnnotationsBrowser methodsFor: 'code pane' stamp: 'rhi 1/15/2005 21:36'! codePaneContents ^ selectedMethod ifNil: [String new] ifNotNil: [selectedMethod sourceCode asText makeSelectorBoldIn: (selectedMethod actualClass ifNil:[self])]! ! !CAnnotationsBrowser methodsFor: 'code pane' stamp: 'rhi 1/15/2005 00:50'! onSelectedMethodChanged self signal: #updateCodePane.! ! !CAnnotationsBrowser methodsFor: 'code pane' stamp: 'rhi 1/15/2005 00:51'! onUpdateCodePane codePane contents: self codePaneContents.! ! !CAnnotationsBrowser methodsFor: 'initialize' stamp: 'rhi 1/15/2005 00:31'! initAnnotations | annos | annos _ Set new. self systemNavigation allBehaviorsDo: [:beh | beh methodDict keysAndValuesDo: [:sel :cm | | props | (props _ cm properties) ifNotNil: [ props associationsDo: [:ass | | prop | prop _ (annos detect: [:anno | anno property == ass key] ifNone: [annos add: (AnnotationsProperty new property: ass key)]). prop values add: ass value. prop methods add: (MethodReference class: beh selector: sel)]]]]. annotations _ annos asSortedCollection: [:a :b | a property <= b property].! ! !CAnnotationsBrowser methodsFor: 'initialize' stamp: 'rhi 1/16/2005 11:02'! initialize super initialize. (self define: #propertyList as: CList new) allowDeselect: true. (self define: #valueList as: CList new) allowDeselect: true. (self define: #methodList as: CList new) menu: self methodListMenu; userDataAt: #keyMap put: self methodListKeyMap; allowDeselect: true. self initAnnotations. self flag: #rhi. "Das hier ist nicht so doll. Muesste eigentlich via events funktionieren!!" propertyList contents: annotations.! ! !CAnnotationsBrowser methodsFor: 'initialize' stamp: 'rhi 1/15/2005 22:12'! setupCostume super setupCostume. window extent: 550@350. propertyList costume: CStringListCostume new; color: Color transparent; layoutFrame: (0@0 corner: 0.33@0.45). window add: propertyList. valueList costume: CStringListCostume new; color: Color transparent; layoutFrame: (0.33@0 corner: 0.66@0.45). window add: valueList. methodList costume: CStringListCostume new; color: Color transparent; layoutFrame: (0.66@0 corner: 1@0.45). window add: methodList. codePane layoutFrame: (0@0.45 corner: 1@1). window elements do: [:each | each borderWidth: 2; borderStyle: #complexAltInset; borderColor: Color lightGray; windowColor: Color lightGray]. window color: Color lightGray. self flag: #rhi. "Muss das wirklich sein?" self signal: #annotationsChanged.! ! !CAnnotationsBrowser methodsFor: 'method list' stamp: 'rhi 1/15/2005 22:13'! getMethodList | list | list _ Set new. selectedProperty ifNil: [annotations do: [:each | list addAll: each methods]] ifNotNil: [ selectedValue ifNil: [list addAll: selectedProperty methods] ifNotNil: [selectedProperty methods do: [:mref | ((mref actualClass compiledMethodAt: mref methodSymbol) valueOfProperty: selectedProperty property) = selectedValue ifTrue: [list add: mref]]]]. ^ list asSortedCollection: [:a :b | a stringVersion <= b stringVersion]! ! !CAnnotationsBrowser methodsFor: 'method list' stamp: 'rhi 1/14/2005 20:46'! methodListKeyMap "Copied from CClassBrowser>>messageListKeyMap!!" ^ CKeyboardDispatchTable new addAll: #( ((ctrl b) browseMethodFull) ((ctrl h) browseClassHierarchy) ((ctrl p) browseFullProtocol) ((ctrl o) fileOutMessage) ((cmd c) copySelector) ((cmd n) browseSenders) ((cmd m) browseAllMessages) ((ctrl i) browseMethodHierary) ((ctrl shift n) browseClassRefs) ((ctrl x) removeMessage)); yourself! ! !CAnnotationsBrowser methodsFor: 'method list' stamp: 'rhi 1/14/2005 19:58'! methodListMenu "Copied from CClassBrowser>>messageListMenu!!" | aMenu | aMenu _ CMenu new. aMenu label: 'Messages'. aMenu addList: #( ('browse full (b)' browseMethodFull) ('browse hierarchy (h)' classHierarchy) ('browse method (O)' openSingleMessageBrowser) ('browse protocol (p)' browseFullProtocol) - ('fileOut (o)' fileOutMessage) ('printOut' printOutMessage) ('copy selector (c)' copySelector) - ('senders of... (n)' browseSenders) ('implementors of... (m)' browseImplementors) ('inheritance (i)' browseMethodHierarchy) ('versions (v)' browseMethodVersions) - ('inst var refs...' browseInstVarRefs) ('inst var defs...' browseInstVarDefs) ('class var refs...' browseClassVarRefs) ('class refs (N)' browseClassRefs) - ('remove method (x)' removeMessage)) target: self. ^ aMenu! ! !CAnnotationsBrowser methodsFor: 'method list' stamp: 'rhi 1/15/2005 21:59'! onAnnotationsChanged4MethodList self onSelectedPropertyChanged4MethodList.! ! !CAnnotationsBrowser methodsFor: 'method list' stamp: 'rhi 1/15/2005 22:31'! onChangedInValueList4MethodList self onSelectedValueChanged4MethodList.! ! !CAnnotationsBrowser methodsFor: 'method list' stamp: 'rhi 1/15/2005 22:30'! onCursorChangedInMethodList4MethodList (self okToChangeList: methodList from: self selectedMethod) ifTrue: [selectedMethod _ methodList selection].! ! !CAnnotationsBrowser methodsFor: 'method list' stamp: 'rhi 1/15/2005 21:54'! onSelectedPropertyChanged4MethodList self onSelectedValueChanged4MethodList.! ! !CAnnotationsBrowser methodsFor: 'method list' stamp: 'rhi 1/15/2005 22:10'! onSelectedValueChanged4MethodList methodList contents: self getMethodList.! ! !CAnnotationsBrowser methodsFor: 'method list actions' stamp: 'rhi 1/15/2005 23:12'! browseMethodFull selectedMethod ifNotNil: [ CClassBrowser new selectClass: selectedMethod actualClass selector: selectedMethod methodSymbol; open].! ! !CAnnotationsBrowser methodsFor: 'method list actions' stamp: 'rhi 1/15/2005 23:37'! browseMethodHierarchy | aClass selector aClassNonMeta isMeta list theClassOrMeta | selectedMethod ifNotNil: [ aClass _ selectedMethod actualClass. selector _ selectedMethod methodSymbol. aClassNonMeta _ aClass theNonMetaClass. isMeta _ aClassNonMeta ~~ aClass. list _ OrderedCollection new. aClass allSuperclasses reverseDo: [:cl | (cl includesSelector: selector) ifTrue: [ list addLast: (MethodReference new setStandardClass: cl methodSymbol: selector)]]. aClassNonMeta allSubclassesWithLevelDo: [:cl :level | theClassOrMeta _ isMeta ifTrue: [cl class] ifFalse: [cl]. (theClassOrMeta includesSelector: selector) ifTrue: [ list addLast: (MethodReference new setStandardClass: theClassOrMeta methodSymbol: selector)]] startingLevel: 0. self browseMessageList: list name: 'Inheritance of ' , selector autoSelect: nil].! ! !CAnnotationsBrowser methodsFor: 'method list actions' stamp: 'rhi 1/15/2005 23:42'! browseMethodVersions self cNotYet.! ! !CAnnotationsBrowser methodsFor: 'method list actions' stamp: 'rhi 1/16/2005 00:06'! confirmRemovalOf: aSelector in: aClass "Copied from CClassBrowser>>confirmRemovalOf:in:!!" | count answer allCalls aMenu | allCalls _ self allCallsOn: aSelector. count _ allCalls size. count = 0 ifTrue: [^ true]. count == 1 ifTrue: [ (allCalls first actualClass == aClass and: [allCalls first methodSymbol == aSelector]) ifTrue: [^ true]]. aMenu _ CMenu new. aMenu label: 'This message has ', count, ' sender(s)'. answer _ aMenu chooseFrom: #( ('Remove it' 1) ('Remove, then browse senders' 2) ('Don''t remove, but show me those senders' 3) ('Forget it -- do nothing -- sorry I asked' 4)). answer = 1 ifTrue: [^ true]. answer = 2 ifTrue: [^ nil]. answer = 3 ifTrue: [self browseMessageList: allCalls name: 'Senders of ' , aSelector autoSelect: aSelector keywords first]. ^ false! ! !CAnnotationsBrowser methodsFor: 'method list actions' stamp: 'rhi 1/15/2005 23:20'! copySelector selectedMethod ifNotNil: [ Clipboard clipboardText: selectedMethod methodSymbol asString].! ! !CAnnotationsBrowser methodsFor: 'method list actions' stamp: 'rhi 1/15/2005 23:16'! fileOutMessage selectedMethod ifNotNil: [ Cursor write showWhile: [ selectedMethod actualClass fileOutMethod: selectedMethod methodSymbol]].! ! !CAnnotationsBrowser methodsFor: 'method list actions' stamp: 'rhi 1/15/2005 23:11'! openSingleMessageBrowser selectedMethod ifNotNil: [ self browseMessageList: { selectedMethod. } name: selectedMethod asStringOrText autoSelect: nil].! ! !CAnnotationsBrowser methodsFor: 'method list actions' stamp: 'rhi 1/15/2005 23:40'! printOutMessage selectedMethod ifNotNil: [ Cursor write showWhile: [ selectedMethod actualClass fileOutMethod: selectedMethod methodSymbol asHtml: true]].! ! !CAnnotationsBrowser methodsFor: 'method list actions' stamp: 'rhi 1/16/2005 00:01'! removeMessage | messageName removal | selectedMethod ifNotNil: [ messageName _ selectedMethod methodSymbol. self okToChange ifFalse: [^ self]. removal _ self confirmRemovalOf: messageName in: self selectedClassOrMetaClass. removal ifFalse: [^ self]. self selectedClassOrMetaClass removeSelector: messageName. removal ifNil: [self browseAllCallsOn: messageName]. self onSelectedValueChanged4MethodList].! ! !CAnnotationsBrowser methodsFor: 'method list actions' stamp: 'rhi 1/15/2005 23:27'! selectMessage: label andEvaluate: aBlock | selector method messages msgMenu result | selectedMethod ifNotNil: [ selector _ selectedMethod methodSymbol. method _ selectedMethod compiledMethod. messages _ method messages copyWithout: selector. messages isEmpty ifTrue: [^ aBlock value: selector]. msgMenu _ CMenu new. msgMenu label: (label ifNil: ['Choose message']). result _ msgMenu chooseFromValues: messages default: selector. result ifNotNil: [aBlock value: result]].! ! !CAnnotationsBrowser methodsFor: 'property list' stamp: 'rhi 1/15/2005 22:38'! getPropertyList ^ annotations! ! !CAnnotationsBrowser methodsFor: 'property list' stamp: 'rhi 1/15/2005 22:38'! onAnnotationsChanged4PropertyList propertyList contents: self getPropertyList.! ! !CAnnotationsBrowser methodsFor: 'property list' stamp: 'rhi 1/15/2005 22:23'! onCursorChangedInPropertyList4PropertyList (self okToChangeList: propertyList from: selectedProperty) ifTrue: [selectedProperty _ propertyList selection].! ! !CAnnotationsBrowser methodsFor: 'value list' stamp: 'rhi 1/15/2005 22:35'! getValueList ^ selectedProperty ifNil: [Array new] ifNotNil: [selectedProperty values asSortedCollection: [:a :b | a printString <= b printString]]! ! !CAnnotationsBrowser methodsFor: 'value list' stamp: 'rhi 1/15/2005 22:48'! onChangedInPropertyList4ValueList self onSelectedPropertyChanged4ValueList.! ! !CAnnotationsBrowser methodsFor: 'value list' stamp: 'rhi 1/15/2005 22:27'! onCursorChangedInValueList4ValueList (self okToChangeList: valueList from: selectedValue) ifTrue: [selectedValue _ valueList selection].! ! !CAnnotationsBrowser methodsFor: 'value list' stamp: 'rhi 1/15/2005 22:41'! onSelectedPropertyChanged4ValueList valueList contents: self getValueList.! ! !CAnnotationsBrowser methodsFor: 'private' stamp: 'rhi 1/15/2005 23:49'! selectedClass ^ selectedMethod ifNotNil: [selectedMethod actualClass]! ! !ClassDescription methodsFor: 'compiling' stamp: 'rhi 1/14/2005 21:26'! compile: code notifying: requestor trailer: bytes ifFail: failBlock elseSetSelectorAndNode: selAndNodeBlock "Intercept this message in order to remember system changes. 5/15/96 sw: modified so that if the class does not wish its methods logged in the changes file, then they also won't be accumulated in the current change set. 7/12/96 sw: use wantsChangeSetLogging to determine whether to put in change set" | methodNode selector newMethod priorMethodOrNil | methodNode _ self compilerClass new compile: code in: self notifying: requestor ifFail: failBlock. selector _ methodNode selector. selAndNodeBlock value: selector value: methodNode. requestor ifNotNil: ["Note this change for recent submissions list" Utilities noteMethodSubmission: selector forClass: self]. methodNode encoder requestor: requestor. "Why was this not preserved?" newMethod _ methodNode generate: bytes. priorMethodOrNil _ (self methodDict includesKey: selector) ifTrue: [self compiledMethodAt: selector] ifFalse: [nil]. ChangeSet current noteNewMethod: newMethod forClass: self selector: selector priorMethod: priorMethodOrNil. self addSelector: selector withMethod: newMethod. self flag: #rhi. "Sorry..." CompiledMethod changed: #properties. CompiledMethod signal: #propertiesChanged. ^ newMethod! ! !AnnotationsBrowser class methodsFor: 'instance creation' stamp: 'rhi 1/10/2005 17:31'! new ^ super new initialize! ! !AnnotationsProperty class methodsFor: 'instance creation' stamp: 'rhi 1/10/2005 16:02'! new ^ super new initialize! ! !CAnnotationsBrowser class methodsFor: 'class initialization' stamp: 'rhi 1/14/2005 11:38'! initialize "doIt: [self initialize]" CProjectBuilder registerOpenCommand: { 'Annotations Browser'. { self. #open. }. 'A Method Annotations Browser'. }.! ! !CompiledMethod methodsFor: 'properties' stamp: 'rhi 1/14/2005 20:18'! properties: propDict MethodProperties ifNotNil:[ propDict isEmptyOrNil ifTrue:[MethodProperties removeKey: self ifAbsent:[]] ifFalse:[MethodProperties at: self put: propDict]]. self class changed: #properties. self class signal: #propertiesChanged.! ! !CompiledMethod methodsFor: 'properties' stamp: 'rhi 1/14/2005 20:18'! setProperty: propName toValue: aValue | props | props _ self properties. props ifNil:[ props _ IdentityDictionary new. self properties: props]. props at: propName put: aValue. self class changed: #properties. self class signal: #propertiesChanged.! ! !CompiledMethod class methodsFor: 'class initialization' stamp: 'rhi 1/14/2005 20:18'! initialize "CompiledMethod initialize" "Initialize class variables specifying the size of the temporary frame needed to run instances of me." SmallFrame _ 16. "Context range for temps+stack" LargeFrame _ 56. MethodProperties ifNil:[MethodProperties _ WeakIdentityKeyDictionary new]. self changed: #properties. self signal: #propertiesChanged. Smalltalk addToShutDownList: self.! ! !TheWorldMenu methodsFor: 'commands' stamp: 'rhi 1/16/2005 00:15'! openAnnotationsBrowser AnnotationsBrowser new openAsMorph.! ! !TheWorldMenu methodsFor: 'construction' stamp: 'rhi 1/16/2005 09:04'! openMenu "Build the open window menu for the world." | menu | menu _ self menu: 'open...'. self fillIn: menu from: { {'browser (b)' . { self . #openBrowser}. 'A five-paned tool that lets you see all the code in the system'}. {'package-pane browser' . { PackagePaneBrowser . #openBrowser} . 'Similar to the regular browser, but adds an extra pane at top-left that groups class-categories that start with the same prefix' }. {'workspace (k)' . {self . #openWorkspace}. 'A window for composing text' }. {'file list' . {self . #openFileList} . 'A tool allowing you to browse any file' }. {'file...' . { FileList . #openFileDirectly} . 'Lets you open a window on a single file'}. {'transcript (t)' . {self . #openTranscript}. 'A window used to report messages sent to Transcript' }. {'annotations browser' . { self . #openAnnotationsBrowser}. 'A tool that lets you navigate all method annotations in the system'}. "{'inner world' . { WorldWindow . #test1} }." nil. {'method finder' . { self . #openSelectorBrowser} . 'A tool for discovering methods' }. {'message names (W)' . { self . #openMessageNames} . 'A tool for finding and editing methods that contain any given keyword in their names.'}. nil. {'simple change sorter' . {self . #openChangeSorter1} . 'A tool allowing you to view the methods in a single change set' }. {'dual change sorter' . {self . #openChangeSorter2} . 'A tool allowing you to compare and manipulate two change sets concurrently' }. nil. }. self fillIn: menu from: self class registeredOpenCommands. menu addLine. self mvcProjectsAllowed ifTrue: [self fillIn: menu from: { {'mvc project' . {self. #openMVCProject} . 'Creates a new project of the classic "mvc" style'} }]. ^ self fillIn: menu from: { {'morphic project' . {self. #openMorphicProject} . 'Creates a new morphic project'}. }.! ! CompiledMethod initialize! CAnnotationsBrowser initialize! !CAnnotationsBrowser reorganize! ('accessing' annotations annotations: methodList methodList: propertyList propertyList: selectedMethod selectedMethod: selectedProperty selectedProperty: selectedValue selectedValue: valueList valueList:) ('annotations' onPropertiesChangedInCompiledMethod onWindowCloseRequest) ('code pane' codePaneContents onSelectedMethodChanged onUpdateCodePane) ('initialize' initAnnotations initialize setupCostume) ('method list' getMethodList methodListKeyMap methodListMenu onAnnotationsChanged4MethodList onChangedInValueList4MethodList onCursorChangedInMethodList4MethodList onSelectedPropertyChanged4MethodList onSelectedValueChanged4MethodList) ('method list actions' browseMethodFull browseMethodHierarchy browseMethodVersions confirmRemovalOf:in: copySelector fileOutMessage openSingleMessageBrowser printOutMessage removeMessage selectMessage:andEvaluate:) ('property list' getPropertyList onAnnotationsChanged4PropertyList onCursorChangedInPropertyList4PropertyList) ('value list' getValueList onChangedInPropertyList4ValueList onCursorChangedInValueList4ValueList onSelectedPropertyChanged4ValueList) ('private' selectedClass) ! !AnnotationsBrowser reorganize! ('accessing' annotations annotations:) ('code pane' contents:notifying: selectedClass selectedClassOrMetaClass selectedMessageName updateCurrentCompiledMethod) ('initialization' initAnnotations initialize) ('interface opening' openAsMorph) ('method list' addExtraShiftedItemsTo: messageListMenu:shifted: methodList methodListIndex methodListIndex: methodListMorph methodListNames selectedMethod selectedMethod: shiftedMessageListMenu:) ('property list' propertyList propertyListIndex propertyListIndex: propertyListMorph propertyListNames selectedProperty selectedProperty:) ('updating' update: windowIsClosing) ('value list' selectedValue selectedValue: valueList valueListIndex valueListIndex: valueListMorph valueListNames) !