The Trunk: Tools-jr.894.mcz

Marcel Taeumel uploaded a new version of Tools to project The Trunk:
http://source.squeak.org/trunk/Tools-jr.894.mcz

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

Name: Tools-jr.894
Author: jr
Time: 21 September 2019, 11:33:52.065709 am
UUID: 7230df17-e4e8-a945-b028-d534271ded3b
Ancestors: Tools-jr.893

Fix error in help balloons for class comments in MessageSet

Also add code to support the other special items: class definition, hierarchy. The text extraction expressions come from MessageSet>>selectedMessage.

Add fallback nil check in messageHelpForMethod:.

=============== Diff against Tools-jr.893 ===============

Item was changed:
  ----- 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 |
+ aMethod ifNil: [^ nil].
- | source formatted lineCount |
  source := aMethod getSource.
  formatted := (Smalltalk classNamed: #SHTextStylerST80)
  ifNil: [ source asText ]
  ifNotNil: [ :textStylerClass |
  textStylerClass new
  classOrMetaClass: aMethod methodClass;
  styledTextFor: source asText ].
+ ^ self messageHelpTruncated: formatted!
-
- 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: CodeHolder>>messageHelpTruncated: (in category 'message list') -----
+ messageHelpTruncated: aText
+ "Show only the first n lines of the text."
+ | formatted lineCount |
+ formatted := aText.
+ lineCount := 0.
+ aText 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>>isClassDefinition: (in category 'message list') -----
+ isClassDefinition: messageListItemOrSymbol
+ "Answer whether this item from the message list (or its extracted selector) indicates a
+ class definition."
+ ^ messageListItemOrSymbol selector = #Definition!

Item was added:
+ ----- Method: MessageSet>>isComment: (in category 'message list') -----
+ isComment: messageListItemOrSymbol
+ "Answer whether this item from the message list (or its extracted selector) indicates a
+ class comment."
+ ^ messageListItemOrSymbol selector = #Comment!

Item was added:
+ ----- Method: MessageSet>>isHierarchy: (in category 'message list') -----
+ isHierarchy: messageListItemOrSymbol
+ "Answer whether this item from the message list (or its extracted selector) indicates a
+ class hierarchy."
+ ^ messageListItemOrSymbol selector = #Hierarchy!

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 |
  Preferences balloonHelpInMessageLists ifFalse: [^ nil].
  self messageList size < anIndex ifTrue: [^ nil].
 
  reference := self messageList at: anIndex.
  reference isValid ifFalse: [^ nil].
+ (self isComment: reference) ifTrue: [^ self messageHelpForComment: reference].
+ (self isClassDefinition: reference) ifTrue: [^ self messageHelpForClassDefinition: reference].
+ (self isHierarchy: reference) ifTrue: [^ self messageHelpForClassHierarchy: reference].
  ^ self messageHelpForMethod: reference compiledMethod!

Item was added:
+ ----- Method: MessageSet>>messageHelpForClassDefinition: (in category 'message list') -----
+ messageHelpForClassDefinition: aMethodReference
+ "Answer the formatted help text for a class definition."
+ ^ aMethodReference setClassAndSelectorIn: [:class :sel | class definition]!

Item was added:
+ ----- Method: MessageSet>>messageHelpForClassHierarchy: (in category 'message list') -----
+ messageHelpForClassHierarchy: aMethodReference
+ "Answer the formatted help text for a class hierarchy."
+ "Show the first n lines of the class hierarchy."
+ | source |
+ source := aMethodReference setClassAndSelectorIn: [:class :sel | class printHierarchy].
+ ^ self messageHelpTruncated: source asText!

Item was added:
+ ----- Method: MessageSet>>messageHelpForComment: (in category 'message list') -----
+ messageHelpForComment: aMethodReference
+ "Answer the formatted help text for a class comment."
+ "Show the first n lines of the class comment."
+ | source |
+ source := aMethodReference setClassAndSelectorIn: [:class :sel | class comment].
+ ^ self messageHelpTruncated: source asText!