[squeak-dev] The Trunk: Tools-fbs.360.mczcommits at source.squeak.org commits at source.squeak.orgMon Jun 13 10:04:53 UTC 2011
Levente Uzonyi uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-fbs.360.mcz ==================== Summary ==================== Name: Tools-fbs.360 Author: fbs Time: 8 June 2011, 12:48:19.403 pm UUID: c15abbe6-2529-4471-9c0d-d854df1cddfb Ancestors: Tools-ul.359 Make MessageSet subclass CodeHolder, not Browser. Rationale: MessageSet uses nothing but a tiny subset of Browser. All existing tests pass, but we have poor code coverage. I've banged on it a fair bit, but this needs extra checking (ideally in the form of more tests!) =============== Diff against Tools-ul.359 =============== Item was added: + ----- Method: MessageNames>>topConstantHeightFrame:fromLeft:width: (in category 'as yet unclassified') ----- + topConstantHeightFrame: height fromLeft: leftFraction width: rightFraction + ^LayoutFrame new + topFraction: 0 offset: 0; + leftFraction: leftFraction offset: 0; + rightFraction: (leftFraction + rightFraction) offset: 0; + bottomFraction: 0 offset: height; + yourself.! Item was changed: + CodeHolder subclass: #MessageSet + instanceVariableNames: 'growable messageList autoSelectString messageListIndex editSelection' - Browser subclass: #MessageSet - instanceVariableNames: 'growable messageList autoSelectString messageListIndex' classVariableNames: '' poolDictionaries: '' category: 'Tools-Browser'! !MessageSet commentStamp: '<historical>' prior: 0! I represent a query path of the retrieval result of making a query about methods in the system. The result is a set of methods, denoted by a message selector and the class in which the method was found. As a StringHolder, the string I represent is the source code of the currently selected method. I am typically viewed in a Message Set Browser consisting of a MessageListView and a BrowserCodeView.! Item was added: + ----- Method: MessageSet>>buildMessageListWith: (in category 'toolbuilder') ----- + buildMessageListWith: builder + | listSpec | + listSpec := builder pluggableListSpec new. + listSpec + model: self; + list: #messageList; + getIndex: #messageListIndex; + setIndex: #messageListIndex:; + menu: #messageListMenu:shifted:; + keyPress: #messageListKey:from:. + Preferences browseWithDragNDrop + ifTrue:[listSpec dragItem: #dragFromMessageList:]. + ^listSpec + ! Item was removed: - ----- Method: MessageSet>>compileMessage:notifying: (in category 'as yet unclassified') ----- - compileMessage: aText notifying: aController - "Compile the code that was accepted by the user, placing the compiled method into an appropriate message category. Return true if the compilation succeeded, else false." - "Copied from Browser's version of sd 11/20/2005 21:26 because later versions remove messageListIndex." - - | fallBackCategoryName fallBackMethodIndex originalSelectorName result | - - self selectedMessageCategoryName ifNil: - [ self selectOriginalCategoryForCurrentMethod - ifFalse:["Select the '--all--' category" - self messageCategoryListIndex: 1]]. - - - self selectedMessageCategoryName asSymbol = ClassOrganizer allCategory - ifTrue: - [ "User tried to save a method while the ALL category was selected" - fallBackCategoryName := selectedMessageCategoryName. - fallBackMethodIndex := messageListIndex. - editSelection == #newMessage - ifTrue: - [ "Select the 'as yet unclassified' category" - selectedMessageCategoryName := nil. - (result := self defineMessageFrom: aText notifying: aController) - ifNil: - ["Compilation failure: reselect the original category & method" - selectedMessageCategoryName := fallBackCategoryName. - messageListIndex := fallBackMethodIndex] - ifNotNil: - [self setSelector: result]] - ifFalse: - [originalSelectorName := self selectedMessageName. - self setOriginalCategoryIndexForCurrentMethod. - messageListIndex := fallBackMethodIndex := self messageList indexOf: originalSelectorName. - (result := self defineMessageFrom: aText notifying: aController) - ifNotNil: - [self setSelector: result] - ifNil: - [ "Compilation failure: reselect the original category & method" - selectedMessageCategoryName := fallBackCategoryName. - messageListIndex := fallBackMethodIndex. - ^ result notNil]]. - self changed: #messageCategoryList. - ^ result notNil] - ifFalse: - [ "User tried to save a method while the ALL category was NOT selected" - ^ (self defineMessageFrom: aText notifying: aController) notNil]! Item was added: + ----- Method: MessageSet>>dragFromMessageList: (in category 'drag and drop') ----- + dragFromMessageList: index + "Drag a method from the browser" + ^self selectedClassOrMetaClass compiledMethodAt: (self messageList at: index) ifAbsent:[nil]! Item was added: + ----- Method: MessageSet>>editSelection: (in category 'accessing') ----- + editSelection: aSelection + "Set the editSelection as requested." + + editSelection := aSelection. + self changed: #editSelection.! Item was changed: ----- Method: MessageSet>>fileOutMessage (in category 'message functions') ----- fileOutMessage "Put a description of the selected method on a file, or all methods if none selected." | fileName | self selectedMessageName ifNotNil: [^super fileOutMessage]. + fileName := self request: 'File out on which file?' initialAnswer: 'methods'. - fileName := UIManager default request: 'File out on which file?' initialAnswer: 'methods'. Cursor write showWhile: [| internalStream | internalStream := WriteStream on: (String new: 1000). internalStream header; timeStamp. messageList do: [:methodRef| methodRef actualClass printMethodChunk: methodRef methodSymbol withPreamble: true on: internalStream moveSource: false toFile: nil]. FileStream writeSourceCodeFrom: internalStream baseName: fileName isSt: true useHtml: false]! Item was changed: ----- Method: MessageSet>>filterToImplementorsOf (in category 'filtering') ----- filterToImplementorsOf "Filter the receiver's list down to only those items with a given selector" | aFragment inputWithBlanksTrimmed | + aFragment := self request: 'type selector:' initialAnswer: ''. - aFragment := UIManager default request: 'type selector:' initialAnswer: ''. aFragment isEmptyOrNil ifTrue: [^ self]. inputWithBlanksTrimmed := aFragment withBlanksTrimmed. Symbol hasInterned: inputWithBlanksTrimmed ifTrue: [:aSymbol | self filterFrom: [:aClass :aSelector | aSelector == aSymbol]]! Item was changed: ----- Method: MessageSet>>filterToNotImplementorsOf (in category 'filtering') ----- filterToNotImplementorsOf "Filter the receiver's list down to only those items whose selector is NOT one solicited from the user." | aFragment inputWithBlanksTrimmed | + aFragment := self request: 'type selector: ' initialAnswer: ''. - aFragment := UIManager default request: 'type selector: ' initialAnswer: ''. aFragment isEmptyOrNil ifTrue: [^ self]. inputWithBlanksTrimmed := aFragment withBlanksTrimmed. Symbol hasInterned: inputWithBlanksTrimmed ifTrue: [:aSymbol | self filterFrom: [:aClass :aSelector | aSelector ~~ aSymbol]]! Item was changed: ----- Method: MessageSet>>filterToNotSendersOf (in category 'filtering') ----- filterToNotSendersOf "Filter the receiver's list down to only those items which do not send a given selector" | aFragment inputWithBlanksTrimmed | + aFragment := self request: 'type selector:' initialAnswer: ''. - aFragment := UIManager default request: 'type selector:' initialAnswer: ''. aFragment isEmptyOrNil ifTrue: [^ self]. inputWithBlanksTrimmed := aFragment withBlanksTrimmed. Symbol hasInterned: inputWithBlanksTrimmed ifTrue: [:aSymbol | self filterFrom: [:aClass :aSelector | | aMethod | (aMethod := aClass compiledMethodAt: aSelector) isNil or: [(aMethod hasLiteralThorough: aSymbol) not]]]! Item was changed: ----- Method: MessageSet>>filterToSendersOf (in category 'filtering') ----- filterToSendersOf "Filter the receiver's list down to only those items which send a given selector" | aFragment inputWithBlanksTrimmed | + aFragment := self request: 'type selector:' initialAnswer: ''. - aFragment := UIManager default request: 'type selector:' initialAnswer: ''. aFragment isEmptyOrNil ifTrue: [^ self]. inputWithBlanksTrimmed := aFragment withBlanksTrimmed. Symbol hasInterned: inputWithBlanksTrimmed ifTrue: [:aSymbol | self filterFrom: [:aClass :aSelector | | aMethod | (aMethod := aClass compiledMethodAt: aSelector) notNil and: [aMethod hasLiteralThorough: aSymbol]]] ! Item was changed: ----- Method: MessageSet>>initializeMessageList: (in category 'private') ----- initializeMessageList: anArray "Initialize my messageList from the given list of MethodReference or string objects. NB: special handling for uniclasses." messageList := OrderedCollection new. anArray do: [ :each | MessageSet parse: each toClassAndSelector: [ :class :sel | | s | class ifNotNil: [class isUniClass ifTrue: [s := class typicalInstanceName, ' ', sel] ifFalse: [s := class name , ' ' , sel , ' {' , ((class organization categoryOfElement: sel) ifNil: ['']) , '}']. messageList add: ( MethodReference new setClass: class methodSymbol: sel stringVersion: s)]]]. messageListIndex := messageList isEmpty ifTrue: [0] ifFalse: [1]. - selectedMessageName := messageList isEmpty ifTrue: [nil] ifFalse: [messageList first selector]. contents := ''! Item was added: + ----- Method: MessageSet>>messageListMenu:shifted: (in category 'message functions') ----- + messageListMenu: aMenu shifted: shifted + "Answer the message-list menu" + self + menuHook: aMenu + named: #messageListMenu + shifted: shifted. + Preferences useOnlyServicesInMenu ifTrue:[^aMenu]. + shifted ifTrue: [^ self shiftedMessageListMenu: aMenu]. + aMenu addList: #( + ('what to show...' offerWhatToShowMenu) + ('toggle break on entry' toggleBreakOnEntry) + - + ('browse full (b)' browseMethodFull) + ('browse hierarchy (h)' classHierarchy) + ('browse method (O)' openSingleMessageBrowser) + ('browse protocol (p)' browseFullProtocol) + - + ('fileOut' fileOutMessage) + ('printOut' printOutMessage) + ('copy selector (c)' copySelector) + ('copy reference' copyReference) + - + ('senders of... (n)' browseSendersOfMessages) + ('implementors of... (m)' browseMessages) + ('inheritance (i)' methodHierarchy) + ('versions (v)' browseVersions) + - + ('references... (r)' browseVariableReferences) + ('assignments... (a)' browseVariableAssignments) + ('class refs (N)' browseClassRefs) + - + ('remove method (x)' removeMessage) + ('explore method' exploreMethod) + ('inspect method' inspectMethod) + - + ('more...' shiftedYellowButtonActivity)). + ^ aMenu! Item was added: + ----- Method: MessageSet>>request:initialAnswer: (in category 'as yet unclassified') ----- + request: prompt initialAnswer: initialAnswer + + ^ UIManager default + request: prompt + initialAnswer: initialAnswer! Item was removed: - ----- Method: MessageSet>>selectMessageNamed: (in category 'message list') ----- - selectMessageNamed: aSymbolOrString - super selectMessageNamed: aSymbolOrString. - - contents := - selectedMessageName notNil - ifTrue: [self selectedMessage] - ifFalse: ['']. - self changed: #messageListIndex. "update my selection" - self editSelection: #editMessage. - self contentsChanged. - (selectedMessageName notNil and: [ autoSelectString notNil and: [ self contents notEmpty ] ]) ifTrue: [ self changed: #autoSelect ]. - self decorateButtons! Item was added: + ----- Method: MessageSet>>shiftedMessageListMenu: (in category 'message functions') ----- + shiftedMessageListMenu: aMenu + "Fill aMenu with the items appropriate when the shift key is held down" + + aMenu addStayUpItem. + aMenu addList: #( + ('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) + - + ('more...' unshiftedYellowButtonActivity)). + ^ aMenu + ! Item was changed: + ----- Method: MessageSet>>systemOrganizer: (in category 'initialize-release') ----- - ----- Method: MessageSet>>systemOrganizer: (in category 'as yet unclassified') ----- systemOrganizer: aSystemOrganizer messageListIndex := 0. ^ super systemOrganizer: aSystemOrganizer.! Item was changed: + ----- Method: MessageSet>>veryDeepInner: (in category 'copying') ----- - ----- Method: MessageSet>>veryDeepInner: (in category 'as yet unclassified') ----- veryDeepInner: deepCopier "Copy all of my instance variables. Some need to be not copied at all, but shared. See DeepCopier class comment." super veryDeepInner: deepCopier. + messageListIndex := messageListIndex veryDeepCopyWith: deepCopier. + editSelection := editSelection veryDeepCopyWith: deepCopier.! - messageListIndex := messageListIndex veryDeepCopyWith: deepCopier.! Item was changed: ----- Method: TimeProfileBrowser>>initializeMessageList: (in category 'private') ----- initializeMessageList: anArray messageList := anArray. messageListIndex := 0. - selectedMessageName := nil. contents := ''!
More information about the Squeak-dev mailing list |