[squeak-dev] The Inbox: Tools-jr.860.mcz
commits at source.squeak.org
commits at source.squeak.org
Sat Aug 10 18:27:36 UTC 2019
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!
More information about the Squeak-dev
mailing list
|