The Trunk: Tools-mt.645.mcz

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@0 corner: 1@0.22).
  windowSpec children add: listSpec.
 
 
  textSpec := self buildCodePaneWith: builder.
  textSpec frame: (0@0.22corner: 1@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@0.8 corner: 0.2@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@0.8 corner: 0.5@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@0.8 corner: 0.7@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@0.8 corner: 1@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
- !

Here is an example for the debugger's notifier window with both preferences enabled.



Best,
Marcel

Hmm... our list morphs do not support embedding interactive morphs (i.e. radio/toggle buttons) yet...

Best,
Marcel