[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