The Inbox: Tools-jr.860.mcz

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

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

Name: Tools-jr.860
Author: jr
Time: 10 August 2019, 8:27:40.074208 pm
UUID: 6e619c24-626c-3546-97a5-b5d42521f625
Ancestors: Tools-jr.859

Deduplicate code for message list help texts

Also fix tool building code that did not use the correct setter for the list item help selector.

=============== Diff against Tools-jr.859 ===============

Item was added:
+ ----- Method: CodeHolder>>messageHelpForMethod: (in category 'message list') -----
+ messageHelpForMethod: aMethod
+       "Answer the formatted help text for a method."
+       "Show the first n lines of the source code of the method."
+       | source formatted lineCount |
+       source := aMethod getSource.
+       formatted := (Smalltalk classNamed: #SHTextStylerST80)
+               ifNil: [ source asText ]
+               ifNotNil: [ :textStylerClass |
+                       textStylerClass new
+                               classOrMetaClass: aMethod methodClass;
+                               styledTextFor: source asText ].
+       
+       lineCount := 0.
+       source doWithIndex: [:char :index |
+               char = Character cr ifTrue: [lineCount := lineCount + 1].
+               lineCount > 10 ifTrue: [
+                       formatted := formatted copyFrom: 1 to: index-1.
+                       formatted append: ' [...]'.
+                       ^ formatted]].
+
+       ^ formatted!

Item was changed:
  ----- Method: Debugger>>buildNotifierWith:label:message: (in category 'toolbuilder') -----
  buildNotifierWith: builder label: label message: messageString
        | windowSpec listSpec textSpec panelSpec quads |
        windowSpec := builder pluggableWindowSpec new
                model: self;
                extent: self initialExtentForNotifier;
                label: label;
                children: OrderedCollection new.

        panelSpec := builder pluggablePanelSpec new.
        panelSpec children: OrderedCollection new.
        quads := self preDebugButtonQuads.
        (self interruptedContext selector == #doesNotUnderstand:) ifTrue: [
                quads := quads copyWith:
                        { 'Create'. #createMethod. #magenta. 'create the missing method' }
        ].
        (#(#notYetImplemented #shouldBeImplemented #requirement) includes: self interruptedContext selector) ifTrue: [
                quads := quads copyWith:
                        { 'Create'. #createImplementingMethod. #magenta. 'implement the marked method' }
        ].
        (self interruptedContext selector == #subclassResponsibility) ifTrue: [
                quads := quads copyWith:
                        { 'Create'. #createOverridingMethod. #magenta. 'create the missing overriding method' }
        ].
        quads do:[:spec| | buttonSpec |
                buttonSpec := builder pluggableButtonSpec new.
                buttonSpec model: self.
                buttonSpec label: spec first.
                buttonSpec action: spec second.
                buttonSpec help: spec fourth.
                panelSpec children add: buttonSpec.
        ].
        panelSpec layout: #horizontal. "buttons"
        panelSpec frame: self preDebugButtonQuadFrame.
        windowSpec children add: panelSpec.

        Preferences eToyFriendly | messageString notNil ifFalse:[
                listSpec := builder pluggableListSpec new.
                listSpec
                        model: self;
                        list: #contextStackList;
                        getIndex: #contextStackIndex;
                        setIndex: #debugAt:;
                        icon: #messageIconAt:;
+                       helpItem: #messageHelpAt:;
-                       help: #messageHelpAt:;
                        frame: self contextStackFrame.
                windowSpec children add: listSpec.
        ] ifTrue:[
                message := messageString.
                textSpec := builder pluggableTextSpec new.
                textSpec
                        model: self;
                        getText: #preDebugMessageString;
                        setText: nil;
                        selection: nil;
                        menu: #debugProceedMenu:;
                        frame: self contextStackFrame.
                windowSpec children add: textSpec.
        ].

        ^windowSpec!

Item was changed:
  ----- Method: Debugger>>messageHelpAt: (in category 'context stack (message list)') -----
  messageHelpAt: anIndex
        "Show the first n lines of the sources code of the selected message."

+       | method |
-       | method source formatted lineCount |
        Preferences balloonHelpInMessageLists ifFalse: [^ nil].
        contextStack size < anIndex ifTrue: [^ nil].

        method := (contextStack at: anIndex) method.
+       ^ self messageHelpForMethod: method.!
-       
-       source := method getSource.
-       formatted := (Smalltalk classNamed: #SHTextStylerST80)
-               ifNil: [ source asText ]
-               ifNotNil: [ :textStylerClass |
-                       textStylerClass new
-                               classOrMetaClass: method methodClass;
-                               styledTextFor: source asText ].
-       
-       lineCount := 0.
-       source doWithIndex: [:char :index |
-               char = Character cr ifTrue: [lineCount := lineCount + 1].
-               lineCount > 10 ifTrue: [
-                       formatted := formatted copyFrom: 1 to: index-1.
-                       formatted append: ' [...]'.
-                       ^ formatted]].
-
-       ^ formatted!

Item was changed:
  ----- Method: MessageSet>>buildMessageListWith: (in category 'toolbuilder') -----
  buildMessageListWith: builder
        | listSpec |
        listSpec := builder pluggableListSpec new.
        listSpec
                model: self;
                list: #messageList;
                getIndex: #messageListIndex;
                setIndex: #messageListIndex:;
                icon: #messageIconAt:;
+               helpItem: #messageHelpAt:;
-               help: #messageHelpAt:;
                menu: #messageListMenu:shifted:;
                keyPress: #messageListKey:from:.
        SystemBrowser browseWithDragNDrop
                ifTrue:[listSpec dragItem: #dragFromMessageList:].
        ^listSpec
  !

Item was changed:
  ----- Method: MessageSet>>messageHelpAt: (in category 'message list') -----
  messageHelpAt: anIndex
        "Show the first n lines of the sources code of the selected message."

+       | reference |
-       | reference source formatted lineCount |
        Preferences balloonHelpInMessageLists ifFalse: [^ nil].
        self messageList size < anIndex ifTrue: [^ nil].

        reference := self messageList at: anIndex.
        reference isValid ifFalse: [^ nil].
+       ^ self messageHelpForMethod: reference compiledMethod!
-       
-       source := reference compiledMethod getSource.
-       formatted := (Smalltalk classNamed: #SHTextStylerST80)
-               ifNil: [ source asText ]
-               ifNotNil: [ :textStylerClass |
-                       textStylerClass new
-                               classOrMetaClass: reference actualClass;
-                               styledTextFor: source asText ].
-       
-       lineCount := 0.
-       source doWithIndex: [:char :index |
-               char = Character cr ifTrue: [lineCount := lineCount + 1].
-               lineCount > 10 ifTrue: [
-                       formatted := formatted copyFrom: 1 to: index-1.
-                       formatted append: ' [...]'.
-                       ^ formatted]].
-
-       ^ formatted!

Item was changed:
  ----- 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: ;
                icon: #messageIconAt:;
+               helpItem: #messageHelpAt:;
-               help: #messageHelpAt:;
                menu: #messageListMenu:shifted: ;
                getSelectionList: #isMessageSelectedAt: ;
                setSelectionList: #messageAt:beSelected: ;
                keyPress: #messageListKey:from:.
        SystemBrowser browseWithDragNDrop
                ifTrue: [ listSpec dragItem: #dragFromMessageList: ].
        ^ listSpec!

Item was changed:
  ----- Method: TimeProfileBrowser>>messageHelpAt: (in category 'message list') -----
  messageHelpAt: anIndex
        "Show the first n lines of the sources code of the selected message."

+       | reference |
-       | reference source formatted lineCount |
        Preferences balloonHelpInMessageLists ifFalse: [^ nil].
        self messageList size < anIndex ifTrue: [^ nil].

        reference := (self methodReferences at: anIndex) ifNil: [ ^nil ].
        reference isValid ifFalse: [ ^nil ].
+       ^ self messageHelpForMethod: reference compiledMethod!
-       
-       source := reference compiledMethod getSource.
-       formatted := (Smalltalk classNamed: #SHTextStylerST80)
-               ifNil: [ source asText ]
-               ifNotNil: [ :textStylerClass |
-                       textStylerClass new
-                               classOrMetaClass: reference actualClass;
-                               styledTextFor: source asText ].
-       
-       lineCount := 0.
-       source doWithIndex: [:char :index |
-               char = Character cr ifTrue: [lineCount := lineCount + 1].
-               lineCount > 10 ifTrue: [
-                       formatted := formatted copyFrom: 1 to: index-1.
-                       formatted append: ' [...]'.
-                       ^ formatted]].
-
-       ^ formatted!