The example given in the class comment of TextAnchor does not work.

Workspace new
		contents: (Text withAll: 'foo') , (Text string: '*' attribute:
(TextAnchor new anchoredMorph: EllipseMorph new)) , (Text withAll:
'bar');
		openLabel: 'Text with Morph'.

(Squeak 5.3-19046)

Does it need to be updated?

--Hannes

On Fri, 4 Oct 2019 09:22:22 0000, commits at source.squeak.org
<commits at source.squeak.org> wrote:
> Patrick Rein uploaded a new version of MorphicTests to project The Trunk:
> http://source.squeak.org/trunk/MorphicTests-pre.53.mcz
>
> ==================== Summary ====================
>
> Name: MorphicTests-pre.53
> Author: pre
> Time: 4 October 2019, 11:22:21.819303 am
> UUID: d1d84e3f-afe5-624c-a1be-287b3465240e
> Ancestors: MorphicTests-mt.52
>
> Adds Test for the placement of text anchors
>
> =============== Diff against MorphicTests-mt.52 ===============
>
> Item was changed:
>   SystemOrganization addCategory: #'MorphicTests-Basic'!
> + SystemOrganization addCategory: #'MorphicTests-Events'!
>   SystemOrganization addCategory: #'MorphicTests-Kernel'!
>   SystemOrganization addCategory: #'MorphicTests-Layouts'!
>   SystemOrganization addCategory: #'MorphicTests-Support'!
>   SystemOrganization addCategory: #'MorphicTests-Text Support'!
>   SystemOrganization addCategory: #'MorphicTests-ToolBuilder'!
>   SystemOrganization addCategory: #'MorphicTests-Widgets'!
>   SystemOrganization addCategory: #'MorphicTests-Worlds'!
> - SystemOrganization addCategory: #'MorphicTests-Events'!
>
> Item was changed:
> + TestCase subclass: #TextAnchorTest
> + 	instanceVariableNames: 'anchoredMorph anchorAttribute text textMorph'
> - HashAndEqualsTestCase subclass: #TextAnchorTest
> - 	instanceVariableNames: ''
>   	classVariableNames: ''
>   	poolDictionaries: ''
>   	category: 'MorphicTests-Text Support'!
>
> Item was added:
> + ----- Method: TextAnchorTest>>after:paddingChangesTo: (in category
> 'utility') -----
> + after: aBlock paddingChangesTo: assertBlock
> +
> + 	anchoredMorph := TextAnchorTestMorph new.
> + 	anchorAttribute anchoredMorph: anchoredMorph.
> + 	aBlock value.
> + 	self prepareTextMorph.
> + 	assertBlock value: (textMorph paragraph lines first).	!
>
> Item was added:
> + ----- Method: TextAnchorTest>>prepareTextMorph (in category 'utility')
> -----
> + prepareTextMorph
> +
> + 	textMorph := text asMorph.
> + 	self refreshTextMorph.!
>
> Item was added:
> + ----- Method: TextAnchorTest>>refreshTextMorph (in category 'utility')
> -----
> + refreshTextMorph
> +
> + 	textMorph changed; imageForm. "This triggers a redraw and thereby
> positions the embedded morphs."!
>
> Item was changed:
> + ----- Method: TextAnchorTest>>setUp (in category 'running') -----
> - ----- Method: TextAnchorTest>>setUp (in category 'initialize-release')
> -----
>   setUp
> +
>   	super setUp.
> + 	anchoredMorph := TextAnchorTestMorph new.
> + 	anchorAttribute := TextAnchor new anchoredMorph: anchoredMorph.
> + 	text := Text streamContents: [:stream |
> + 		stream
> + 			nextPutAll: 'Here is a contrived example ';
> + 			nextPutAll: (Text
> + 				string: Character startOfHeader asString
> + 				attributes: {
> + 					anchorAttribute.
> + 					TextColor color: Color transparent});
> + 			nextPutAll: ' whose morph is in the center.' ].
> + 	self prepareTextMorph.!
> - 	prototypes
> - 		add: (TextAnchor new anchoredMorph: RectangleMorph new initialize);
> - 		
> - 		add: (TextAnchor new anchoredMorph: EllipseMorph new initialize) !
>
> Item was changed:
> + ----- Method: TextAnchorTest>>testBeginWithAnAnchor (in category 'tests')
> -----
> - ----- Method: TextAnchorTest>>testBeginWithAnAnchor (in category
> 'initialize-release') -----
>   testBeginWithAnAnchor
> + 	
> + 	text := Text streamContents: [:stream |
> + 		stream
> + 			nextPutAll: (Text
> + 				string: Character startOfHeader asString
> + 				attributes: {
> + 					anchorAttribute.
> - 	| text morph model |
> - 	text := Text streamContents:
> - 		[ : stream | stream
> - 			 nextPutAll:
> - 			(Text
> - 				string: (String value: 1)
> - 				attributes: {TextAnchor new anchoredMorph: Morph new.
>   					TextColor color: Color transparent}) ;
> + 			nextPutAll: ' should be able to begin with an embedded object. '].
> + 	self prepareTextMorph.
> + 	self
> + 		assert: (anchoredMorph ownerChain includes: textMorph);
> + 		assert: anchoredMorph topLeft >= textMorph topLeft.!
> - 			 nextPutAll: ' should be able to begin with an embedded object. ' ].
> - 	model := text -> nil.
> - 	morph := PluggableTextMorph
> - 		on: model
> - 		text: #key
> - 		accept: nil.
> - 	[ morph openInWorld ] ensure: [ morph delete ]!
>
> Item was added:
> + ----- Method:
> TextAnchorTest>>testHavingADocumentAnchorAndRelativeTextAnchorPosition (in
> category 'tests') -----
> + testHavingADocumentAnchorAndRelativeTextAnchorPosition
> + 	
> + 	anchoredMorph := Morph new.
> + 	anchoredMorph textAnchorProperties
> + 		positionInDocument: 20 @ 10;
> + 		anchorLayout: #document.
> + 	anchorAttribute anchoredMorph: anchoredMorph.
> + 	self prepareTextMorph.
> + 	
> + 	self
> + 		assert: (anchoredMorph ownerChain includes: textMorph);
> + 		 assert: anchoredMorph topLeft >= textMorph topLeft;
> + 		 assert: anchoredMorph top > textMorph top!
>
> Item was added:
> + ----- Method:
> TextAnchorTest>>testHavingADocumentAnchorShouldNotAffectTheLineHeight (in
> category 'tests') -----
> + testHavingADocumentAnchorShouldNotAffectTheLineHeight
> + 	
> + 	| firstLine |
> + 	anchoredMorph := Morph new.
> + 	anchoredMorph height: 50.
> + 	anchoredMorph textAnchorProperties
> + 		positionInDocument: 20 @ 10;
> + 		anchorLayout: #document.
> + 	anchorAttribute anchoredMorph: anchoredMorph.
> + 	self prepareTextMorph.
> + 	
> + 	firstLine := textMorph paragraph lines first.
> + 	self	
> + 		assert: (firstLine bottom - firstLine top) < 25
> + 		description: '#document layouted anchor should not affect line height'.
> + 	!
>
> Item was added:
> + ----- Method:
> TextAnchorTest>>testHavingAMultilineDocumentAnchorAndRelativeTextAnchorPosition
> (in category 'tests') -----
> + testHavingAMultilineDocumentAnchorAndRelativeTextAnchorPosition
> + 	
> + 	| secondLine |
> + 	text := Text streamContents: [ :stream |
> + 		stream
> + 			nextPutAll: 'Example with more than one line.
> + Here is an example ';
> + 			nextPutAll: (Text
> + 				string: Character startOfHeader asString
> + 				attributes: {anchorAttribute});
> + 			nextPutAll: ' without a morph in the center.' ].
> + 	anchoredMorph := Morph new
> + 		height: 50;
> + 		yourself.
> + 	anchoredMorph textAnchorProperties
> + 		positionInDocument: 20 @ 10;
> + 		anchorLayout: #document.
> + 	anchorAttribute anchoredMorph: anchoredMorph.
> + 	self prepareTextMorph.
> +
> + 	secondLine := textMorph paragraph lines second.
> + 	self
> + 		assert: (anchoredMorph ownerChain includes: textMorph);
> + 		assert: anchoredMorph topLeft >= textMorph topLeft;
> + 		assert: anchoredMorph top > textMorph top;
> + 		assert: anchoredMorph top > secondLine top.!
>
> Item was added:
> + ----- Method: TextAnchorTest>>testHavingAnAnchorCanBeAlignedDifferently
> (in category 'tests') -----
> + testHavingAnAnchorCanBeAlignedDifferently
> +
> + 	| line |
> + 	anchoredMorph textAnchorProperties verticalAlignment: #(top baseline).
> + 	anchoredMorph textAnchorProperties padding. 1.
> + 	self prepareTextMorph.
> + 	line := textMorph paragraph lines first.
> + 	self assert: anchoredMorph top = (line top + line baseline).!
>
> Item was added:
> + ----- Method: TextAnchorTest>>testHavingAnAnchorInTheCenter (in category
> 'tests') -----
> + testHavingAnAnchorInTheCenter
> + 	
> + 	self
> + 		assert: (anchoredMorph ownerChain includes: textMorph);
> + 		assert: anchoredMorph topLeft > textMorph topLeft!
>
> Item was added:
> + ----- Method:
> TextAnchorTest>>testHavingAnAnchorInTheCenterWithHorizontalPadding (in
> category 'tests') -----
> + testHavingAnAnchorInTheCenterWithHorizontalPadding
> +
> + 	anchoredMorph textAnchorProperties padding. 30 at 0.
> + 	
> + 	self
> + 		assert: (anchoredMorph ownerChain includes: textMorph);
> + 		assert: (anchoredMorph topLeft > textMorph topLeft)!
>
> Item was added:
> + ----- Method:
> TextAnchorTest>>testHavingAnInlineAnchorAndRelativeTextAnchorPosition (in
> category 'tests') -----
> + testHavingAnInlineAnchorAndRelativeTextAnchorPosition
> + 	
> + 	| positionWithRelativePosition positionWithoutRelativePosition |
> + 	anchoredMorph textAnchorProperties
> + 		positionInDocument: 20 at 10;
> + 		anchorLayout: #inline.
> + 	self refreshTextMorph.
> + 	positionWithRelativePosition := anchoredMorph topLeft.
> + 	
> + 	anchoredMorph textAnchorProperties positionInDocument: nil.
> + 	self refreshTextMorph.
> + 	positionWithoutRelativePosition := anchoredMorph topLeft.
> + 	
> + 	self	assert: positionWithRelativePosition =
> positionWithoutRelativePosition!
>
> Item was added:
> + ----- Method: TextAnchorTest>>testLayoutingSetsTheMorphPosition (in
> category 'tests') -----
> + testLayoutingSetsTheMorphPosition
> + 	
> + 	anchoredMorph := Morph new.
> + 	anchoredMorph textAnchorProperties
> + 		anchorLayout: #inline.
> + 	anchorAttribute anchoredMorph: anchoredMorph.
> + 	self prepareTextMorph.
> + 	
> + 	textMorph position: 100 at 100.
> + 	
> + 	self assert: anchoredMorph position > (100 at 100).!
>
> Item was added:
> + ----- Method: TextAnchorTest>>testPaddingBottom (in category
> 'tests-padding') -----
> + testPaddingBottom
> +
> + 	self
> + 		after: [
> + 			anchoredMorph height: 20.
> + 			anchoredMorph textAnchorProperties verticalAlignment: #(bottom
> baseline).
> + 			anchoredMorph textAnchorProperties padding: (anchoredMorph
> textAnchorProperties padding bottom: 10)]
> + 		paddingChangesTo: [:line |
> + 			self assert: anchoredMorph bottom + 10 = line baseline ]!
>
> Item was added:
> + ----- Method: TextAnchorTest>>testPaddingBottomAndBottom (in category
> 'tests-padding') -----
> + testPaddingBottomAndBottom
> +
> + 	self
> + 		after: [
> + 			anchoredMorph height: 20.
> + 			anchoredMorph textAnchorProperties verticalAlignment: #(bottom bottom).
> + 			anchoredMorph textAnchorProperties padding: (anchoredMorph
> textAnchorProperties padding bottom: 10)]
> + 		paddingChangesTo: [:line |
> + 			self assert: anchoredMorph bottom + 10 = line bottom ]!
>
> Item was added:
> + ----- Method:
> TextAnchorTest>>testPaddingBottomAndBottomWithConvenienceAlignment (in
> category 'tests-padding') -----
> + testPaddingBottomAndBottomWithConvenienceAlignment
> +
> + 	self
> + 		after: [
> + 			anchoredMorph height: 20.
> + 			anchoredMorph textAnchorProperties verticalAlignment: #bottom.
> + 			anchoredMorph textAnchorProperties padding: (anchoredMorph
> textAnchorProperties padding bottom: 10)]
> + 		paddingChangesTo: [:line |
> + 			self assert: anchoredMorph bottom + 10 = line bottom ]!
>
> Item was added:
> + ----- Method: TextAnchorTest>>testPaddingTop (in category 'tests-padding')
> -----
> + testPaddingTop
> +
> + 	self
> + 		after: [
> + 			anchoredMorph height: 20.
> + 			anchoredMorph textAnchorProperties verticalAlignment: #(top baseline).
> + 			anchoredMorph textAnchorProperties padding: (anchoredMorph
> textAnchorProperties padding top: 10)]
> + 		paddingChangesTo: [:line | | anchoredMorphTop |
> +  			anchoredMorphTop := anchoredMorph top - textMorph top.
> +  			self assert: anchoredMorphTop - 10 = line baseline ]!
>
> Item was added:
> + ----- Method: TextAnchorTest>>testPaddingTopAndBottom (in category
> 'tests-padding') -----
> + testPaddingTopAndBottom
> + 	
> + 	self
> + 		after: [
> + 			anchoredMorph height: 30.
> + 			anchoredMorph textAnchorProperties verticalAlignment: #(#bottom
> #bottom).
> + 			anchoredMorph textAnchorProperties padding: (anchoredMorph
> textAnchorProperties padding bottom: 10).
> + 			anchoredMorph textAnchorProperties padding: (anchoredMorph
> textAnchorProperties padding top: 10).]
> + 		paddingChangesTo: [:line |
> + 			self assert: anchoredMorph bottom + 10 = line bottom.
> + 			self deny: anchoredMorph top - 10= line top description: 'We only apply
> padding to the morph position'.]!
>
> Item was added:
> + ----- Method: TextAnchorTest>>testPaddingTopAndTop (in category
> 'tests-padding') -----
> + testPaddingTopAndTop
> +
> + 	self
> + 		after: [
> + 			anchoredMorph height: 20.
> + 			anchoredMorph textAnchorProperties verticalAlignment: #(top baseline).
> + 			anchoredMorph textAnchorProperties padding: (anchoredMorph
> textAnchorProperties padding top: 10)]
> + 		paddingChangesTo: [:line | | anchoredMorphTop |
> +  			anchoredMorphTop := anchoredMorph top - textMorph top.
> +  			self assert: anchoredMorphTop - 10 = line baseline ]!
>
> Item was added:
> + ----- Method: TextAnchorTest>>testTextAnchorWithAForm (in category
> 'tests') -----
> + testTextAnchorWithAForm
> +
> + 	anchorAttribute anchoredMorph: (Form dotOfSize: 60).
> + 	self prepareTextMorph.
> + 	
> + 	self
> + 		assert: textMorph paragraph lines first baseline > 20;
> + 		assert: textMorph submorphs isEmpty!
>
> Item was added:
> + ----- Method:
> TextAnchorTest>>testTextAnchorWithMorphDefiningItsOwnBaseline (in category
> 'tests') -----
> + testTextAnchorWithMorphDefiningItsOwnBaseline
> +
> + 	self
> + 		after: [
> + 			anchoredMorph textAnchorProperties
> + 				morphBaselineGetter: #myBaseline;
> + 				verticalAlignment: #(baseline baseline).
> + 			anchoredMorph height: 20]
> + 		paddingChangesTo: [:line |
> +  			self assert: anchoredMorph top + 5 = line baseline ]!
>
> Item was added:
> + ----- Method: TextAnchorTest>>testTextAnchorsDoNotBreakNormalRendering (in
> category 'tests') -----
> + testTextAnchorsDoNotBreakNormalRendering
> + 	
> + 	text := Text streamContents: [ :stream |
> + 		stream
> + 			nextPutAll: 'Here is an example ';
> + 			nextPutAll: (Text
> + 				string: Character startOfHeader asString
> + 				attributes: {});
> + 			nextPutAll: ' without a morph in the center. ' ].
> + 	
> + 	[self
> + 		shouldnt: [
> + 			self prepareTextMorph.
> + 			textMorph openInWorld]
> + 		raise: Error] ensure: [ textMorph delete ]!
>
> Item was added:
> + Morph subclass: #TextAnchorTestMorph
> + 	instanceVariableNames: ''
> + 	classVariableNames: ''
> + 	poolDictionaries: ''
> + 	category: 'MorphicTests-Text Support'!
>
> Item was added:
> + ----- Method: TextAnchorTestMorph>>initialize (in category
> 'initialization') -----
> + initialize
> +
> + 	super initialize.
> + 	self height: 20.!
>
> Item was added:
> + ----- Method: TextAnchorTestMorph>>myBaseline (in category 'text-anchor')
> -----
> + myBaseline
> +
> + 	^ 5!
>
>
>