[squeak-dev] The Trunk: Tools-cmm.199.mcz

Chris Muller asqueaker at gmail.com
Mon Apr 5 03:15:41 UTC 2010


This was put into the trunk a long time ago, and I merely noticed that
this particular version, while part of the ancestry, was not part of
the history, so I copied it to the trunk repository.

On Sun, Apr 4, 2010 at 9:48 PM,  <commits at source.squeak.org> wrote:
> Chris Muller uploaded a new version of Tools to project The Trunk:
> http://source.squeak.org/trunk/Tools-cmm.199.mcz
>
> ==================== Summary ====================
>
> Name: Tools-cmm.199
> Author: cmm
> Time: 2 March 2010, 9:13:10.569 pm
> UUID: 3db86f00-e62b-4554-b32e-eda4c8de102b
> Ancestors: Tools-cmm.198
>
> - 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.197 ===============
>
> 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
> - !
>
>
>


More information about the Squeak-dev mailing list