[squeak-dev] The Trunk: ST80-mt.246.mcz

commits at source.squeak.org commits at source.squeak.org
Wed Dec 4 09:32:22 UTC 2019


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

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

Name: ST80-mt.246
Author: mt
Time: 4 December 2019, 10:32:14.954613 am
UUID: 7435a337-bf82-46b4-b44d-de17edd88aae
Ancestors: ST80-jr.245

Replicates the functionality as of Morphic-mt.1599 regarding "senders of it" and "references to it".

=============== Diff against ST80-jr.245 ===============

Item was changed:
  ----- Method: ParagraphEditor>>lineSelectAndEmptyCheck: (in category 'menu messages') -----
  lineSelectAndEmptyCheck: returnBlock
  	"If the current selection is an insertion point, expand it to be the entire current line; if after that's done the selection is still empty, then evaluate the returnBlock, which will typically consist of '[^ self]' in the caller -- check senders of this method to understand this."
  
+ 	self hasSelection ifFalse: [
+ 		self selectLine.
+ 		self hasSelection ifFalse: [
+ 			self flash. 
+ 			^ returnBlock value]].!
- 	self selectLine.  "if current selection is an insertion point, then first select the entire line in which occurs before proceeding"
- 	self hasSelection ifFalse: [self flash.  ^ returnBlock value]!

Item was changed:
  ----- Method: ParagraphEditor>>referencesToIt (in category 'menu messages') -----
  referencesToIt
+ 	"Open a MessageSet with the references to the selected global or variable name."
- 	"Open a references browser on the selected symbol"
  
+ 	self wordSelectAndEmptyCheck: [^ self].
+ 	self selectedInstanceVariable ifNotNil:
+ 		[:nameToClass | ^ self terminateAndInitializeAround:
+ 			[self systemNavigation
+ 				browseAllAccessesTo: nameToClass key
+ 				from: nameToClass value]].
+ 	self selectedBinding ifNotNil:
+ 		[:binding | ^ self terminateAndInitializeAround:
+ 			[self systemNavigation browseAllCallsOnClass: binding]].
+ 	view flash.!
- 	| aSymbol |
- 	self selectLine.
- 	((aSymbol := self selectedSymbol) == nil or:
- 		[(Smalltalk globals includesKey: aSymbol) not])
- 			ifTrue: [^ view flash].
- 
- 	self terminateAndInitializeAround: [self systemNavigation browseAllCallsOn: (Smalltalk globals associationAt: self selectedSymbol)]!

Item was changed:
  ----- Method: ParagraphEditor>>selectLine (in category 'new selection') -----
  selectLine
  	"Make the receiver's selection, if it currently consists of an insertion point only, encompass the current line."
+ 
- 	self hasSelection ifTrue:[^self].
  	self selectInterval: (self encompassLine: self selectionInterval)!

Item was added:
+ ----- Method: ParagraphEditor>>selectedBinding (in category 'menu messages') -----
+ selectedBinding
+ 	"Try to make a binding out of the current text selection. That binding can be a global or class."
+ 
+ 	^ self selectedSymbol ifNotNil:
+ 		[ :symbol |
+ 			((model respondsTo: #selectedClassOrMetaClass)
+ 				ifTrue: [ model selectedClassOrMetaClass ifNil: [ model environment ] ]
+ 				ifFalse: [ model environment ]) ifNotNil:
+ 					[ :environment | environment bindingOf: symbol ] ]!

Item was added:
+ ----- Method: ParagraphEditor>>selectedInstanceVariable (in category 'menu messages') -----
+ selectedInstanceVariable
+ 	"Try to make an association from an instance-variable name to the class where this variable is defined. Make the implementation robust for models that do not know about classes."
+ 
+ 	(model respondsTo: #selectedClassOrMetaClass) ifFalse: [ ^ nil ].
+ 		
+ 	^ self selection string ifNotNil:
+ 		[ :token | model selectedClassOrMetaClass ifNotNil:
+ 			[ :behavior |
+ 				(behavior instVarIndexFor: token ifAbsent: [ 0 ]) ~= 0
+ 					ifTrue: [ token -> behavior ]
+ 					ifFalse: [ nil ] ] ]!

Item was added:
+ ----- Method: ParagraphEditor>>selectedLiteral (in category 'menu messages') -----
+ selectedLiteral
+ 	"Try to make a Smalltalk literal out of the current text selection."
+ 
+ 	^ self selection string findLiteral!

Item was changed:
  ----- Method: ParagraphEditor>>selectedSymbol (in category 'menu messages') -----
  selectedSymbol
+ 	"Try to make a symbol out of the current text selection."
- 	"Return the currently selected symbol, or nil if none.  Spaces, tabs and returns are ignored"
  
+ 	^ self selection string findSymbol!
- 	| aString |
- 	self hasCaret ifTrue: [^ nil].
- 	aString := self selection string.
- 	aString isOctetString ifTrue: [aString := aString asOctetString].
- 	aString := self selection string copyWithoutAll: CharacterSet separators.
- 	aString size = 0 ifTrue: [^ nil].
- 	Symbol hasInterned: aString  ifTrue: [:sym | ^ sym].
- 
- 	^ nil!

Item was changed:
  ----- Method: ParagraphEditor>>sendersOfIt (in category 'menu messages') -----
  sendersOfIt
  	"Open a senders browser on the selected selector"
  
- 	| aSelector |
  	self lineSelectAndEmptyCheck: [^ self].
+ 	self selectedSelector ifNotNil:
+ 		[:aSelector| ^ self terminateAndInitializeAround:
+ 			[self systemNavigation browseAllCallsOn: aSelector]].
+ 	self selectedLiteral ifNotNil:
+ 		[:aLiteral| ^ self terminateAndInitializeAround:
+ 			[self systemNavigation browseAllCallsOn: aLiteral]].
+ 	view flash!
- 	(aSelector := self selectedSelector) == nil ifTrue: [^ view flash].
- 	self terminateAndInitializeAround: [self systemNavigation browseAllCallsOn: aSelector]!

Item was added:
+ ----- Method: ParagraphEditor>>wordSelectAndEmptyCheck: (in category 'menu messages') -----
+ wordSelectAndEmptyCheck: returnBlock
+ 	"If the current selection is an insertion point, expand it to be the entire current word; if after that's done the selection is still empty, then evaluate the returnBlock, which will typically consist of '[^ self]' in the caller -- check senders of this method to understand this."
+ 
+ 	self hasSelection ifFalse: [
+ 		self selectWord.
+ 		self hasSelection ifFalse: [
+ 			self flash. 
+ 			^ returnBlock value]].!



More information about the Squeak-dev mailing list