The Inbox: Tools-tpr.1003.mcz

A new version of Tools was added to project The Inbox:
http://source.squeak.org/inbox/Tools-tpr.1003.mcz

==================== Summary ====================

Name: Tools-tpr.1003
Author: tpr
Time: 18 October 2020, 5:24:15.656722 pm
UUID: 7a19cdad-a4e2-432e-ab35-b89d0de811e1
Ancestors: Tools-mt.1002

Rework the window label handing of MessageSet/Trace to be a bit more accurate, and to work within the normal style of labels.

Instead of assuming the size of the list passed to the MessageSet/Trace is correct, derive it from the post-processing list. We process the list to remove duplicates, which e.g. the #allUnimplementedCalls method produces.

This required adding an instvar to M-Set, removing one from M-Trace, setting the new one properly, dumping some dodgy code that used to half-assedly derive the old one, use the proper #changed: #windowTitle to, y'know, change the title, and some faffing with the messageList.

As a result we are better placed to make further improvements if/when we develop a way to correctly hightlight multi-part keywords (or indeed, multiple messages) within a single method, which would greatly improve many browsers.

This benefits from being accompanied by the single-method change in the System-tpr.1181 package

=============== Diff against Tools-mt.1002 ===============

Item was changed:
  CodeHolder subclass: #MessageSet
+ instanceVariableNames: 'growable messageList messageListFormatted autoSelectString messageListIndex editSelection windowLabel'
- instanceVariableNames: 'growable messageList messageListFormatted autoSelectString messageListIndex editSelection'
  classVariableNames: 'UseUnifiedMessageLabels'
  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 changed:
  ----- Method: MessageSet class>>openMessageList:name:autoSelect: (in category 'instance creation') -----
  openMessageList: messageList name: labelString autoSelect: autoSelectString
  "Open a system view for a MessageSet on messageList.
+ The labelString is passed to the model to use as a base label, depending on the selection state"
- 1/24/96 sw: the there-are-no msg now supplied by my sender"
 
  | messageSet |
  messageSet := self messageList: messageList.
+ messageSet
+ autoSelectString: autoSelectString;
+ setInitialLabel: labelString.
+ ^ToolBuilder open: messageSet!
- messageSet autoSelectString: autoSelectString.
- ^ToolBuilder open: messageSet label: labelString!

Item was changed:
  ----- Method: MessageSet>>adjustWindowTitleAfterFiltering (in category 'private') -----
  adjustWindowTitleAfterFiltering
+ "Set the title of the receiver's window, if any, to reflect the just-completed filtering. Avoid re-doing it if fitering is re-done"
- "Set the title of the receiver's window, if any, to reflect the just-completed filtering"
 
+ (windowLabel endsWith: 'Filtered')
+ ifFalse: [windowLabel := windowLabel , ' Filtered'.
+ self changed: #windowTitle]!
- | aWindow existingLabel newLabel |
-
- (aWindow := self containingWindow) ifNil: [^ self].
- (existingLabel := aWindow label) isEmptyOrNil ifTrue: [^ self].
- (((existingLabel size < 3) or: [existingLabel last ~~ $]]) or: [(existingLabel at: (existingLabel size - 1)) isDigit not]) ifTrue: [^ self].
- existingLabel size to: 1 by: -1 do:
- [:anIndex | ((existingLabel at: anIndex) == $[) ifTrue:
- [newLabel := (existingLabel copyFrom: 1 to: anIndex),
- 'Filtered: ',
- messageList size printString,
- ']'.
- ^ aWindow setLabel: newLabel]]
-
-
- !

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.
  Do /not/ replace the elements of anArray if they are already MethodReferences, so as to allow users to construct richer systems, such as differencers between existing and edited versions of code."
+ messageList := Set new.
- messageList := OrderedCollection new.
  anArray do:
  [:each | each isMethodReference
+ ifTrue: [messageList add: each]
- ifTrue: [messageList addLast: each]
  ifFalse:
  [ MessageSet
  parse: each
  toClassAndSelector:
+ [ : class : sel | class ifNotNil: [ messageList add: (MethodReference class: class selector: sel) ] ] ] ].
+ messageList := messageList asSortedCollection asOrderedCollection. "Possibly better to do asOrderedCollection sort ?"
- [ : class : sel | class ifNotNil: [ messageList addLast: (MethodReference class: class selector: sel) ] ] ] ].
  "Unify labels if wanted."
  self class useUnifiedMessageLabels ifTrue:
  [ messageList withIndexDo:
  [ : each : index | | cls |
  cls := each actualClass.
  each stringVersion:
  (self indentionPrefixOfSize: (self indentionsIn: each stringVersion))
  , (cls
  ifNil: [each asString]
  ifNotNil:
  [cls isUniClass
  ifTrue: [cls typicalInstanceName, ' ', each selector]
  ifFalse:
  [ cls name , ' ' , each selector , ' {'
  , ((cls organization categoryOfElement: each selector) ifNil: ['']) , '}'
  , ' {', cls category, '}' ] ]) ] ].
  messageListIndex := messageList isEmpty ifTrue: [0] ifFalse: [1].
  contents := String empty!

Item was changed:
  ----- Method: MessageSet>>messageListIndex: (in category 'message list') -----
  messageListIndex: anInteger
+ "Set the index of the selected item to be anInteger.
+ Update the message list morph, the text edit morph and the assorted buttons"
- "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 ].
  self decorateButtons
  !

Item was added:
+ ----- Method: MessageSet>>setInitialLabel: (in category 'accessing') -----
+ setInitialLabel: aString
+ "set the base label for the window, as returned by #windowTitle"
+
+ windowLabel := aString!

Item was added:
+ ----- Method: MessageSet>>windowTitle (in category 'user interface') -----
+ windowTitle
+ "just return the basic label for now"
+
+ ^windowLabel!

Item was changed:
  MessageSet subclass: #MessageTrace
+ instanceVariableNames: 'autoSelectStrings messageSelections anchorIndex'
- instanceVariableNames: 'autoSelectStrings messageSelections anchorIndex defaultSelectString'
  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 changed:
  ----- Method: MessageTrace>>browseAllImplementorsOf: (in category 'actions') -----
  browseAllImplementorsOf: selectorSymbol
  | selectorToBrowse |
  selectorToBrowse := self selection
  ifNil: [ selectorSymbol ]
+ ifNotNil: [ self getImplementorNamed: selectorSymbol asSymbol "since we can get passed literals"].
- ifNotNil: [ self getImplementorNamed: selectorSymbol ].
  (self hasUnacceptedEdits or: [ Preferences traceMessages not ])
  ifTrue: [ super browseAllImplementorsOf: selectorToBrowse ]
  ifFalse: [ self addChildMethodsNamed: selectorToBrowse ]
  !

Item was changed:
  ----- Method: MessageTrace>>initializeMessageList: (in category 'private initializing') -----
  initializeMessageList: anArray
- messageSelections := (Array new: anArray size withAll: false) asOrderedCollection.
  super initializeMessageList: anArray.
+ messageSelections := (Array new: messageList size withAll: false) asOrderedCollection.
  self
  messageAt: messageListIndex
  beSelected: true.
  "autoSelectStrings is initialized right after this method, in autoSelectString:"
  !

Item was changed:
  ----- Method: MessageTrace>>messageListIndex: (in category 'actions') -----
  messageListIndex: anInteger
+ "Set the index of the selected item to be anInteger.
+ Find the relevant auto select string to use, do my superclass' work and update the window title"
+
  autoSelectStrings ifNotEmpty:
  [ autoSelectString :=
  anInteger = 0
+ ifTrue: [ "clear the autoSelectString"
+ String empty ]
+ ifFalse: [autoSelectStrings at: anInteger]
+ ].
+
+ anInteger > 0 ifTrue: [ self
+ messageAt: anInteger
+ beSelected: true
+ ].
+ super messageListIndex: anInteger.
+ self changed: #windowTitle
- ifTrue:
- [ defaultSelectString ifNotNil: [:default| self containingWindow setLabel: default].
- "clear the autoSelectString"
- '' ]
- ifFalse:
- [ messageListIndex := anInteger.  
- "setting the window label, below, can't wait for this.."
- self containingWindow setLabel: (self windowLabelAt: anInteger).
- "work out the string to ask the text view to pre-select. We should do better than this; after all the debugger does"
- (autoSelectStrings at: anInteger)] ].
- anInteger > 0 ifTrue:
- [ self
- messageAt: anInteger
- beSelected: true ].
- super messageListIndex: anInteger
  !

Item was changed:
  ----- Method: MessageTrace>>windowLabelAt: (in category 'private accessing') -----
  windowLabelAt: anInteger
+ "return a suitable window label when there is an actual list item selected; work out what it should be based upon the array of autoSelectStrings or the current selection"
 
+ ^(autoSelectStrings at: anInteger)
+ ifNil: [ 'Implementors of ',
- | str |
- defaultSelectString ifNil:
- [defaultSelectString := self containingWindow label].
- ^(str := autoSelectStrings at: anInteger)
- ifNil:
- [ 'Implementors of ',
  (self class
  parse: self selection
+ toClassAndSelector: [ :class :selector | selector ])
+ ]
+ ifNotNil: [:str|  'Senders of ', str ]
- toClassAndSelector: [ :class :selector | selector ]) ]
- ifNotNil:
- [ 'Senders of ', str ]
  !

Item was added:
+ ----- Method: MessageTrace>>windowTitle (in category 'building') -----
+ windowTitle
+ "set the window label to suit the selection state;
+ if no selection, use saved widow label and add the number of items in the messageList
+ if something is selected, use the relevant string provided by windowLabelAt: which considers the index"
+
+ ^messageListIndex = 0
+ ifTrue:[String streamContents: [:str| str nextPutAll: windowLabel;
+ space;
+ nextPut: $[;
+ space;
+ nextPutAll: messageList size asString;
+ space;
+ nextPut: $]
+ ]
+ ]
+ ifFalse: [self windowLabelAt: messageListIndex]!

Hi Tim,

On Mon, 19 Oct 2020, [hidden email] wrote:

Yes, it's better not to use SortedCollection in this case (as in most
cases).
If messageList does not have to be an OrderedCollection, then

  messageList := messageList sorted.

is the best option.


Levente

messageList := messageList asOrderedCollection sort

seems to work perfectly well and is nicely readable. We do need anOrderedCollection since the tracing adds and removes items in specific indices. I've no idea if the performance would become a practical issue.

In fact, I tried a quick hack to make a list of all the implemented messages to time making a really big message list - but that falls foul of a problem I'm simply not willing to spend any time on right now.

I hacked allUnimplentedCalls to -
allImplementedCalls
        "Answer a collection of each message that is sent by an expression in a method"

        | result  |
        result := OrderedCollection new.
        self allSelectorsAndMethodsDo: [ :behavior :selector :method |
                method selectorsDo: [ :each |
                                        result add: (String streamContents: [ :stream |
                                                stream
                                                        nextPutAll: behavior name;
                                                        space;
                                                        nextPutAll: selector;
                                                        space;
                                                        nextPutAll: 'calls: ';
                                                        nextPutAll: each ])  ] ].
        ^result
... to return a list in the same format, to pass over to #browseMessageList:name:.

It causes a barf in MessageSet class>>#parse:toClassAndSelector: for a rather amusing reason; note how the line in the middle tries to parse the incoming list

tuple := (codeReferenceOrString asString includesSubstring: '>>')
                                ifTrue: [(codeReferenceOrString findTokens: '>>') fold: [:a :b| (a findTokens: ' '), {b first = $# ifTrue: [b allButFirst] ifFalse: [b]}]]
                                ifFalse: [codeReferenceOrString asString findTokens: ' .'].

That check for '>>', the separator we so often use within a method reference? Guess what happens when we try to handle the input line 'ThirtyTwoBitRegister >> calls: >=' :-) I guess it is simply a fluke that no method with a > in the name is currently mentioned in #allUnimplementedCalls!

The #findTokens: simply isn't doing what I think the author expected. Trying to parse the list of strings we get from #allUnimplementedCalls et al. needs more thought, and perhaps the list *created* needs more thought too.

tim
--
tim Rowledge; [hidden email]; http://www.rowledge.org/tim
Useful random insult:- On permanent leave of absence from his senses.