Squeak-dev March 2010

squeak-dev@lists.squeakfoundation.org

158 participants
767 discussions

Re: [squeak-dev] The Trunk: System-cmm.275.mcz
by Nicolas Cellier 03 Mar '10

03 Mar '10

Hi Chris Did you notice new pattern for creating preferences ? We prefer a method annotation (pragme) because it will prevent Preferences to be bloated. like TextDiffBuilder>>ignoreLineEndings "Answer a boolean telling if line endings differences should be ignored or emphasized" <preference: 'ignoreLineEndings' category: 'TextDiff' description: 'When enabled, source code differences in line endings will be ignored.' type: #Boolean> ^IgnoreLineEndings ifNil: [ false ] Cheers Nicolas 2010/3/3 <commits(a)source.squeak.org>: > Chris Muller uploaded a new version of System to project The Trunk: > http://source.squeak.org/trunk/System-cmm.275.mcz > > ==================== Summary ==================== > > Name: System-cmm.275 > Author: cmm > Time: 2 March 2010, 9:48:35.173 pm > UUID: 2f46dbd4-b790-41cc-b8c4-76d1b7eb1b15 > Ancestors: System-cmm.274 > > Added #traceMessages preference. > > =============== Diff against System-cmm.274 =============== > > Item was added: > + ----- Method: Preferences class>>traceMessages (in category 'standard queries') ----- > + traceMessages > + ^ self > + valueOfFlag: #traceMessages > + ifAbsent: [ false ]! > > >

2 3

Analyzing message sent to Smalltalk in trunk for plan B
by Nicolas Cellier 03 Mar '10

03 Mar '10

If we want to rename SystemDictionary: SystemNavigation default allCallsOn: (Smalltalk associationAt: #SystemDictionary) -> SystemDictionary >> majorShrink SystemDictionary >> discardOddsAndEnds ReleaseBuilderFor3dot11 >> cleanupPhasePrepare They all call (SystemDictionary removeSelector: xxx) Which message is sent to Smalltalk ? (not counting messages sent to self class environment) As usage is huge, I do not reproduce here. An analyzer utility is provided attached Use with: MessageSentToGlobalFinder testMessagesSentToSmalltalk to come next: analyze of messages sent to (SmalltalkImage current) Nicolas

1 1

The Trunk: ToolBuilder-Morphic-cmm.51.mcz
by commits＠source.squeak.org 03 Mar '10

03 Mar '10

Chris Muller uploaded a new version of ToolBuilder-Morphic to project The Trunk: http://source.squeak.org/trunk/ToolBuilder-Morphic-cmm.51.mcz ==================== Summary ==================== Name: ToolBuilder-Morphic-cmm.51 Author: cmm Time: 2 March 2010, 5:37:09.731 pm UUID: 82f96d6d-4a31-44ea-ae92-305f02152b5b Ancestors: ToolBuilder-Morphic-dtl.50 - Support for newly introduced AlternatePluggableListMorphOfMany. =============== Diff against ToolBuilder-Morphic-dtl.50 =============== Item was added: + ----- Method: MorphicToolBuilder>>buildPluggableAlternateMultiSelectionList: (in category 'pluggable widgets') ----- + buildPluggableAlternateMultiSelectionList: aSpec + | listMorph listClass | + aSpec getSelected ifNotNil: [ ^ self error: 'There is no PluggableAlternateListMorphOfManyByItem' ]. + listClass := self alternateMultiSelectListClass. + listMorph := listClass + on: aSpec model + list: aSpec list + primarySelection: aSpec getIndex + changePrimarySelection: aSpec setIndex + listSelection: aSpec getSelectionList + changeListSelection: aSpec setSelectionList + menu: aSpec menu. + listMorph + setProperty: #highlightSelector toValue: #highlightMessageList:with: ; + setProperty: #itemConversionMethod toValue: #asStringOrText ; + setProperty: #balloonTextSelectorForSubMorphs toValue: #balloonTextForClassAndMethodString ; + enableDragNDrop: Preferences browseWithDragNDrop ; + menuTitleSelector: #messageListSelectorTitle. + self + register: listMorph + id: aSpec name. + listMorph + keystrokeActionSelector: aSpec keyPress ; + getListElementSelector: aSpec listItem ; + getListSizeSelector: aSpec listSize. + self + buildHelpFor: listMorph + spec: aSpec. + self + setFrame: aSpec frame + in: listMorph. + parent ifNotNil: [ self add: listMorph to: parent ]. + panes ifNotNil: [ aSpec list ifNotNil:[panes add: aSpec list ] ]. + ^ listMorph! Item was added: + ----- Method: MorphicToolBuilder>>alternateMultiSelectListClass (in category 'widget classes') ----- + alternateMultiSelectListClass + ^ AlternatePluggableListMorphOfMany !

1 0

The Trunk: ToolBuilder-Kernel-cmm.32.mcz
by commits＠source.squeak.org 03 Mar '10

03 Mar '10

Chris Muller uploaded a new version of ToolBuilder-Kernel to project The Trunk: http://source.squeak.org/trunk/ToolBuilder-Kernel-cmm.32.mcz ==================== Summary ==================== Name: ToolBuilder-Kernel-cmm.32 Author: cmm Time: 2 March 2010, 5:38:33.25 pm UUID: 6fcc688b-054c-499a-a77c-63d7aa2ad763 Ancestors: ToolBuilder-Kernel-dtl.31 - Support for newly introduced AlternatePluggableListMorphOfMany. =============== Diff against ToolBuilder-Kernel-dtl.31 =============== Item was added: + PluggableMultiSelectionListSpec subclass: #PluggableAlternateMultiSelectionListSpec + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'ToolBuilder-Kernel'! Item was added: + ----- Method: ToolBuilder>>pluggableAlternateMultiSelectionListSpec (in category 'defaults') ----- + pluggableAlternateMultiSelectionListSpec + ^ PluggableAlternateMultiSelectionListSpec! Item was added: + ----- Method: PluggableAlternateMultiSelectionListSpec>>buildWith: (in category 'building') ----- + buildWith: builder + ^ builder buildPluggableAlternateMultiSelectionList: self!

1 0

The Trunk: System-cmm.275.mcz
by commits＠source.squeak.org 03 Mar '10

03 Mar '10

Chris Muller uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-cmm.275.mcz ==================== Summary ==================== Name: System-cmm.275 Author: cmm Time: 2 March 2010, 9:48:35.173 pm UUID: 2f46dbd4-b790-41cc-b8c4-76d1b7eb1b15 Ancestors: System-cmm.274 Added #traceMessages preference. =============== Diff against System-cmm.274 =============== Item was added: + ----- Method: Preferences class>>traceMessages (in category 'standard queries') ----- + traceMessages + ^ self + valueOfFlag: #traceMessages + ifAbsent: [ false ]!

1 0

The Trunk: Tools-cmm.200.mcz
by commits＠source.squeak.org 03 Mar '10

03 Mar '10

Chris Muller uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-cmm.200.mcz ==================== Summary ==================== Name: Tools-cmm.200 Author: cmm Time: 3 March 2010, 3:19:31.384 pm UUID: 15f209c2-7198-400d-b14b-e1de0a623f18 Ancestors: Tools-cmm.199, Tools-laza.199 - MessageTrace, a new subclass of MessageSet, presents message flow via a succint hierarchy. To turn it on, enable the preference #traceMessages. =============== Diff against Tools-laza.199 =============== Item was added: + ----- Method: MessageTrace>>getImplementorNamed: (in category 'private accessing') ----- + getImplementorNamed: selectorSymbol + | allPossibilities | + allPossibilities := (((self selection compiledMethod messages + select: [ :eachSelector | eachSelector beginsWith: selectorSymbol ]) + copyWith: selectorSymbol) + select: [ :each | Symbol hasInterned: each ifTrue: [ :s | ] ]) + asSet asSortedCollection asOrderedCollection. + (allPossibilities includes: selectorSymbol) ifTrue: + [ allPossibilities addFirst: (allPossibilities remove: selectorSymbol) ]. + ^allPossibilities size > 1 + ifTrue: + [ | selectionIndex | + selectionIndex := (PopUpMenu labelArray: allPossibilities lines: #(1)) + startUpWithCaption: + 'Browse implementors of + which message?'. + selectionIndex = 0 ifTrue: [ selectorSymbol ] ifFalse: [ allPossibilities at: selectionIndex ] ] + ifFalse: [ allPossibilities isEmpty + ifTrue: [ selectorSymbol ] + ifFalse: [ allPossibilities first ] ] + ! Item was changed: ----- Method: MessageSet>>messageListIndex: (in category 'message list') ----- messageListIndex: anInteger "Set the index of the selected item to be anInteger." messageListIndex := anInteger. contents := messageListIndex ~= 0 ifTrue: [self selectedMessage] ifFalse: ['']. self changed: #messageListIndex. "update my selection" self editSelection: #editMessage. self contentsChanged. + (messageListIndex ~= 0 and: [ autoSelectString notNil and: [ self contents notEmpty ] ]) ifTrue: [ self changed: #autoSelect ]. - (messageListIndex ~= 0 and: [autoSelectString notNil]) - ifTrue: [self changed: #autoSelect]. self decorateButtons ! Item was added: + ----- Method: MessageSet>>browseAllImplementorsOf: (in category 'message functions') ----- + browseAllImplementorsOf: selectorSymbol + self systemNavigation browseAllImplementorsOf: selectorSymbol! Item was added: + ----- Method: MessageTrace>>addChildMethodsNamed: (in category 'building') ----- + addChildMethodsNamed: selectorSymbol + + | methodsReferences | + + messageListIndex = 0 + ifTrue: + [ ^(PopUpMenu labels: ' OK ') + startUpWithCaption: 'Please reselect a method.' ]. + (methodsReferences := self filteredSelectorsNamed: selectorSymbol) isEmpty + ifTrue: + [ ^(PopUpMenu labels: ' OK ') + startUpWithCaption: 'There are no methods named ', selectorSymbol ] + ifFalse: + [ self + addChildMessages: methodsReferences + autoSelectString: selectorSymbol ] + ! Item was added: + ----- Method: MessageTrace>>deleteFromMessageList: (in category 'building') ----- + deleteFromMessageList: aMethodReference + "Delete the given message from the receiver's message list" + + | index | + autoSelectStrings removeAt: (index := messageList indexOf: aMethodReference). + messageSelections removeAt: index. + super deleteFromMessageList: aMethodReference. + anchorIndex ifNotNil: + [ anchorIndex := anchorIndex min: messageList size ] + ! Item was added: + ----- Method: MessageTrace>>noteSelectionIndex:for: (in category 'accessing') ----- + noteSelectionIndex: anInteger for: aSymbol + aSymbol == #messageList + ifTrue: + [ messageListIndex := anInteger. + self + messageAt: messageListIndex + beSelected: true ]. + super + noteSelectionIndex: anInteger + for: aSymbol! Item was added: + ----- Method: MessageTrace>>toggleMessageSelectionAt: (in category 'private actions') ----- + toggleMessageSelectionAt: anInteger + + messageSelections + at: anInteger + put: (messageSelections at: anInteger) not + ! Item was added: + ----- Method: MessageTrace>>browseAllCallsOn: (in category 'actions') ----- + browseAllCallsOn: selectorSymbol + (self hasUnacceptedEdits or: [ Preferences traceMessages not ]) + ifTrue: [ super browseAllCallsOn: selectorSymbol ] + ifFalse: [ self addParentMethodsSending: selectorSymbol ]! Item was added: + ----- Method: MessageTrace>>windowLabelAt: (in category 'private accessing') ----- + windowLabelAt: anInteger + + | str | + ^(str := autoSelectStrings at: anInteger) + ifNil: + [ 'Implementors of ', + (self class + parse: self selection + toClassAndSelector: [ :class :selector | selector ]) ] + ifNotNil: + [ 'Senders of ', str ] + ! Item was added: + ----- Method: MessageTrace>>indentionPrefixOfSize: (in category 'indenting') ----- + indentionPrefixOfSize: levelInteger + + | answer | + answer := String new: levelInteger * self indentionSize. + answer atAllPut: $ . "space" + ^answer + ! Item was added: + ----- Method: MessageTrace>>addChildMessages:autoSelectString: (in category 'building') ----- + addChildMessages: methodReferences autoSelectString: aString + | currentIndentionLevel addables selectables selectableString | + selectableString := aString keywords + ifEmpty: [ String empty ] + ifNotEmptyDo: [ : keywords | keywords first ]. + [ (messageListIndex between: 1 and: autoSelectStrings size) ] + whileFalse: + [ autoSelectStrings add: selectableString ]. + autoSelectStrings + at: messageListIndex + put: selectableString. + currentIndentionLevel := self indentionsIn: self selection asStringOrText. + "Don't add mulitple copies of the same method, if a method is already in the list we will merely select it." + addables := methodReferences reject: [ : each | messageList includes: each ]. + addables do: + [ : each | + each stringVersion: (self indentionPrefixOfSize: currentIndentionLevel + 1) , each asStringOrText. + messageList + add: each + afterIndex: self messageListIndex. + autoSelectStrings + add: nil + afterIndex: self messageListIndex. + messageSelections + add: false + afterIndex: self messageListIndex ]. + selectables := + addables copy + addAll: (methodReferences select: [ : each | messageList includes: each ]) ; + yourself. + self deselectAll. + selectables do: + [ : each | + self + messageAt: (messageList indexOf: each) + beSelected: true ]. + self changed: #messageList. + "Select the first child method." + self messageListIndex: + (selectables size > 0 + ifTrue: [ messageList indexOf: selectables last ] + ifFalse: [ messageList ifEmpty: [ 0 ] ifNotEmpty: [ 1 ] ])! Item was added: + ----- Method: MessageTrace>>isMessageSelectedAt: (in category 'testing') ----- + isMessageSelectedAt: anInteger + + ^messageSelections at: anInteger ifAbsent: [ false ]! Item was added: + ----- Method: MessageTrace>>filteredSelectorsNamed: (in category 'filtering') ----- + filteredSelectorsNamed: selectorSymbol + + ^SystemNavigation new allImplementorsOf: selectorSymbol + ! Item was added: + ----- Method: Object>>browseAllImplementorsOf: (in category '*Tools-MessageSets') ----- + browseAllImplementorsOf: selectorSymbol + "Models get first chance to handle browseAllImplementorsOf:, so a tracing-messages browser can be built.. Not all Tool 'models' inherit from Model, otherwise this would be there." + self systemNavigation browseAllImplementorsOf: selectorSymbol! Item was added: + ----- Method: MessageTrace>>autoSelectString: (in category 'building') ----- + autoSelectString: aString + + super autoSelectString: aString. + autoSelectStrings := messageList collect: [ :each | aString ] + ! Item was added: + ----- Method: MessageTrace>>initialize (in category 'private initializing') ----- + initialize + + super initialize. + messageSelections := OrderedCollection new. + autoSelectStrings := OrderedCollection new + ! Item was changed: ----- Method: MessageSet>>reformulateList (in category 'message functions') ----- reformulateList "The receiver's messageList has been changed; rebuild it" - super reformulateList. - self initializeMessageList: messageList. self changed: #messageList. self changed: #messageListIndex. + self contentsChanged! - self contentsChanged - ! Item was added: + ----- Method: MessageTrace>>browseAllImplementorsOf: (in category 'actions') ----- + browseAllImplementorsOf: selectorSymbol + | selectorToBrowse | + selectorToBrowse := self selection + ifNil: [ selectorSymbol ] + ifNotNil: [ self getImplementorNamed: selectorSymbol ]. + (self hasUnacceptedEdits or: [ Preferences traceMessages not ]) + ifTrue: [ super browseAllImplementorsOf: selectorToBrowse ] + ifFalse: [ self addChildMethodsNamed: selectorToBrowse ] + ! Item was changed: ----- Method: ChangeSorter>>methodConflictsWithOtherSide (in category 'changeSet menu') ----- methodConflictsWithOtherSide "Check to see if the change set on the other side shares any methods with the selected change set; if so, open a browser on all such." | aList other | self checkThatSidesDiffer: [^ self]. other := (parent other: self) changeSet. aList := myChangeSet messageListForChangesWhich: [ :aClass :aSelector | aClass notNil and: [(other methodChangesAtClass: aClass name) includesKey: aSelector] ] ifNone: [^ self inform: 'There are no methods that appear both in this change set and in the one on the other side.']. + ToolSet + browseMessageSet: aList - MessageSet - openMessageList: aList name: 'Methods in "', myChangeSet name, '" that are also in ', other name,' (', aList size printString, ')' + autoSelect: nil! - ! Item was added: + ----- Method: MessageTrace classSide>>initialize (in category 'initializing') ----- + initialize + + self setUpPreferencesPanel! Item was added: + ----- Method: MessageTrace>>buildMessageListWith: (in category 'private initializing') ----- + buildMessageListWith: builder + | listSpec | + listSpec := builder pluggableAlternateMultiSelectionListSpec new. + listSpec + model: self ; + list: #messageList ; + getIndex: #messageListIndex ; + setIndex: #toggleSelectionAt:shifted:controlled: ; + menu: #messageListMenu:shifted: ; + getSelectionList: #isMessageSelectedAt: ; + setSelectionList: #messageAt:beSelected: ; + keyPress: #messageListKey:from:. + Preferences browseWithDragNDrop + ifTrue: [ listSpec dragItem: #dragFromMessageList: ]. + ^ listSpec! Item was added: + ----- Method: MessageTrace>>filterFrom: (in category 'filtering') ----- + filterFrom: aBlock + "Filter the receiver's list down to only those items that satisfy aBlock, which takes a class an a selector as its arguments." + + | newList newAutoSelectStrings newMessageSelections | + newList := messageList class new. + newAutoSelectStrings := autoSelectStrings class new. + newMessageSelections := messageSelections class new. + messageList withIndexDo: + [ :each :index | + (self class parse: each toClassAndSelector: aBlock) + ifTrue: + [ newList add: each. + newAutoSelectStrings add: (autoSelectStrings at: index). + newMessageSelections add: (messageSelections at: index) ] ]. + autoSelectStrings := newAutoSelectStrings. + self setFilteredList: newList. + ! Item was added: + ----- Method: MessageTrace>>removeMessage (in category 'actions') ----- + removeMessage + "Remove the selected messages from the system." + self selectedMessages size = 0 ifTrue: [ ^self ]. + self selectedMessages size = 1 ifTrue: [ ^super removeMessage ]. + (self confirm: 'Are you certain you want to remove all of the selected methods from the image?') ifFalse: [ ^self ]. + self selectedMessages do: + [ :each | + each actualClass removeSelector: each methodSymbol. + self deleteFromMessageList: each ]! Item was added: + ----- Method: MessageTrace classSide>>setUpPreferencesPanel (in category 'initializing') ----- + setUpPreferencesPanel + Preferences + addPreference: #traceMessages + category: #browsing + default: false + balloonHelp: 'If true, browsing senders or implementors in a methods browser will add to the methods in that browser instead of opening a new browser.' + ! Item was added: + ----- Method: MessageTrace>>addParentMethodsSending: (in category 'building') ----- + addParentMethodsSending: selectorSymbol + + | methodsList | + (methodsList := self filteredSelectorsSending: selectorSymbol) isEmpty + ifTrue: + [ ^(PopUpMenu labels: ' OK ') + startUpWithCaption: 'There are no methods that send ', selectorSymbol ] + ifFalse: + [ self + addParentMessages: methodsList + autoSelectString: selectorSymbol ] + ! Item was added: + ----- Method: MessageTrace>>toggleSelectionAt:shifted:controlled: (in category 'actions') ----- + toggleSelectionAt: currentPosition shifted: isShifted controlled: isControlled + + currentPosition = 0 ifTrue: [ ^nil ]. + isControlled + ifTrue: + [ isShifted + ifTrue: + [ self selectAllBetweenAnchorAnd: currentPosition ] + ifFalse: + [ self toggleMessageSelectionAt: currentPosition. + anchorIndex := currentPosition ] ] + ifFalse: + [ self deselectAll. + isShifted + ifTrue: + [ self selectAllBetweenAnchorAnd: currentPosition ] + ifFalse: + [ self + messageAt: currentPosition + beSelected: true. + anchorIndex := currentPosition ] ]. + self messageListIndex: currentPosition + ! Item was changed: ----- Method: CodeHolder>>messageListKey:from: (in category 'message list menu') ----- messageListKey: aChar from: view "Respond to a Command key. I am a model with a code pane, and I also have a listView that has a list of methods. The view knows how to get the list and selection." | sel class | aChar == $D ifTrue: [^ self toggleDiffing]. sel := self selectedMessageName. aChar == $m ifTrue: "These next two put up a type in if no message selected" + [^ self useSelector: sel orGetSelectorAndSendQuery: #browseAllImplementorsOf: to: self ]. - [^ self useSelector: sel orGetSelectorAndSendQuery: #browseAllImplementorsOf: to: self systemNavigation]. aChar == $n ifTrue: + [^ self useSelector: sel orGetSelectorAndSendQuery: #browseAllCallsOn: to: self ]. - [^ self useSelector: sel orGetSelectorAndSendQuery: #browseAllCallsOn: to: self systemNavigation]. "The following require a class selection" (class := self selectedClassOrMetaClass) ifNil: [^ self arrowKey: aChar from: view]. aChar == $b ifTrue: [^ Browser fullOnClass: class selector: sel]. aChar == $N ifTrue: [^ self browseClassRefs]. aChar == $i ifTrue: [^ self methodHierarchy]. aChar == $h ifTrue: [^ self classHierarchy]. aChar == $p ifTrue: [^ self browseFullProtocol]. "The following require a method selection" sel ifNotNil: [aChar == $o ifTrue: [^ self fileOutMessage]. aChar == $c ifTrue: [^ self copySelector]. aChar == $v ifTrue: [^ self browseVersions]. aChar == $O ifTrue: [^ self openSingleMessageBrowser]. aChar == $x ifTrue: [^ self removeMessage]. aChar == $d ifTrue: [^ self removeMessageFromBrowser]. (aChar == $C and: [self canShowMultipleMessageCategories]) ifTrue: [^ self showHomeCategory]]. ^ self arrowKey: aChar from: view! Item was added: + ----- Method: MessageTrace>>indentEverything (in category 'indenting') ----- + indentEverything + + messageList do: [ :each | each stringVersion: (self indentionPrefixOfSize: 1), each stringVersion ] + ! Item was added: + ----- Method: MessageTrace>>indentionSize (in category 'indenting') ----- + indentionSize + + ^2 "that is, 2 spaces.." + ! Item was added: + ----- Method: MessageTrace>>filteredSelectorsSending: (in category 'filtering') ----- + filteredSelectorsSending: selectorSymbol + ^ self systemNavigation allCallsOn: selectorSymbol! Item was changed: ----- Method: StandardToolSet class>>browseMessageSet:name:autoSelect: (in category 'browsing') ----- browseMessageSet: messageList name: title autoSelect: autoSelectString + "Open a message set or message-trace browser, depending on the #traceMessages setting." + ^ Preferences traceMessages + ifTrue: + [ MessageTrace + openMessageList: messageList + name: title + autoSelect: autoSelectString ] + ifFalse: + [ MessageSet + openMessageList: messageList + name: title + autoSelect: autoSelectString ]! - "Open a message set browser" - ^MessageSet - openMessageList: messageList - name: title - autoSelect: autoSelectString! Item was added: + ----- Method: Object>>browseAllCallsOn: (in category '*Tools-MessageSets') ----- + browseAllCallsOn: selectorSymbol + "Models get the first chance to handle this, so a message-tracer can be built.. Not all Tool 'models' inherit from Model, otherwise this would be there." + self systemNavigation browseAllCallsOn: selectorSymbol! Item was added: + ----- Method: MessageTrace>>deselectAll (in category 'actions') ----- + deselectAll + self messageListIndex: 0. + 1 to: messageSelections size do: [ :index | messageSelections at: index put: false ] + ! Item was added: + ----- Method: MessageTrace>>removeMessageFromBrowser (in category 'building') ----- + removeMessageFromBrowser + | indexToSelect | + indexToSelect := (messageSelections indexOf: true) max: 1. + self selectedMessages do: [ :eachMethodReference | self deleteFromMessageList: eachMethodReference ]. + self deselectAll. + messageSelections ifNotEmpty: + [ messageSelections + at: (indexToSelect min: messageSelections size) "safety" + put: true ]. + anchorIndex := indexToSelect. + self reformulateList! Item was added: + ----- Method: MessageTrace>>indentionsIn: (in category 'indenting') ----- + indentionsIn: aString + + aString + withIndexDo: + [ :eachChar :index | + eachChar = $ "space" ifFalse: [ ^(index-1) / self indentionSize ] ]. + ^0 + ! Item was added: + ----- Method: MessageTrace>>selectedMessages (in category 'private actions') ----- + selectedMessages + + | answer | + answer := OrderedCollection new. + messageSelections withIndexDo: + [ :eachSelection :index | + eachSelection ifTrue: [ answer add: (messageList at: index) ] ]. + ^answer + ! Item was added: + MessageSet subclass: #MessageTrace + instanceVariableNames: 'autoSelectStrings messageSelections anchorIndex' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Browser'! + + !MessageTrace commentStamp: 'cmm 3/2/2010 20:26' prior: 0! + A MessageTrace is a MessageSet allowing efficient sender/implementor message following. With implementors indented below, and senders outdended above, message flow is succinctly expressed, hierarchically. + + My autoSelectStrings and messageSelections are Arrays of Booleans, parallel to my messageList. Each boolean indicates whether that message is selected. Each autoSelectStrings indicates which string should be highlighted in the code for each method in my messageList.! Item was added: + ----- Method: MessageTrace>>addParentMessages:autoSelectString: (in category 'building') ----- + addParentMessages: methodReferences autoSelectString: aString + | currentIndentionLevel addables selectables | + addables := methodReferences reject: [ : each | messageList includes: each ]. + selectables := addables copy + addAll: (methodReferences select: [ : each | messageList includes: each ]) ; + yourself. + currentIndentionLevel := self indentionsIn: self selection stringVersion. + (currentIndentionLevel = 0 and: [ addables notEmpty ]) ifTrue: + [ self indentEverything. + currentIndentionLevel := 1 ]. + addables do: + [ : each | + each stringVersion: (self indentionPrefixOfSize: currentIndentionLevel - 1) , each asStringOrText. + messageList + add: each + afterIndex: self messageListIndex - 1. + autoSelectStrings + add: aString + afterIndex: self messageListIndex - 1. + messageSelections + add: false + afterIndex: self messageListIndex - 1 ]. + self deselectAll. + selectables do: + [ : each | | messageIndex | + messageIndex := messageList indexOf: each. + self + messageAt: messageIndex + beSelected: true. + autoSelectStrings + at: messageIndex + put: aString ]. + self changed: #messageList. + selectables size > 0 ifTrue: + [ self messageListIndex: (messageList indexOf: selectables first) ]! Item was added: + ----- Method: MessageTrace>>selectAllBetweenAnchorAnd: (in category 'private actions') ----- + selectAllBetweenAnchorAnd: indexPosition + + | lower higher | + self deselectAllBetweenLastSelectionAnd: indexPosition. + anchorIndex ifNil: [ anchorIndex := indexPosition ]. + lower := anchorIndex min: indexPosition. + higher := anchorIndex max: indexPosition. + lower to: higher do: + [ :index | messageSelections at: index put: true ] + ! Item was added: + ----- Method: MessageTrace>>initializeMessageList: (in category 'private initializing') ----- + initializeMessageList: anArray + messageSelections := (Array new: anArray size withAll: false) asOrderedCollection. + super initializeMessageList: anArray. + self + messageAt: messageListIndex + beSelected: true. + "autoSelectStrings is initialized right after this method, in autoSelectString:" + ! Item was changed: ----- Method: Model>>addItem: (in category '*Tools') ----- addItem: classAndMethod "Make a linked message list and put this method in it" self flag: #mref. "classAndMethod is a String" MessageSet parse: classAndMethod toClassAndSelector: [ :class :sel | | list | class ifNil: [^self]. list := OrderedCollection with: ( MethodReference new setClass: class methodSymbol: sel stringVersion: classAndMethod ). + ToolSet + browseMessageSet: list + name: 'Linked by HyperText' + autoSelect: nil - MessageSet - openMessageList: list - name: 'Linked by HyperText'. ] ! Item was added: + ----- Method: MessageTrace>>messageAt:beSelected: (in category 'actions') ----- + messageAt: indexInteger beSelected: aBoolean + ^ indexInteger isZero ifFalse: + [ messageSelections + at: indexInteger + put: aBoolean ]! Item was added: + ----- Method: MessageTrace>>messageListIndex: (in category 'actions') ----- + messageListIndex: anInteger + autoSelectStrings notEmpty ifTrue: + [ autoSelectString := + anInteger = 0 + ifTrue: [ '' ] + ifFalse: + [ messageListIndex := anInteger. "setting the window label, below, can't wait for this.." + self containingWindow setLabel: (self windowLabelAt: anInteger). + (autoSelectStrings at: anInteger) ifNotNilDo: [ : fullSelector | fullSelector keywords first ] ] ]. + anInteger > 0 ifTrue: + [ self + messageAt: anInteger + beSelected: true ]. + super messageListIndex: anInteger + ! Item was changed: ----- Method: ChangeSorter>>browseMethodConflicts (in category 'changeSet menu') ----- browseMethodConflicts "Check to see if any other change set also holds changes to any methods in the selected change set; if so, open a browser on all such." | aList | aList := myChangeSet messageListForChangesWhich: [ :aClass :aSelector | (ChangesOrganizer allChangeSetsWithClass: aClass selector: aSelector) size > 1 ] ifNone: [^ self inform: 'No other change set has changes for any method in this change set.']. + ToolSet + browseMessageSet: aList - MessageSet - openMessageList: aList name: 'Methods in "', myChangeSet name, '" that are also in other change sets (', aList size printString, ')' + autoSelect: nil! - ! Item was changed: ----- Method: Browser>>reformulateList (in category 'message list') ----- reformulateList "If the receiver has a way of reformulating its message list, here is a chance for it to do so" - super reformulateList. + messageListIndex > self messageList size ifTrue: [ self messageListIndex: self messageList size ]! - self messageListIndex: 0! Item was changed: ----- Method: ChangeList>>browseCurrentVersionsOfSelections (in category 'menu actions') ----- browseCurrentVersionsOfSelections "Opens a message-list browser on the current in-memory versions of all methods that are currently seleted" | aList | aList := OrderedCollection new. Cursor read showWhile: [ 1 to: changeList size do: [:i | (listSelections at: i) ifTrue: [ | aClass aChange | aChange := changeList at: i. (aChange type = #method and: [(aClass := aChange methodClass) notNil and: [aClass includesSelector: aChange methodSelector]]) ifTrue: [ aList add: ( MethodReference new setStandardClass: aClass methodSymbol: aChange methodSelector ) ]]]]. aList size == 0 ifTrue: [^ self inform: 'no selected methods have in-memory counterparts']. + ToolSet + browseMessageSet: aList + name: 'Current versions of selected methods in ', file localName + autoSelect: nil! - MessageSet - openMessageList: aList - name: 'Current versions of selected methods in ', file localName! Item was added: + ----- Method: MessageTrace>>deselectAllBetweenLastSelectionAnd: (in category 'private actions') ----- + deselectAllBetweenLastSelectionAnd: indexPosition + + | lower higher | + lower := messageListIndex min: indexPosition. + higher := messageListIndex max: indexPosition. + lower = 0 ifTrue: [ ^nil ]. + lower to: higher do: + [ :index | messageSelections at: index put: false ] + ! Item was changed: ----- Method: MessageSet>>addExtraShiftedItemsTo: (in category 'message list') ----- addExtraShiftedItemsTo: aMenu "The shifted selector-list menu is being built. Add items specific to MessageSet" - self growable ifTrue: [aMenu addList: #( - ('remove from this browser' removeMessageFromBrowser) + ('filter message list...' filterMessageList))]. + aMenu + add: 'sort by date' + action: #sortByDate! - ('filter message list...' filterMessageList) - ('add to message list...' augmentMessageList))]. - aMenu add: 'sort by date' action: #sortByDate! Item was removed: - ----- Method: MessageSet>>augmentMessageList (in category 'filtering') ----- - augmentMessageList - "Allow the user to add to the list of messages." - - self notYetImplemented - !

1 0

The Trunk: Morphic-cmm.372.mcz
by commits＠source.squeak.org 03 Mar '10

03 Mar '10

Chris Muller uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-cmm.372.mcz ==================== Summary ==================== Name: Morphic-cmm.372 Author: cmm Time: 3 March 2010, 3:16:59.984 pm UUID: 7e315edd-fe3e-4733-9194-76612facf8c7 Ancestors: Morphic-cmm.371, Morphic-laza.370 Merged laza.370. =============== Diff against Morphic-laza.370 =============== Item was added: + ----- Method: AlternatePluggableListMorphOfMany>>listSelectionAt:put: (in category 'drawing') ----- + listSelectionAt: index put: value + setSelectionListSelector ifNil:[^false]. + ^model perform: setSelectionListSelector with: index with: value! Item was added: + ----- Method: AlternatePluggableListMorphOfMany>>changeModelSelection:shifted:controlled: (in category 'model access') ----- + changeModelSelection: anInteger shifted: shiftedBoolean controlled: controlledBoolean + "Change the model's selected item index to be anInteger." + + setIndexSelector ifNotNil: + [ model + perform: setIndexSelector + with: anInteger + with: shiftedBoolean + with: controlledBoolean ] + ! Item was added: + ----- Method: AlternatePluggableListMorphOfMany>>handlesMouseDown: (in category 'event handling') ----- + handlesMouseDown: evt + ^ true! Item was changed: ----- Method: TextEditor>>prettyPrint: (in category 'menu messages') ----- + prettyPrint: decorated - prettyPrint: decorated "Reformat the contents of the receiver's view (a Browser)." - | selectedClass newText | + model selectedMessageName ifNil: [ ^ morph flash ]. - model selectedMessageName ifNil: [^ morph flash]. selectedClass := model selectedClassOrMetaClass. newText := selectedClass compilerClass new format: self text in: selectedClass notifying: self decorated: decorated. newText ifNotNil: + [ self + deselect ; + selectInvisiblyFrom: 1 + to: paragraph text size. - [self deselect; selectInvisiblyFrom: 1 to: paragraph text size. self replaceSelectionWith: (newText asText makeSelectorBoldIn: selectedClass). + self selectAt: self text size + 1 ]! - self selectAt: 1]! Item was added: + ----- Method: AlternatePluggableListMorphOfMany classSide>>on:list:primarySelection:changePrimarySelection:listSelection:changeListSelection:menu: (in category 'instance creation') ----- + on: anObject list: listSel primarySelection: getSelectionSel changePrimarySelection: setSelectionSel listSelection: getListSel changeListSelection: setListSel menu: getMenuSel + ^ self new + on: anObject + list: listSel + primarySelection: getSelectionSel + changePrimarySelection: setSelectionSel + listSelection: getListSel + changeListSelection: setListSel + menu: getMenuSel + keystroke: #arrowKey:from: "default"! Item was added: + ----- Method: AlternatePluggableListMorphOfMany>>itemSelectedAmongMultiple: (in category 'model access') ----- + itemSelectedAmongMultiple: index + ^model isMessageSelectedAt: index! Item was changed: ----- Method: PluggableMessageCategoryListMorph>>verifyContents (in category 'updating') ----- verifyContents - | newList existingSelection anIndex newRawList | (model editSelection == #editComment) ifTrue: [^ self]. model classListIndex = 0 ifTrue: [^ self]. newRawList := model perform: getRawListSelector. newRawList == priorRawList ifTrue: [^ self]. "The usual case; very fast" priorRawList := newRawList. newList := (Array with: ClassOrganizer allCategory), priorRawList. list = newList ifTrue: [^ self]. - self flash. "could get annoying, but hell" existingSelection := self selection. self updateList. (anIndex := newList indexOf: existingSelection ifAbsent: [nil]) ifNotNil: [model noteSelectionIndex: anIndex for: getListSelector. self selectionIndex: anIndex] ifNil: [self changeModelSelection: 0]! Item was added: + ----- Method: MessageSet>>representsSameBrowseeAs: (in category '*morphic') ----- + representsSameBrowseeAs: anotherModel + ^ self hasUnacceptedEdits not + and: [ messageList = anotherModel messageList ]! Item was added: + ----- Method: SmalltalkEditor>>invokePrettyPrint: (in category 'editing keys') ----- + invokePrettyPrint: dummy + self prettyPrint: false. + ^ true! Item was changed: ----- Method: TextEditor>>implementorsOfIt (in category 'menu messages') ----- implementorsOfIt "Open an implementors browser on the selected selector" - | aSelector | self lineSelectAndEmptyCheck: [^ self]. (aSelector := self selectedSelector) == nil ifTrue: [^ morph flash]. + model browseAllImplementorsOf: aSelector! - self systemNavigation browseAllImplementorsOf: aSelector! Item was added: + ----- Method: AlternatePluggableListMorphOfMany classSide>>on:list:primarySelection:changePrimarySelection:listSelection:changeListSelection:menu:keystroke: (in category 'instance creation') ----- + on: anObject list: listSel primarySelection: getSelectionSel changePrimarySelection: setSelectionSel listSelection: getListSel changeListSelection: setListSel menu: getMenuSel keystroke: keyActionSel + ^ self new + on: anObject + list: listSel + primarySelection: getSelectionSel + changePrimarySelection: setSelectionSel + listSelection: getListSel + changeListSelection: setListSel + menu: getMenuSel + keystroke: keyActionSel! Item was added: + ----- Method: AlternatePluggableListMorphOfMany>>mouseDown: (in category 'event handling') ----- + mouseDown: event + | row | + + event yellowButtonPressed ifTrue: [^ self yellowButtonActivity: event shiftPressed]. + + row := self rowAtLocation: event position. + + row = 0 ifTrue: [^super mouseDown: event]. + + model okToChange ifFalse: [^ self]. "No change if model is locked" + + "Inform model of selected item and let it toggle." + self + changeModelSelection: row + shifted: event shiftPressed + controlled: event controlKeyPressed. + + + " + event hand releaseMouseFocus: aMorph. + submorphs do: [ :each | each changed ] + "! Item was added: + ----- Method: AlternatePluggableListMorphOfMany>>listSelectionAt: (in category 'drawing') ----- + listSelectionAt: index + getSelectionListSelector ifNil:[^false]. + ^model perform: getSelectionListSelector with: index! Item was changed: ----- Method: PluggableListMorph>>verifyContents (in category 'updating') ----- verifyContents "Verify the contents of the receiver, reconstituting if necessary. Called whenever window is reactivated, to react to possible structural changes. Also called periodically in morphic if the smartUpdating preference is true" | newList existingSelection anIndex oldList | oldList := list ifNil: [ #() ]. newList := self getList. + oldList = newList ifTrue: [ ^ self ]. - ((oldList == newList) "fastest" or: [oldList = newList]) ifTrue: [^ self]. - self flash. "list has changed beneath us; give the user a little visual feedback that the contents of the pane are being updated." existingSelection := self selectionIndex > 0 ifTrue: [ oldList at: self selectionIndex ] ifFalse: [ nil ]. self updateList. (existingSelection notNil and: [(anIndex := list indexOf: existingSelection asStringOrText ifAbsent: [nil]) notNil]) ifTrue: [model noteSelectionIndex: anIndex for: getListSelector. self selectionIndex: anIndex] ifFalse: [self changeModelSelection: 0]! Item was added: + ----- Method: AlternatePluggableListMorphOfMany>>on:list:primarySelection:changePrimarySelection:listSelection:changeListSelection:menu:keystroke: (in category 'initialization') ----- + on: anObject list: listSel primarySelection: getSelectionSel changePrimarySelection: setSelectionSel listSelection: getListSel changeListSelection: setListSel menu: getMenuSel keystroke: keyActionSel + "setup a whole load of pluggability options" + + getSelectionListSelector := getListSel. + setSelectionListSelector := setListSel. + self + on: anObject + list: listSel + selected: getSelectionSel + changeSelected: setSelectionSel + menu: getMenuSel + keystroke: keyActionSel! Item was added: + ----- Method: AlternatePluggableListMorphOfMany>>list: (in category 'initialization') ----- + list: listOfStrings + scroller removeAllMorphs. + list := listOfStrings ifNil: [Array new]. + list isEmpty ifTrue: [^ self selectedMorph: nil]. + super list: listOfStrings. + + "At this point first morph is sensitized, and all morphs share same handler." + scroller firstSubmorph on: #mouseEnterDragging + send: #mouseEnterDragging:onItem: + to: self. + scroller firstSubmorph on: #mouseUp + send: #mouseUp:onItem: + to: self. + "This should add this behavior to the shared event handler thus affecting all items"! Item was added: + PluggableListMorph subclass: #AlternatePluggableListMorphOfMany + instanceVariableNames: 'getSelectionListSelector setSelectionListSelector' + classVariableNames: '' + poolDictionaries: '' + category: 'Morphic-Pluggable Widgets'! + + !AlternatePluggableListMorphOfMany commentStamp: 'cmm 3/2/2010 14:39' prior: 0! + This is a multi-select list that is more conventional in its behavior than PluggableListMorphOfMany. It utilizes a shift+click mechanism for selecting ranges, and control+click for toggling individual selections. This list also allows fast mouse swipes without missing any message selections.! Item was added: + ----- Method: AlternatePluggableListMorphOfMany>>mouseMove: (in category 'event handling') ----- + mouseMove: event + "The mouse has moved, as characterized by the event provided. Adjust the scrollbar, and alter the selection as appropriate" + + | oldIndex oldVal row | + event position y < self top + ifTrue: + [scrollBar scrollUp: 1. + row := self rowAtLocation: scroller topLeft + (1 @ 1)] + ifFalse: + [row := event position y > self bottom + ifTrue: + [scrollBar scrollDown: 1. + self rowAtLocation: scroller bottomLeft + (1 @ -1)] + ifFalse: [ self rowAtLocation: event position]]. + row = 0 ifTrue: [^super mouseDown: event]. + + model okToChange ifFalse: [^self]. "No change if model is locked" + + "Set meaning for subsequent dragging of selection" + oldIndex := self getCurrentSelectionIndex. + oldIndex ~= 0 ifTrue: [oldVal := self listSelectionAt: oldIndex]. + "Need to restore the old one, due to how model works, and set new one." + oldIndex ~= 0 ifTrue: [self listSelectionAt: oldIndex put: oldVal]. + + "Inform model of selected item and let it toggle." + self + changeModelSelection: row + shifted: true + controlled: event controlKeyPressed. + submorphs do: [:each | each changed]! Item was added: + ----- Method: AlternatePluggableListMorphOfMany>>changeModelSelection: (in category 'model access') ----- + changeModelSelection: anInteger + "Change the model's selected item index to be anInteger." + + ^self + changeModelSelection: anInteger + shifted: Sensor shiftPressed + controlled: Sensor controlKeyPressed + ! Item was added: + ----- Method: AlternatePluggableListMorphOfMany>>mouseUp: (in category 'event handling') ----- + mouseUp: event + "Not needed. Overridden to do nothing."! Item was changed: ----- Method: SmalltalkEditor class>>initializeShiftCmdKeyShortcuts (in category 'keyboard shortcut tables') ----- initializeShiftCmdKeyShortcuts "Initialize the shift-command-key (or control-key) shortcut table." "NOTE: if you don't know what your keyboard generates, use Sensor kbdTest" "wod 11/3/1998: Fix setting of cmdMap for shifted keys to actually use the capitalized versions of the letters. TPR 2/18/99: add the plain ascii values back in for those VMs that don't return the shifted values." "SmalltalkEditor initialize" | cmds | super initializeShiftCmdKeyShortcuts. cmds := #( $a argAdvance: $b browseItHere: $e methodStringsContainingIt: $f displayIfFalse: $g fileItIn: $i exploreIt: $n referencesToIt: + $s invokePrettyPrint: $t displayIfTrue: $v pasteInitials: $w methodNamesContainingIt: ). 1 to: cmds size by: 2 do: [ :i | shiftCmdActions at: ((cmds at: i) asciiValue + 1) put: (cmds at: i + 1). "plain keys" shiftCmdActions at: ((cmds at: i) asciiValue - 32 + 1) put: (cmds at: i + 1). "shifted keys" shiftCmdActions at: ((cmds at: i) asciiValue - 96 + 1) put: (cmds at: i + 1). "ctrl keys" ].! Item was added: + ----- Method: AlternatePluggableListMorphOfMany>>update: (in category 'event handling') ----- + update: aSymbol + aSymbol == #allSelections ifTrue: + [self selectionIndex: self getCurrentSelectionIndex. + ^ self changed]. + ^ super update: aSymbol! Item was removed: - ----- Method: MorphicProject>>currentVocabulary (in category 'protocols') ----- - currentVocabulary - "Answer the currently-prevailing default vocabulary." - - ^ ActiveWorld currentVocabulary - !

1 0

Monticello-kb.368 (Shout styling for the MCSnapshotBrowser)
by Andreas Raab 03 Mar '10

03 Mar '10

Hi Balázs - This does not work for me. I don't get any styling when I browse packages after loading this package. Any ideas? Cheers, - Andreas

8 13

[Election] In approximately 4 hours and 50 minutes...
by Göran Krampe 03 Mar '10

03 Mar '10

...the candidate list is finalized! So if you want to be a candidate for the 2010 Squeak Oversight Board, step up NOW! regards, Göran

2 1

About Compiler-cmm.131
by Chris Muller 03 Mar '10

03 Mar '10

Hi, I've just posted refinements to the inbox for pretty-print to provide Rectangular Block and Indented Control Flow as suggested by Ward Cunningham at: http://c2.com/ppr/formatting.html#2 These formatting rules maximize readability while balancing screen space (and methods should be short anyway). However, I did only push these to the inbox for now, due to the potentially combustible nature of this sort of change. Unless there are major objections, I'd like to copy these to the trunk so we can all enjoy gorgeous Rectangular Block formatting. - Chris

3 4

← Newer
1
...
69
70
71
72
73
74
75
76
77
Older →

Jump to page: