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

commits at source.squeak.org commits at source.squeak.org
Tue Jan 11 08:45:36 UTC 2022


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

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

Name: Tools-mt.1101
Author: mt
Time: 11 January 2022, 9:45:33.663724 am
UUID: a26d9da7-dbb4-473b-ac22-713303b30480
Ancestors: Tools-ct.1100

Extends protocol for browsing senders/implementors to enable models to consider a 'requestor'. Use this to fix a regression in MessageTrace tool, which discriminates between browse-senders/implementors requests that originate either from the message list or the text/code field.

=============== Diff against Tools-ct.1100 ===============

Item was changed:
  ----- Method: CodeHolder>>browseImplementors (in category 'commands') -----
  browseImplementors
+ 	"Create and schedule a message set browser on all implementors of the currently selected message selector. If there is no message currently selected, offer a type-in"
- 	"Create and schedule a message set browser on all implementors of the currently selected message selector. Do nothing if no message is selected."
  
+ 	self sendQuery: #browseAllImplementorsOf:requestor: to: self with: #(modelMenu).!
- 	| aMessageName |
- 	(aMessageName := self selectedMessageName) ifNotNil: 
- 		[self systemNavigation browseAllImplementorsOf: aMessageName]!

Item was changed:
  ----- Method: CodeHolder>>browseSenders (in category 'commands') -----
  browseSenders
+ 	"Create and schedule a message set browser on all senders of the currently selected message selector. If there is no message currently selected, offer a type-in"
- 	"Create and schedule a message set browser on all senders of the currently selected message selector.  Of there is no message currently selected, offer a type-in"
  
+ 	self sendQuery: #browseAllCallsOn:requestor: to: self with: #(modelMenu).!
- 	self sendQuery: #browseAllCallsOn: to: self systemNavigation!

Item was changed:
  ----- Method: CodeHolder>>getSelectorAndSendQuery:to: (in category 'misc') -----
  getSelectorAndSendQuery: querySelector to: queryPerformer
+ 	"See commentary in #getSelectorAndSendQuery:to:with:."
- 	"Obtain a selector relevant to the current context, and then send the querySelector to the queryPerformer with the selector obtained as its argument.  If no message is currently selected, then obtain a method name from a user type-in"
  
+ 	^ self getSelectorAndSendQuery: querySelector to: queryPerformer with: {}!
- 	self getSelectorAndSendQuery: querySelector to: queryPerformer with: { }.
- !

Item was changed:
  ----- Method: CodeHolder>>getSelectorAndSendQuery:to:with: (in category 'misc') -----
  getSelectorAndSendQuery: querySelector to: queryPerformer with: queryArgs
+ 	"Obtain a selector relevant to the current context, and then send the querySelector to the queryPerformer with the selector obtained and queryArgs as its arguments."
- 	"Obtain a selector relevant to the current context, and then send the querySelector to the queryPerformer with the selector obtained and queryArgs as its arguments.  If no message is currently selected, then obtain a method name from a user type-in"
  
+ 	^ self selectedMessageName
+ 		ifNotNil: [ "We have a message. Let the user choose a symbol from its contents."
+ 			self selectMessageAndEvaluate: [ :aSymbol |
+ 				queryPerformer
+ 					perform: querySelector
+ 					withArguments: {aSymbol}, queryArgs ]]
+ 		ifNil: [ "No message currently selected. Obtain a selector from a user type-in."
+ 			(Project uiManager request: 'Type selector:' initialAnswer: 'flag:')
+ 				ifEmpty: [ nil "Cancelled by user" ]
+ 				ifNotEmpty: [ :typeIn | | selectorString |
+ 					(Symbol lookup: (selectorString := typeIn asLegalSelector))
+ 						ifNil: [ self inform: 'There is no symbol known as #', selectorString ]
+ 						ifNotNil: [ :aSymbol |
+ 							queryPerformer
+ 								perform: querySelector
+ 								withArguments: {aSymbol}, queryArgs ] ]]!
- 	| strm array |
- 	strm := WriteStream on: (array := Array new: queryArgs size + 1).
- 	strm nextPut: nil.
- 	strm nextPutAll: queryArgs.
- 
- 	self selectedMessageName ifNil: [ | selector |
- 		selector := UIManager default request: 'Type selector:' initialAnswer: 'flag:'.
- 		selector := selector copyWithout: Character space.
- 		^ selector isEmptyOrNil ifFalse: [
- 			(Symbol hasInterned: selector
- 				ifTrue: [ :aSymbol |
- 					array at: 1 put: aSymbol.
- 					queryPerformer perform: querySelector withArguments: array])
- 				ifFalse: [ self inform: 'no such selector']
- 		]
- 	].
- 
- 	self selectMessageAndEvaluate: [:selector |
- 		array at: 1 put: selector.
- 		queryPerformer perform: querySelector withArguments: array
- 	]!

Item was changed:
  ----- Method: CodeHolder>>messageListKey:from: (in category 'message list menu') -----
  messageListKey: aChar from: view
+ 	"Overwritten to add more code-specific commands."
+ 
- 	"Respond to a Command key.  I am a model with a code pane, and I also
- 	have a listView that has a list of methods.  The view knows how to get
- 	the list and selection."
- 	| sel class |
- 	aChar == $D ifTrue: [^ self toggleDiffing].
- 	sel := self selectedMessageName.
- 	aChar == $m ifTrue:  "These next two put up a type in if no message selected"
- 		[^ self useSelector: sel orGetSelectorAndSendQuery: #browseAllImplementorsOf: to: self ].
- 	aChar == $n ifTrue: 
- 		[^ self useSelector: sel orGetSelectorAndSendQuery: #browseAllCallsOn: to: self ].
  	aChar == $d ifTrue: [^ self removeMessageFromBrowser].
+ 
+ 	self selectedClassOrMetaClass ifNotNil: [
+ 		aChar == $r ifTrue: [^ self browseVariableReferences].
+ 		aChar == $a ifTrue: [^ self browseVariableAssignments].
+ 		(aChar == $Y and: [self canShowMultipleMessageCategories])
+ 			ifTrue: [^ self showHomeCategory]].
+ 
+ 	^ super messageListKey: aChar from: view!
- 	"The following require a class selection"
- 	(class := self selectedClassOrMetaClass) ifNil: [^ self arrowKey: aChar from: view].
- 	aChar == $b ifTrue: [^ ToolSet browse: class selector: sel].
- 	aChar == $N ifTrue: [^ self browseClassRefs].
- 	aChar == $i ifTrue: [^ self methodHierarchy].
- 	aChar == $h ifTrue: [^ self browseClassHierarchy].
- 	aChar == $p ifTrue: [^ self browseFullProtocol].
- 	aChar == $r ifTrue: [^ self browseVariableReferences].
- 	aChar == $a ifTrue: [^ self browseVariableAssignments].
- 	(aChar == $Y and: [self canShowMultipleMessageCategories])
- 		ifTrue: [^ self showHomeCategory].
- 	"The following require a method selection"
- 	sel ifNotNil: 
- 		[aChar == $o ifTrue: [^ self fileOutMessage].
- 		aChar == $c ifTrue: [^ self copySelector].
- 		aChar == $v ifTrue: [^ self browseVersions].
- 		aChar == $x ifTrue: [^ self removeMessage].
- 		aChar == $C ifTrue: [ self copyReference ]].
- 	^ self arrowKey: aChar from: view!

Item was changed:
  ----- Method: CodeHolder>>sendQuery:to: (in category 'misc') -----
  sendQuery: querySelector to: queryPerformer
+ 	"See commentary in #sendQuery:to:with:."
- 	"Apply a query to the primary selector associated with the current context.  If no such selection exists, obtain one by user type-in. Then send querySelector to queryPerformer with the selector as its argument."
  
+ 	^ self sendQuery: querySelector to: queryPerformer with: { }!
- 	| aSelector aString |
- 	aSelector := self selectedMessageName ifNil:
- 		[aString :=UIManager default request: 'Type selector:' initialAnswer: 'flag:'.
- 		^ aString isEmptyOrNil ifFalse:
- 			[(Symbol hasInterned: aString ifTrue:
- 				[:aSymbol | queryPerformer perform: querySelector with: aSymbol])
- 				ifFalse:
- 					[self inform: 'no such selector']]].
- 
- 	queryPerformer perform: querySelector with: aSelector!

Item was added:
+ ----- Method: CodeHolder>>sendQuery:to:with: (in category 'misc') -----
+ sendQuery: querySelector to: queryPerformer with: queryArgs
+ 	"Apply a query to the primary selector associated with the current context.  If no such selection exists, obtain one by user type-in. Then send querySelector to queryPerformer with the selector as its argument. Unlike #getSelectorAndSendQuery:to:with:, DO NOT let the user choose from the list of known symbols inside the selected context/message."
+ 
+ 	^ self selectedMessageName
+ 		ifNotNil: [ :aSymbol | "We have a message name. Use it directly."
+ 			queryPerformer
+ 				perform: querySelector
+ 				withArguments: {aSymbol}, queryArgs ]
+ 		ifNil: [ "No message currently selected. Obtain a selector from a user type-in."
+ 			(Project uiManager request: 'Type selector:' initialAnswer: 'flag:')
+ 				ifEmpty: [ nil "Cancelled by user" ]
+ 				ifNotEmpty: [ :typeIn | | selectorString |
+ 					(Symbol lookup: (selectorString := typeIn asLegalSelector))
+ 						ifNil: [ self inform: 'There is no symbol known as #', selectorString ]
+ 						ifNotNil: [ :aSymbol |
+ 							queryPerformer
+ 								perform: querySelector
+ 								withArguments: {aSymbol}, queryArgs ] ]]!

Item was changed:
  ----- Method: CodeHolder>>useSelector:orGetSelectorAndSendQuery:to: (in category 'misc') -----
  useSelector: incomingSelector orGetSelectorAndSendQuery: querySelector to: queryPerformer
- 	"If incomingSelector is not nil, use it, else obtain a selector from user type-in.   Using the determined selector, send the query to the performer provided."
  
+ 	self flag: #deprecated.
+ 	self selectedMessageName = incomingSelector
+ 		ifFalse: [^ self notify: 'This protocol is not supported anymore. Please revise using #seletedMessageName and either #sendQuery:to:with: or #getSelectorAndSendQuery:to:with:.'].
+ 	
+ 	^ self sendQuery: querySelector to: queryPerformer!
- 	| aSelector |
- 	incomingSelector
- 		ifNotNil:
- 			[queryPerformer perform: querySelector with: incomingSelector]
- 		ifNil:
- 			[aSelector :=UIManager default request: 'Type selector:' initialAnswer: 'flag:'.
- 			aSelector isEmptyOrNil ifFalse:
- 				[(Symbol hasInterned: aSelector ifTrue:
- 					[:aSymbol | queryPerformer perform: querySelector with: aSymbol])
- 					ifFalse:
- 						[self inform: 'no such selector']]]!

Item was removed:
- ----- Method: MessageTrace>>browseAllCallsOn: (in category 'actions') -----
- browseAllCallsOn: selectorSymbol
- 	(self hasUnacceptedEdits or: [ Preferences traceMessages not ])
- 		ifTrue: [ super browseAllCallsOn: selectorSymbol ]
- 		ifFalse: [ self addParentMethodsSending: selectorSymbol ]!

Item was added:
+ ----- Method: MessageTrace>>browseAllCallsOn:requestor: (in category 'actions') -----
+ browseAllCallsOn: selectorSymbol requestor: anObject
+ 	"Overwritten to modify the trace if the request origins from a model-menu command such as the message-list menu (shortcut)."
+ 	
+ 	(anObject = #modelMenu and: [ Preferences traceMessages ] and: [ self hasUnacceptedEdits not ])
+ 		ifTrue: [ self addParentMethodsSending: selectorSymbol ]
+ 		ifFalse: [ super browseAllCallsOn: selectorSymbol requestor: anObject ].!

Item was removed:
- ----- Method: MessageTrace>>browseAllImplementorsOf: (in category 'actions') -----
- browseAllImplementorsOf: selectorSymbol
- 	| selectorToBrowse |
- 	selectorToBrowse := self selection 
- 		ifNil: [ selectorSymbol ] 
- 		ifNotNil: [ self getImplementorNamed: selectorSymbol asSymbol "since we can get passed literals"].
- 	(self hasUnacceptedEdits or: [ Preferences traceMessages not ])
- 		ifTrue: [ super browseAllImplementorsOf: selectorToBrowse ]
- 		ifFalse: [ self addChildMethodsNamed: selectorToBrowse ]
- !

Item was added:
+ ----- Method: MessageTrace>>browseAllImplementorsOf:requestor: (in category 'actions') -----
+ browseAllImplementorsOf: selectorSymbol requestor: anObject
+ 	"Overwritten to modify the trace if the request origins from a model-menu command such as the message-list menu (shortcut)."
+ 
+ 	| selectorToBrowse |
+ 	selectorToBrowse := self selection 
+ 		ifNil: [ selectorSymbol ] 
+ 		ifNotNil: [ self getImplementorNamed: selectorSymbol asSymbol "since we can get passed literals"].
+ 	(anObject = #modelMenu and: [ Preferences traceMessages ] and: [ self hasUnacceptedEdits not ])
+ 		ifTrue: [ self addChildMethodsNamed: selectorToBrowse ]
+ 		ifFalse: [ super browseAllImplementorsOf: selectorToBrowse requestor: anObject ].!

Item was changed:
  ----- Method: Object>>browseAllCallsOn: (in category '*Tools-MessageSets') -----
  browseAllCallsOn: selectorSymbol
+ 	"A tool's widget/view (i.e., 'requestor') requested to browse the calls on selectorSymbol. By default, let #systemNavigation handle it."
+ 
+ 	self flag: #todo. "mt: Push down to Model but check non-Model tools such as TranscriptStream."
- 	"Models get the first chance to handle this, so a message-tracer can be built..  Not all Tool 'models' inherit from Model, otherwise this would be there."
  	self systemNavigation browseAllCallsOn: selectorSymbol!

Item was added:
+ ----- Method: Object>>browseAllCallsOn:requestor: (in category '*Tools-MessageSets') -----
+ browseAllCallsOn: selectorSymbol requestor: anObject
+ 	"A tool's widget/view (i.e., 'requestor') requested to browse the calls on selectorSymbol. By default, let #systemNavigation handle it."
+ 
+ 	self flag: #todo. "mt: Push down to Model but check non-Model tools such as TranscriptStream."
+ 	self browseAllCallsOn: selectorSymbol!

Item was changed:
  ----- Method: Object>>browseAllImplementorsOf: (in category '*Tools-MessageSets') -----
  browseAllImplementorsOf: selectorSymbol
+ 	"A tool's widget/view (i.e., 'requestor') requested to browse the implementors of selectorSymbol. By default, let #systemNavigation handle it."
+ 
+ 	self flag: #todo. "mt: Push down to Model but check non-Model tools such as TranscriptStream."
+ 	self systemNavigation browseAllImplementorsOf: selectorSymbol.!
- 	"Models get first chance to handle browseAllImplementorsOf:, so a tracing-messages browser can be built..  Not all Tool 'models' inherit from Model, otherwise this would be there."
- 	self systemNavigation browseAllImplementorsOf: selectorSymbol!

Item was added:
+ ----- Method: Object>>browseAllImplementorsOf:requestor: (in category '*Tools-MessageSets') -----
+ browseAllImplementorsOf: selectorSymbol requestor: anObject
+ 	"A tool's widget/view (i.e., 'requestor') requested to browse the implementors of selectorSymbol. By default, let #systemNavigation handle it."
+ 
+ 	self flag: #todo. "mt: Push down to Model but check non-Model tools such as TranscriptStream."
+ 	self browseAllImplementorsOf: selectorSymbol.!

Item was added:
+ ----- Method: StringHolder>>browseImplementors (in category '*Tools') -----
+ browseImplementors
+ 
+ 	self browseAllImplementorsOf: self selectedMessageName requestor: #modelMenu.!

Item was added:
+ ----- Method: StringHolder>>browseSenders (in category '*Tools') -----
+ browseSenders
+ 
+ 	self browseAllCallsOn: self selectedMessageName requestor: #modelMenu.!

Item was changed:
  ----- Method: StringHolder>>messageListKey:from: (in category '*Tools') -----
  messageListKey: aChar from: view
  	"Respond to a Command key.  I am a model with a code pane, and I also
  	have a listView that has a list of methods.  The view knows how to get
  	the list and selection."
  
  	| sel class |
  	aChar == $D ifTrue: [^ self toggleDiffing].
  
+ 	aChar == $m ifTrue: [^ self browseImplementors].
+ 	aChar == $n ifTrue: [^ self browseSenders].
- 	sel := self selectedMessageName.
- 	aChar == $m ifTrue:  "These next two put up a type in if no message selected"
- 		[^ self useSelector: sel orGetSelectorAndSendQuery: #browseAllImplementorsOf: to: self systemNavigation].
- 	aChar == $n ifTrue: 
- 		[^ self useSelector: sel orGetSelectorAndSendQuery: #browseAllCallsOn: to: self systemNavigation].
  
  	"The following require a class selection"
+ 	sel := self selectedMessageName.
  	(class := self selectedClassOrMetaClass) ifNil: [^ self arrowKey: aChar from: view].
  	aChar == $b ifTrue: [^ ToolSet browse: class selector: sel].
  	aChar == $N ifTrue: [^ self browseClassRefs].
  	aChar == $i ifTrue: [^ self methodHierarchy].
  	aChar == $h ifTrue: [^ self browseClassHierarchy].
  	aChar == $p ifTrue: [^ self browseFullProtocol].
  
  	"The following require a method selection"
  	sel ifNotNil: 
  		[aChar == $o ifTrue: [^ self fileOutMessage].
  		aChar == $c ifTrue: [^ self copySelector].
  		aChar == $C ifTrue: [^ self copyReference].
  		aChar == $v ifTrue: [^ self browseVersions].
  		aChar == $x ifTrue: [^ self removeMessage]].
  
  	^ self arrowKey: aChar from: view!



More information about the Squeak-dev mailing list