The Trunk: Tools-nice.953.mcz

Nicolas Cellier uploaded a new version of Tools to project The Trunk:
http://source.squeak.org/trunk/Tools-nice.953.mcz

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

Name: Tools-nice.953
Author: nice
Time: 5 March 2020, 1:31:09.307169 pm
UUID: b3f8cb2d-289f-47e4-a9d0-a5b051a4c8bc
Ancestors: Tools-mt.942, Tools-ct.945, Tools-ct.941, Tools-ct.952, Tools-kfr.930, Tools-nice.725, Tools-jr.930

Merge several tool improvments from the inbox

Tools-ct.945, Tools-ct.941, Tools-ct.952, Tools-kfr.930, Tools-nice.725, Tools-jr.930

Tools-mt.942:
        Prepare 5.3rc3 --- All those "----" entries (SNAPSHOT, QUIT, etc.) in the changes file should not be of type #doIt, because that can cause Compiler/Parser errors. Change it to #misc instead. We might want to remove any other " if begins with ----" checks later, too.

Tools-ct.945:
        Fixes a bug/unnecessary limitation in VersionsBrowser class >> #browseMethod: that raised an error when browsing a method that had been removed from the system.

You can also reproduce it via: thisContext method browse "on a fresh image".

This commit replaces Tools-ct.944, which has been refactored again to reuse the return carat according to Kent Beck ("Format conditionals so their value is used where it clearly expresses the intent of the method"). Thanks to Chris for the reminder!

Tools-ct.941:
        Fixes a small bug when reusing a MessageNames window.

To reproduce:

        Preferences setFlag: #(SystemWindow >> reuseWindows) join asSymbol toValue: true during: [
                ToolSet
                        browseMessageNames: 'someFictiveMessageName';
                        browseMessageNames: 'someOtherFictiveMessageName'].

Tools-ct.952:
        Fixes an invalidation bug in the debugger's stack list display optimization

For the full bug report, see http://forum.world.st/BUG-in-Debugger-gt-gt-newStack-optimization-td5112726.html. Please review!

Tools-kfr.930:
        Form preview was displaying wrong colors. Convert preview form to screen depth to make colors display correctly

Tools-nice.725:
        Recognize Cuis #classDefinition: when scanning a cuis change file.

Tools-jr.930:
        Speed up removing of messages from MessageTrace.

In an existing MessageTrace, try "senders of at:put:", then remove them again with "remove from this browser (d)". Took several seconds before, finishes in an instant now.

Replaces autoSelectStrings and messageSelections with new OrderedCollections. The other method deleteFromMessageList: removes one element from the existing collections instead.

=============== Diff against Tools-mt.942 ===============

Item was changed:
  ----- Method: Browser>>defaultBrowserTitle (in category 'initialize-release') -----
  defaultBrowserTitle
+        | title |
+        title := 'System Browser'.
+        ^ environment = self class environment
+                ifTrue: [title]
+                ifFalse: [title, ' on environment ', environment asString]!
-        ^ 'System Browser'!

Item was changed:
  ----- Method: ChangeList>>scanCategory (in category 'scanning') -----
  scanCategory 
         "Scan anything that involves more than one chunk; method name is historical only"
 
+        | itemPosition item tokens stamp anIndex class meta |
-        | itemPosition item tokens stamp anIndex |
         itemPosition := file position.
         item := file nextChunk.
 
         ((item includesSubstring: 'commentStamp:')
         or: [(item includesSubstring: 'methodsFor:')
+        or: [(item includesSubstring: 'classDefinition:')
+        or: [item endsWith: 'reorganize']]]) ifFalse:
-        or: [item endsWith: 'reorganize']]) ifFalse:
                 ["Maybe a preamble, but not one we recognize; bail out with the preamble trick"
                 ^ self addItem: (ChangeRecord new file: file position: itemPosition type: #preamble)
                                  text: ('preamble: ' , item contractTo: 50)].
 
         tokens := Scanner new scanTokens: item.
         tokens size >= 3 ifTrue:
                 [stamp := ''.
                 anIndex := tokens indexOf: #stamp: ifAbsent: [nil].
                 anIndex ifNotNil: [stamp := tokens at: (anIndex + 1)].
 
                 tokens second == #methodsFor:
                         ifTrue: [^ self scanCategory: tokens third class: tokens first
                                                         meta: false stamp: stamp].
                 tokens third == #methodsFor:
                         ifTrue: [^ self scanCategory: tokens fourth class: tokens first
                                                         meta: true stamp: stamp]].
 
         tokens second == #commentStamp:
                 ifTrue:
                         [stamp := tokens third.
                         self addItem:
                                         (ChangeRecord new file: file position: file position type: #classComment
                                                                         class: tokens first category: nil meta: false stamp: stamp)
                                         text: 'class comment for ' , tokens first,
                                                   (stamp isEmpty ifTrue: [''] ifFalse: ['; ' , stamp]).
                         file nextChunk.
                         ^ file skipStyleChunk].
+               
+        tokens first == #classDefinition:
+                ifTrue:
+                        [class := tokens second.
+                        meta := tokens size >= 3 and: [tokens third = 'class'].
+                        stamp := ''.
+                        self addItem:
+                                        (ChangeRecord new file: file position: file position type: #classDefinition
+                                                                        class: class category: nil meta: meta stamp: stamp)
+                                        text: 'class definition for ' , class,
+                                                  (stamp isEmpty ifTrue: [''] ifFalse: ['; ' , stamp]).
+                        file nextChunk.
+                        ^ file skipStyleChunk].
 
         self assert: tokens last == #reorganize.
         self addItem:
                 (ChangeRecord new
                         file: file position: file position type: #reorganize
                         class: tokens first category: nil meta: false stamp: stamp)
                 text: 'organization for ' , tokens first, (tokens second == #class ifTrue: [' class'] ifFalse: ['']).
         file nextChunk!

Item was changed:
  ----- Method: Debugger>>newStack: (in category 'private') -----
  newStack: stack
         | oldStack diff |
         oldStack := contextStack.
         contextStack := stack.
         (oldStack == nil or: [oldStack last ~~ stack last])
                 ifTrue: [contextStackList := contextStack collect: [:ctx | ctx printString].
                                 ^ self].
         "May be able to re-use some of previous list"
         diff := stack size - oldStack size.
         contextStackList := diff <= 0
                 ifTrue: [contextStackList copyFrom: 1-diff to: oldStack size]
+                ifFalse: [(diff = 1 and: [stack second == oldStack first])
+                        ifTrue: [contextStackList copyWithFirst: stack first printString]
+                        ifFalse: [contextStack collect: [:ctx | ctx printString]]]!
-                ifFalse: [diff > 1
-                                ifTrue: [contextStack collect: [:ctx | ctx printString]]
-                                ifFalse: [(Array with: stack first printString) , contextStackList]]!

Item was changed:
  ----- Method: FileList>>readGraphicContents (in category 'private') -----
  readGraphicContents
         | form maxExtent ext |
+        form := (Form fromFileNamed: self fullName) asFormOfDepth: Display depth.
-        form := Form fromFileNamed: self fullName.
         maxExtent := lastGraphicsExtent := self availableGraphicsExtent.
         ext := form extent.
         (maxExtent notNil and: [form extent <= maxExtent]) ifFalse: [
                 form := form magnify: form boundingBox by: (maxExtent x / form width min: maxExtent y / form height) asPoint smoothing: 3].
         contents :=  ('Image extent: ', ext printString) asText,
                                 (String with: Character cr),
                                 (Text string: ' '
                                         attribute: (TextFontReference toFont:
                                                 (FormSetFont new
                                                         fromFormArray: (Array with: form)
                                                         asciiStart: Character space asInteger
                                                         ascent: form height))).
         brevityState := #graphic.
         ^contents!

Item was added:
+ ----- Method: MessageNames>>postAcceptBrowseFor: (in category 'morphic ui') -----
+ postAcceptBrowseFor: anotherModel
+
+        self searchString: anotherModel searchString.!

Item was added:
+ ----- Method: MessageSet>>deleteAllFromMessageList: (in category 'message functions') -----
+ deleteAllFromMessageList: aCollection
+        "Delete the given messages from the receiver's message list"
+        | currIdx |
+        currIdx := self messageListIndex.
+        messageList := messageList copyWithoutAll: aCollection.
+        messageList ifNotEmpty: [self messageListIndex: {currIdx. messageList size.} min]!

Item was added:
+ ----- Method: MessageTrace>>deleteAllFromMessageList: (in category 'building') -----
+ deleteAllFromMessageList: aCollection
+        "Delete the given messages from the receiver's message list"
+
+        | newAutoSelectStrings newMessageSelections newSize set |
+        newSize := self messageList size - aCollection size.
+        newAutoSelectStrings := OrderedCollection new: newSize.
+        newMessageSelections := OrderedCollection new: newSize.
+        set := aCollection asSet.
+        self messageList withIndexDo: [:each :index |
+                (set includes: each) ifFalse:
+                        [newAutoSelectStrings add: (autoSelectStrings at: index).
+                        newMessageSelections add: (messageSelections at: index)]].
+        super deleteAllFromMessageList: aCollection.
+        autoSelectStrings := newAutoSelectStrings.
+        messageSelections := newMessageSelections.
+        anchorIndex ifNotNil:
+                [ anchorIndex := anchorIndex min: messageList size ]!

Item was changed:
  ----- Method: MessageTrace>>removeMessageFromBrowser (in category 'building') -----
  removeMessageFromBrowser
         | indexToSelect |
         "Try to keep the same selection index."
         indexToSelect := (messageSelections indexOf: true) max: 1.
+        self deleteAllFromMessageList: self selectedMessages.
-        self selectedMessages do: [ :eachMethodReference | self deleteFromMessageList: eachMethodReference ].
         self deselectAll.
         messageSelections ifNotEmpty:
                 [ messageSelections
                         at: (indexToSelect min: messageSelections size)  "safety"
                         put: true ].
         anchorIndex := indexToSelect min: messageSelections size.
         self
                 messageListIndex: anchorIndex ;
                 reformulateList!

Item was changed:
  ----- Method: VersionsBrowser class>>browseMethod: (in category 'instance creation') -----
  browseMethod: aCompiledMethod
 
+        ^ (self browseVersionsOf: aCompiledMethod)
+                ifNotNil: [:browser |
+                        browser selectMethod: aCompiledMethod];
-        ^ (self browseVersionsForClass: aCompiledMethod methodClass selector: aCompiledMethod selector)
-                selectMethod: aCompiledMethod;
                 yourself!

Item was added:
+ ----- Method: VersionsBrowser class>>browseVersionsOf: (in category 'instance creation') -----
+ browseVersionsOf: aCompiledMethod
+
+        | methodClass methodSelector |
+        methodClass := aCompiledMethod methodClass.
+        methodSelector := aCompiledMethod selector.
+        ^ self
+                browseVersionsOf: aCompiledMethod
+                class: methodClass
+                meta: methodClass isMeta
+                category: (methodClass organization categoryOfElement: methodSelector)
+                selector: methodSelector!