Christoph Thiede uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-ct.1782.mcz

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

Name: Morphic-ct.1782
Author: ct
Time: 20 September 2021, 11:06:53.254075 pm
UUID: 33e83ddb-069f-074b-aac7-2072a9434f46
Ancestors: Morphic-ul.1780

Fixes a bottleneck when opening a yellow button menu on a morph that contains a very large number of subsub*morphs. On not-so-fast systems, this can be reproduced using:

	self systemNavigation browseAllSelect: #notNil

On faster systems, you might need to install Squeak Inbox Talk and download all messages to reproduce the bottleneck. In my case, this actually blocked the image for several seconds when I yellow-clicked the window.

Reuploaded to replace Morphic-ct.1771 as requested to favor existing patterns over modern convenience ... :-)

=============== Diff against Morphic-ul.1780 ===============

Item was changed:
  ----- Method: Morph>>addYellowButtonMenuItemsTo:event: (in category 'menu') -----
  addYellowButtonMenuItemsTo: aMenu event: evt 
  	"Populate aMenu with appropriate menu items for a  
  	yellow-button (context menu) click."
  	aMenu defaultTarget: self.
  	""
  	Preferences noviceMode
  		ifFalse: [aMenu addStayUpItem].
  	""
  	self addModelYellowButtonItemsTo: aMenu event: evt.
  	""
  	Preferences generalizedYellowButtonMenu
  		ifFalse: [^ self].
  	""
  	aMenu addLine.
  	aMenu add: 'inspect' translated action: #inspect.
  	""
  	aMenu addLine.
  	self world selectedObject == self
  		ifTrue: [aMenu add: 'deselect' translated action: #removeHalo]
  		ifFalse: [aMenu add: 'select' translated action: #addHalo].
  	""
  	(self isWorldMorph
  			or: [self mustBeBackmost
  			or: [self wantsToBeTopmost]])
  		ifFalse: [""
  			aMenu addLine.
  			aMenu add: 'send to back' translated action: #goBehind.
  			aMenu add: 'bring to front' translated action: #comeToFront.
  			self addEmbeddingMenuItemsTo: aMenu hand: evt hand].
  	""
  	self isWorldMorph
  		ifFalse: [""
  	Smalltalk
  		at: #NCAAConnectorMorph
  		ifPresent: [:connectorClass | 
  			aMenu addLine.
  			aMenu add: 'connect to' translated action: #startWiring.
  			aMenu addLine].
  	""
  
  			self isFullOnScreen
  				ifFalse: [aMenu add: 'move onscreen' translated action: #goHome]].
  	""
  	Preferences noviceMode
  		ifFalse: [""
  			self addLayoutMenuItems: aMenu hand: evt hand.
  			(owner notNil
  					and: [owner isTextMorph])
  				ifTrue: [self addTextAnchorMenuItems: aMenu hand: evt hand]].
  	""
  	self isWorldMorph
  		ifFalse: [""
  			aMenu addLine.
  			self addToggleItemsToHaloMenu: aMenu].
  	""
  	aMenu addLine.
  	self isWorldMorph
  		ifFalse: [aMenu add: 'copy to paste buffer' translated action: #copyToPasteBuffer:].
+ 	self hasStrings ifTrue: [
+ 		aMenu add: 'copy text' translated action: #clipText].
- 	(self allStringsAfter: nil) isEmpty
- 		ifFalse: [aMenu add: 'copy text' translated action: #clipText].
  	""
  	self addExportMenuItems: aMenu hand: evt hand.
  	""
  	(Preferences noviceMode not
  			and: [self isWorldMorph not])
  		ifTrue: [""
  			aMenu addLine.
  			aMenu add: 'adhere to edge...' translated action: #adhereToEdge].
  	""
  	self addCustomMenuItems: aMenu hand: evt hand!

Item was changed:
  ----- Method: Morph>>allStringsAfter: (in category 'debug and other') -----
+ allStringsAfter: aSubmorph
- allStringsAfter: aSubmorph 
- 	"return an OrderedCollection of strings of text in my submorphs.  If aSubmorph is non-nil, begin with that container."
  
+ 	^ OrderedCollection streamContents: [:stream |
+ 		self allStringsAfter: aSubmorph do: [:string |
+ 			stream nextPut: string]]!
- 	| list ok |
- 	list := OrderedCollection new.
- 	ok := aSubmorph isNil.
- 	self allMorphsDo: 
- 			[:sub | | string | 
- 			ok ifFalse: [ok := sub == aSubmorph].	"and do this one too"
- 			ok 
- 				ifTrue: 
- 					[(string := sub userString) ifNotNil: 
- 							[string isString ifTrue: [list add: string] ifFalse: [list addAll: string]]]].
- 	^list!

Item was added:
+ ----- Method: Morph>>allStringsAfter:do: (in category 'debug and other') -----
+ allStringsAfter: aSubmorph do: aBlock
+ 	"Stream all strings of text in my submorphs on aStream. If aSubmorph is non-nil, begin with that container."
+ 
+ 	| ok |
+ 	ok := aSubmorph isNil.
+ 	self allMorphsDo: [:sub | | string |
+ 		ok ifFalse: [ok := sub == aSubmorph].
+ 		"and do this one too"
+ 		ok ifTrue: [
+ 			(string := sub userString)
+ 				ifNotNil: [string isString
+ 					ifTrue: [aBlock value: string]
+ 					ifFalse: [string do: aBlock]]]].!

Item was added:
+ ----- Method: Morph>>hasStrings (in category 'debug and other') -----
+ hasStrings
+ 
+ 	self allStringsAfter: nil do: [:string | ^ true].
+ 	^ false!