The Inbox: Tools-jr.860.mcz

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
2 messages Options
Reply | Threaded
Open this post in threaded view
|

The Inbox: Tools-jr.860.mcz

commits-2
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!


Reply | Threaded
Open this post in threaded view
|

Re: The Inbox: Tools-jr.860.mcz

Jakob Reschke
Originally, Browser had the same code duplication, but its messageHelpAt: method was changed in 2015 and part of it extracted in 2016. If we want to reconcile the Browser code with the one in this version to further reduce duplication, Browser messageHelpFor: (takes a selector as argument) and CodeHolder messageHelpForMethod: (takes a CompiledMethod or similar as argument) will need to be merged.

Am Sa., 10. Aug. 2019 um 20:27 Uhr schrieb <[hidden email]>:
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!