[Pkg] The Trunk: Tools-mt.645.mcz
commits at source.squeak.org
commits at source.squeak.org
Fri Nov 6 11:10:37 UTC 2015
Marcel Taeumel uploaded a new version of Tools to project The Trunk:
http://source.squeak.org/trunk/Tools-mt.645.mcz
==================== Summary ====================
Name: Tools-mt.645
Author: mt
Time: 6 November 2015, 12:10:12.372 pm
UUID: a9fab090-87fa-4068-84d7-ccc4ab227b80
Ancestors: Tools-mt.644
Makes the preference #balloonHelpInMessageLists functional again.
Applies the preferences "Show message icons" and #balloonHelpInMessageLists also to senders, implementors, message traces, debuggers, etc.
=============== Diff against Tools-mt.644 ===============
Item was changed:
----- Method: Browser>>buildMessageListWith: (in category 'toolbuilder') -----
buildMessageListWith: builder
| listSpec |
listSpec := builder pluggableListSpec new.
listSpec
model: self;
list: #messageList;
getIndex: #messageListIndex;
setIndex: #messageListIndex:;
icon: #messageIconAt:;
+ help: #messageHelpAt:;
menu: #messageListMenu:shifted:;
keyPress: #messageListKey:from:.
SystemBrowser browseWithDragNDrop
ifTrue:[listSpec dragItem: #dragFromMessageList:].
^listSpec
!
Item was added:
+ ----- Method: Browser>>messageHelpAt: (in category 'message list') -----
+ messageHelpAt: anIndex
+ "Show the first n lines of the sources code of the selected message."
+
+ | source formatted lineCount |
+ Preferences balloonHelpInMessageLists ifFalse: [^ nil].
+ self messageList size < anIndex ifTrue: [^ nil].
+
+ source := (self selectedClassOrMetaClass >> (self messageList at: anIndex)) getSource.
+ formatted := SHTextStylerST80 new
+ classOrMetaClass: self selectedClassOrMetaClass;
+ 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>>buildFullWith: (in category 'toolbuilder') -----
buildFullWith: builder
| windowSpec listSpec textSpec |
windowSpec := builder pluggableWindowSpec new
model: self;
label: 'Debugger';
children: OrderedCollection new.
listSpec := builder pluggableListSpec new.
listSpec
model: self;
list: #contextStackList;
getIndex: #contextStackIndex;
setIndex: #toggleContextStackIndex:;
menu: #contextStackMenu:shifted:;
+ icon: #messageIconAt:;
+ help: #messageHelpAt:;
keyPress: #contextStackKey:from:;
frame: (0 at 0 corner: 1 at 0.22).
windowSpec children add: listSpec.
textSpec := self buildCodePaneWith: builder.
textSpec frame: (0 at 0.22corner: 1 at 0.8).
windowSpec children add: textSpec.
listSpec := builder pluggableListSpec new.
listSpec
model: self receiverInspector;
list: #fieldList;
getIndex: #selectionIndex;
setIndex: #toggleIndex:;
menu: #fieldListMenu:;
keyPress: #inspectorKey:from:;
frame: (0 at 0.8 corner: 0.2 at 1).
windowSpec children add: listSpec.
textSpec := builder pluggableTextSpec new.
textSpec
model: self receiverInspector;
getText: #contents;
setText: #accept:;
help: '<- Select receiver''s field' translated;
selection: #contentsSelection;
menu: #codePaneMenu:shifted:;
frame: (0.2 at 0.8 corner: 0.5 at 1).
windowSpec children add: textSpec.
listSpec := builder pluggableListSpec new.
listSpec
model: self contextVariablesInspector;
list: #fieldList;
getIndex: #selectionIndex;
setIndex: #toggleIndex:;
menu: #fieldListMenu:;
keyPress: #inspectorKey:from:;
frame: (0.5 at 0.8 corner: 0.7 at 1).
windowSpec children add: listSpec.
textSpec := builder pluggableTextSpec new.
textSpec
model: self contextVariablesInspector;
getText: #contents;
setText: #accept:;
help: '<- Select context''s field' translated;
selection: #contentsSelection;
menu: #codePaneMenu:shifted:;
frame: (0.7 at 0.8 corner: 1 at 1).
windowSpec children add: textSpec.
^builder build: windowSpec!
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:;
+ 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 added:
+ ----- 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 source formatted lineCount |
+ Preferences balloonHelpInMessageLists ifFalse: [^ nil].
+ contextStack size < anIndex ifTrue: [^ nil].
+
+ method := (contextStack at: anIndex) method.
+
+ source := method getSource.
+ formatted := SHTextStylerST80 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 added:
+ ----- Method: Debugger>>messageIconAt: (in category 'context stack (message list)') -----
+ messageIconAt: anIndex
+
+ Browser showMessageIcons
+ ifFalse: [^ nil].
+
+ ^ ToolIcons iconNamed: (ToolIcons
+ iconForClass: (contextStack at: anIndex) method methodClass
+ selector: (contextStack at: anIndex) method selector)!
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:;
+ help: #messageHelpAt:;
- setIndex: #messageListIndex:;
menu: #messageListMenu:shifted:;
keyPress: #messageListKey:from:.
SystemBrowser browseWithDragNDrop
ifTrue:[listSpec dragItem: #dragFromMessageList:].
^listSpec
!
Item was added:
+ ----- Method: MessageSet>>messageHelpAt: (in category 'message list') -----
+ messageHelpAt: anIndex
+ "Show the first n lines of the sources code of the selected message."
+
+ | reference source formatted lineCount |
+ Preferences balloonHelpInMessageLists ifFalse: [^ nil].
+ self messageList size < anIndex ifTrue: [^ nil].
+
+ reference := self messageList at: anIndex.
+ reference isValid ifFalse: [^ nil].
+
+ source := reference compiledMethod getSource.
+ formatted := SHTextStylerST80 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 added:
+ ----- Method: MessageSet>>messageIconAt: (in category 'message list') -----
+ messageIconAt: anIndex
+
+ Browser showMessageIcons
+ ifFalse: [^ nil].
+
+ ^ ToolIcons iconNamed: (ToolIcons
+ iconForClass: (self messageList at: anIndex) actualClass
+ selector: (self messageList at: anIndex) selector)!
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:;
+ help: #messageHelpAt:;
menu: #messageListMenu:shifted: ;
getSelectionList: #isMessageSelectedAt: ;
setSelectionList: #messageAt:beSelected: ;
keyPress: #messageListKey:from:.
SystemBrowser browseWithDragNDrop
ifTrue: [ listSpec dragItem: #dragFromMessageList: ].
^ listSpec!
Item was removed:
- ----- Method: StringMorph>>balloonTextForClassAndMethodString (in category '*Tools') -----
- balloonTextForClassAndMethodString
- "Answer suitable balloon text for the receiver thought of as an encoding of the form
- <className> [ class ] <selector>"
-
- | aComment |
- Preferences balloonHelpInMessageLists
- ifFalse: [^ nil].
- MessageSet parse: self contents asString toClassAndSelector:
- [:aClass :aSelector |
- (aClass notNil and: [aSelector notNil]) ifTrue:
- [aComment := aClass precodeCommentOrInheritedCommentFor: aSelector]].
- ^ aComment
- !
Item was removed:
- ----- Method: StringMorph>>balloonTextForLexiconString (in category '*Tools') -----
- balloonTextForLexiconString
- "Answer suitable balloon text for the receiver thought of as an encoding (used in Lexicons) of the form
- <selector> <spaces> (<className>>)"
-
- | aComment contentsString aSelector aClassName |
- Preferences balloonHelpInMessageLists
- ifFalse: [^ nil].
- contentsString := self contents asString.
- aSelector := contentsString upTo: $ .
- aClassName := contentsString copyFrom: ((contentsString indexOf: $() + 1) to: ((contentsString indexOf: $)) - 1).
- MessageSet parse: (aClassName, ' dummy') toClassAndSelector:
- [:cl :sel | cl ifNotNil:
- [aComment := cl precodeCommentOrInheritedCommentFor: aSelector]].
- ^ aComment
- !
Item was removed:
- ----- Method: StringMorph>>balloonTextForMethodString (in category '*Tools') -----
- balloonTextForMethodString
- "Answer suitable balloon text for the receiver thought of as a method belonging to the currently-selected class of a browser tool."
-
- | aWindow aCodeHolder aClass |
- Preferences balloonHelpInMessageLists
- ifFalse: [^ nil].
- aWindow := self ownerThatIsA: SystemWindow.
- (aWindow isNil or: [((aCodeHolder := aWindow model) isKindOf: CodeHolder) not])
- ifTrue: [^ nil].
- ((aClass := aCodeHolder selectedClassOrMetaClass) isNil or:
- [(aClass includesSelector: contents asSymbol) not])
- ifTrue: [^ nil].
- ^ aClass precodeCommentOrInheritedCommentFor: contents asSymbol
- !
More information about the Packages
mailing list