[squeak-dev] The Trunk: Tools-mt.873.mcz

commits at source.squeak.org commits at source.squeak.org
Wed Aug 14 08:39:17 UTC 2019


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

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

Name: Tools-mt.873
Author: mt
Time: 14 August 2019, 10:39:15.970413 am
UUID: 1f4b3949-301d-da40-b7f1-ed3254d625b7
Ancestors: Tools-mt.872, Tools-jr.860

Merges Tools-jr.860.

No need for #messageHelpFor: anymore. #messageHelpAt: (widget-to-model callback) and #messageHelpForMethod: (method-to-text lookup) are the extension points.

It think it is not necessary to deprecate #messageHelpFor:.

=============== Diff against Tools-mt.872 ===============

Item was changed:
  ----- Method: Browser>>messageHelpAt: (in category 'message list') -----
  messageHelpAt: anIndex
  	"Show the first n lines of the sources code of the selected message."
+ 	
+ 	| iconHelp method |
  	Preferences balloonHelpInMessageLists ifFalse: [^ nil].
  	self messageList size < anIndex ifTrue: [^ nil].
+ 	
+ 	method := self selectedClassOrMetaClass compiledMethodAt: (self messageList at: anIndex).
+ 	iconHelp := (self messageIconHelpFor: method selector) ifNotEmpty: [:t | 
+ 		t , Character cr, Character cr].
+ 	
+ 	^ iconHelp asText
+ 		append: (self messageHelpForMethod: method);
+ 		yourself!
- 	^ self messageHelpFor: (self messageList at: anIndex)
- !

Item was removed:
- ----- Method: Browser>>messageHelpFor: (in category 'message list') -----
- messageHelpFor: aSelector 
- 	"Show the first n lines of the sources code of the message behind aSelector."
- 	
- 	| source formatted iconHelp |
- 	Preferences balloonHelpInMessageLists ifFalse: [^ nil].
- 
- 	source := self selectedClassOrMetaClass sourceCodeAt: aSelector ifAbsent: [^ nil].
- 	source lineCount > 5 ifTrue: [
- 		| sourceLines |
- 		sourceLines := (source asString lines copyFrom: 1 to: 5) asOrderedCollection.
- 		sourceLines add: ' [...]'.
- 		source := sourceLines joinSeparatedBy: Character cr].
- 
- 	
- 	formatted := (Smalltalk classNamed: #SHTextStylerST80)
- 		ifNil: [ source asText ]
- 		ifNotNil: [ :textStylerClass |
- 			textStylerClass new
- 				classOrMetaClass: self selectedClassOrMetaClass;
- 				styledTextFor: source asText ].
- 	iconHelp := (self messageIconHelpFor: aSelector) ifNotEmpty: [:t | 
- 		t , Character cr, Character cr].
- 	^ iconHelp asText
- 		append: formatted;
- 		yourself!

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: #messageListFormatted;
  		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>>contents:notifying: (in category 'private') -----
  contents: aString notifying: aController 
  	"Compile the code in aString. Notify aController of any syntax errors. 
  	Answer false if the compilation fails. Otherwise, if the compilation 
  	created a new method, deselect the current selection. Then answer true."
  
+ 	| category class oldSelector |
- 	| category selector class oldSelector |
  	self okayToAccept ifFalse: [^ false].
+ 	class := self targetForContents: aString.
- 	self setClassAndSelectorIn: [:c :os | class := c.  oldSelector := os].
  	class ifNil: [^ false].
+ 	self setClassAndSelectorIn: [:c :os | oldSelector := os].
+ 	(self contents: aString specialSelector: oldSelector in: class notifying: aController)
+ 		ifTrue: [^ false].
- 	(oldSelector ~~ nil and: [oldSelector first isUppercase]) ifTrue:
- 		[oldSelector = #Comment ifTrue:
- 			[class comment: aString stamp: Utilities changeStamp.
- 			self changed: #annotation.
-  			self clearUserEditFlag.
- 			^ false].
- 		oldSelector = #Definition ifTrue:
- 			["self defineClass: aString notifying: aController."
- 			class subclassDefinerClass
- 				evaluate: aString
- 				notifying: aController
- 				logged: true.
- 			self clearUserEditFlag.
-  			^ false].
- 		oldSelector = #Hierarchy ifTrue:
- 			[self inform: 'To change the hierarchy, edit the class definitions'. 
- 			^ false]].
  	"Normal method accept"
+ 	category := self selectedMessageCategoryName.
+ 	^ self contents: aString
+ 		oldSelector: oldSelector
+ 		in: class
+ 		classified: category
+ 		notifying: aController!
- 	category := class organization categoryOfElement: oldSelector.
- 	selector := class compile: aString
- 				classified: category
- 				notifying: aController.
- 	selector == nil ifTrue: [^ false].
- 	self noteAcceptanceOfCodeFor: selector.
- 	selector == oldSelector ifFalse:
- 		[self reformulateListNoting: selector].
- 	contents := aString copy.
- 	self changed: #annotation.
- 	^ true!

Item was added:
+ ----- Method: MessageSet>>contents:oldSelector:in:classified:notifying: (in category 'private') -----
+ contents: aString oldSelector: oldSelector in: aClass classified: category notifying: aController
+ 	"Compile the code in aString. Notify aController of any syntax errors. 
+ 	Answer false if the compilation fails. Otherwise, if the compilation 
+ 	created a new method, deselect the current selection. Then answer true."
+ 	| selector |
+ 	selector := aClass compile: aString
+ 				classified: category
+ 				notifying: aController.
+ 	selector == nil ifTrue: [^ false].
+ 	self noteAcceptanceOfCodeFor: selector.
+ 	selector == oldSelector ifFalse:
+ 		[self reformulateListNoting: selector].
+ 	contents := aString copy.
+ 	self changed: #annotation.
+ 	^ true!

Item was added:
+ ----- Method: MessageSet>>contents:specialSelector:in:notifying: (in category 'private') -----
+ contents: aString specialSelector: oldSelector in: aClass notifying: aController
+ 	"If the selector is a fake to denote a different definition than that of a method,
+ 	try to change that different object. Answer whether a special selector was found and
+ 	handled."
+ 	(oldSelector ~~ nil and: [oldSelector first isUppercase]) ifFalse: [^ false].
+ 	oldSelector = #Comment ifTrue:
+ 		[aClass comment: aString stamp: Utilities changeStamp.
+ 		self changed: #annotation.
+  			self clearUserEditFlag.
+ 		^ true].
+ 	oldSelector = #Definition ifTrue:
+ 		["self defineClass: aString notifying: aController."
+ 		aClass subclassDefinerClass
+ 			evaluate: aString
+ 			notifying: aController
+ 			logged: true.
+ 		self clearUserEditFlag.
+  			^ true].
+ 	oldSelector = #Hierarchy ifTrue:
+ 		[self inform: 'To change the hierarchy, edit the class definitions'. 
+ 		^ true].
+ 	^ false!

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 added:
+ ----- Method: MessageSet>>targetForContents: (in category 'private') -----
+ targetForContents: aString
+ 	"Answer the behavior into which the contents will be accepted."
+ 	self setClassAndSelectorIn: [:c :os | ^ c].
+ 	^ nil "fail safe for overriding implementations of setClassAndSelectorIn:"!

Item was changed:
  ----- Method: MessageTrace>>buildMessageListWith: (in category 'private initializing') -----
  buildMessageListWith: builder
  	| listSpec |
  	listSpec := builder pluggableAlternateMultiSelectionListSpec new.
  	listSpec 
  		model: self ;
  		list: #messageListFormatted ;
  		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