[Pkg] The Trunk: Tools-fbs.360.mcz
commits at source.squeak.org
commits at source.squeak.org
Mon 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 Packages
mailing list