Merge pull request #7 from bpieber/fix-STE

Fix STE loading after font improvements
bpieber · Sep 17, 2023 · 026194f · 026194f
2 parents cd12c69 + b5d5ed7
commit 026194f
Show file tree

Hide file tree

Showing 4 changed files with 417 additions and 444 deletions.
diff --git a/RTFExporting.pck.st b/RTFExporting.pck.st
@@ -1,20 +1,22 @@
-'From Cuis 4.2 of 25 July 2013 [latest update: #2933] on 6 September 2016 at 10:05:12 am'!
+'From Cuis 6.0 [latest update: #6032] on 17 September 2023 at 7:56:05 pm'!
 'Description Please enter a description for this package.'!
-!provides: 'RTFExporting' 1 3!
+!provides: 'RTFExporting' 1 5!
 !requires: 'Graphics-Files-Additional' 1 nil nil!
 
-!String methodsFor: '*rtfExporting' stamp: 'jmv 9/5/2016 20:27:00'!
-iso8859s15ToRTFEncoding
-	"Convert the given string to RTF escaped Unicode from the internal encoding: ISO Latin 9 (ISO 8859-15)"
+
+
+!CharacterSequence methodsFor: '*rtfExporting' stamp: 'bp 9/17/2023 19:54:03'!
+asUnicodeRTF
+	"Convert the given character sequence to Unicode RTF"
 	"
-	self assert: ('A¢¤' iso8859s15ToRTFEncoding) hex = ' 'A\u162?\u8364?''
+	self assert: 'A¢€' rtfString = 'A\u162?\u8364?'
 	"
 	| c cp |
 	^String streamContents: [ :strm | | characters |
-		characters _ self readStream.
+		characters := self readStream.
 		[ characters atEnd ] whileFalse: [
-			c _  characters next.
-			cp _ c codePoint.
+			c :=  characters next.
+			cp := c codePoint.
 			cp < 128
 				ifTrue: [ strm nextPut: c ]
 				ifFalse: [
@@ -24,7 +26,7 @@ iso8859s15ToRTFEncoding
 					cp printOn: strm.
 					strm nextPut: $? ]]]! !
 
-!Text methodsFor: '*rtfExporting' stamp: 'jmv 11/22/2011 15:30'!
+!Text methodsFor: '*rtfExporting' stamp: 'bp 9/17/2023 19:54:47'!
 rtfString
 	"
 	| text |
@@ -34,41 +36,41 @@ rtfString
 	"
 	| prevAttributes colors fonts s |
 	"Build colors and fonts tables"
-	colors _ Set new.
-	fonts _ Set new.
+	colors := Set new.
+	fonts := Set new.
 	runs withStartStopAndValueDo: [ :start :stop :attributes |
 		attributes do: [ :attribute |
 			attribute forParagraphStyleReferenceDo: [ :ts | ts color ifNotNil: [ :color | colors add: color ]].
 			attribute forCharacterStyleReferenceDo: [ :cs | cs color ifNotNil: [ : color | colors add: color ]].
 			attribute forTextColorDo: [ :color | colors add: color ].
-			attribute forBaseFontDo: [ :font | fonts add: font familyName ]]].
-	colors _ colors asArray.
-	fonts _ fonts asArray.
+			attribute forFontFamilyDo: [ :font | fonts add: font ]]].
+	colors := colors asArray.
+	fonts := fonts asArray.
 	^String
 		streamContents: [ :strm |
 			self writeRTFHeaderOn: strm colorTable: colors fontTable: fonts.
-			prevAttributes _ #().
+			prevAttributes := #().
 			runs withStartStopAndValueDo: [ :start :stop :attributes | | currentAttributes actualStart |
-				currentAttributes _ attributes asSet.
+				currentAttributes := attributes asSet.
 				"Close attributes no longer present"
 				prevAttributes do: [ :each |
 					(currentAttributes includes: each) ifFalse: [
 						each writeRTFStopOn: strm colorTable: colors fontTable: fonts ]].
 				"Open attributes not previously present"
-				actualStart _ start.
+				actualStart := start.
 				currentAttributes do: [ :each |
 					"Repeat existing, because the closing of other attributes, in some cases, sets defaults, and not the now active values...
 					For example, finishing a CharStyle sets text to black. But what if the ParaStyle indicated some other color?"
 					"(prevAttributes includes: each) ifFalse: ["
-						actualStart _ actualStart + (each writeRTFStartOn: strm colorTable: colors fontTable: fonts) 
+						actualStart := actualStart + (each writeRTFStartOn: strm colorTable: colors fontTable: fonts) 
 						"]"
 					].
 				"Add string now"
-				s _ string copyFrom: actualStart to: stop.
-				s _ s withLineEndings: '\par '.
-				s _ s iso8859s15ToRTFEncoding.
+				s := string copyFrom: actualStart to: stop.
+				s := s withLineEndings: '\par '.
+				s := s asUnicodeRTF.
 				strm nextPutAll: s.
-				prevAttributes _ currentAttributes ].
+				prevAttributes := currentAttributes ].
 			strm nextPut: $} ]
 		estimatedSize: string size! !
 
@@ -161,15 +163,15 @@ writeRTFStopOn: aStream colorTable: colorArray fontTable: fontArray
 	(emphasisCode allMask: AbstractFont boldCode) ifTrue: [
 		aStream nextPutAll: '\b0 ' ]! !
 
-!TextFontFamilyAndSize methodsFor: '*rtfExporting' stamp: 'jmv 4/12/2011 09:06'!
+!TextFontSize methodsFor: '*rtfExporting' stamp: 'bp 9/13/2023 19:45:38'!
 writeRTFStartOn: aStream colorTable: colorArray fontTable: fontArray
 	"Write the RTF code for attribute start. Return number of characters to skip (usually 0)"
 	"We should also reference familyName, in the table with \f# where # is the number in the table..."
 
 	aStream nextPutAll: '\fs'; nextPutAll: ((pointSize * Text pointSizeConversionFactor ) rounded * 2) asString; space.
 	^0! !
 
-!TextFontFamilyAndSize methodsFor: '*rtfExporting' stamp: 'jmv 4/7/2011 15:20'!
+!TextFontSize methodsFor: '*rtfExporting' stamp: 'bp 9/13/2023 19:45:51'!
 writeRTFStopOn: aStream colorTable: colorArray fontTable: fontArray
 	"Write the RTF code for attribute stop."
 	aStream nextPutAll: '\fs0 '! !

diff --git a/RTFImporting.pck.st b/RTFImporting.pck.st
@@ -1,6 +1,6 @@
-'From Cuis 5.0 [latest update: #4219] on 12 June 2020 at 11:48:38 am'!
+'From Cuis 6.0 [latest update: #6025] on 12 September 2023 at 5:08:08 pm'!
 'Description Please enter a description for this package.'!
-!provides: 'RTFImporting' 1 6!
+!provides: 'RTFImporting' 1 7!
 !requires: 'ExtendedClipboard' 1 nil nil!
 !requires: 'Graphics-Files-Additional' 1 nil nil!
 SystemOrganization addCategory: #RTFimporting!
@@ -285,14 +285,6 @@ newline is a Mac-hack. No newlines are expected in a RTF, but Mac makes escaped
 Not a real Unicode implementation. Just compatibility for Sophie-RTF. Answers instances of Character (i.e. ISO-8859-15).
 Based on http://www.unicode.org/Public/MAPPINGS/ISO8859/8859-15.TXT!
 
-!RTFFontInfo methodsFor: 'accessing' stamp: 'tat 5/3/2006 02:21'!
-name
-	^name! !
-
-!RTFStylesheet methodsFor: 'accessing' stamp: 'tat 5/5/2006 14:49'!
-name
-	^name! !
-
 !RTFChunkScanner methodsFor: 'private' stamp: 'mir 8/14/2006 16:25'!
 addScannedString
 	| scannedString |
@@ -472,6 +464,10 @@ family
 family: f
 	family := f! !
 
+!RTFFontInfo methodsFor: 'accessing' stamp: 'tat 5/3/2006 02:21'!
+name
+	^name! !
+
 !RTFFontInfo methodsFor: 'accessing' stamp: 'tat 5/3/2006 02:21'!
 name: fn
 	name := fn! !
@@ -1514,6 +1510,10 @@ basedon
 basedon: bo
 	basedon := bo! !
 
+!RTFStylesheet methodsFor: 'accessing' stamp: 'tat 5/5/2006 14:49'!
+name
+	^name! !
+
 !RTFStylesheet methodsFor: 'accessing' stamp: 'tat 5/5/2006 14:49'!
 name: n
 	name := n! !
@@ -1570,20 +1570,20 @@ resetStyle: builder
 addToText: aString
 	self addToText: aString specialAttributes: nil! !
 
-!RTFTextBuilder methodsFor: 'private' stamp: 'jmv 4/11/2011 21:58'!
+!RTFTextBuilder methodsFor: 'private' stamp: 'bp 9/12/2023 17:06:45'!
 addToText: aString specialAttributes: nonFormattingAttributesOrNil
 	"nonFormattingAttributesOrNil should only contains attributes that answer false to #isForFormatting"
 	| attributes emphasis |
 
-	attributes _ Array streamContents: [ :strm |
+	attributes := Array streamContents: [ :strm |
 		fontFamilyName ifNotNil: [
-			fontPointSize ifNotNil: [
-				strm nextPut: (TextFontFamilyAndSize
-					familyName: fontFamilyName pointSize: fontPointSize) ]].
-		emphasis _ 0.
-		bold ifTrue: [ emphasis _ emphasis + 1 ].
-		italic ifTrue: [ emphasis _ emphasis + 2 ].
-		underline ifTrue: [ emphasis _ emphasis + 4 ].
+			strm nextPut: (TextFontFamily familyName: fontFamilyName) ].
+		fontPointSize ifNotNil: [
+			strm nextPut: (TextFontSize pointSize: fontPointSize) ].
+		emphasis := 0.
+		bold ifTrue: [ emphasis := emphasis + 1 ].
+		italic ifTrue: [ emphasis := emphasis + 2 ].
+		underline ifTrue: [ emphasis := emphasis + 4 ].
 		emphasis > 0 ifTrue: [
 			strm nextPut: (TextEmphasis new emphasisCode: emphasis) ].
 		currentFgColor ifNotNil: [
@@ -1674,7 +1674,7 @@ convertAndSkip: string
 
 !RTFTextBuilder methodsFor: 'building-characters' stamp: 'jmv 9/5/2016 20:30:31'!
 buildAddBullet
-	self addUnicodeContents: (RTFUnicode codePoint: 16r2022 or: $°) asString! !
+	self addUnicodeContents: (RTFUnicode codePoint: 16r2022 or: $°) asString! !
 
 !RTFTextBuilder methodsFor: 'building-characters' stamp: 'jmv 9/5/2016 20:30:34'!
 buildAddDoubleLeftQuote

diff --git a/RTFTests.pck.st b/RTFTests.pck.st
@@ -1,6 +1,6 @@
-'From Cuis 5.0 [latest update: #4219] on 12 June 2020 at 11:47:03 am'!
+'From Cuis 6.0 [latest update: #6032] on 17 September 2023 at 6:19:19 pm'!
 'Description Please enter a description for this package.'!
-!provides: 'RTFTests' 1 4!
+!provides: 'RTFTests' 1 6!
 !requires: 'RTFExporting' 1 nil nil!
 !requires: 'RTFImporting' 1 nil nil!
 SystemOrganization addCategory: #RTFtests!
@@ -645,7 +645,7 @@ textSample2
 		(Text string: 'This text has no tyle set', String newLineString),
 		(Text string: 'This is right', String newLineString attribute: TextAlignment rightFlush)! !
 
-!RTFConversionTest class methodsFor: 'text samples' stamp: 'jmv 6/11/2020 16:34:31'!
+!RTFConversionTest class methodsFor: 'text samples' stamp: 'bp 9/12/2023 17:04:00'!
 textSample3
 	"
 	| text |
@@ -654,18 +654,18 @@ textSample3
 	Clipboard default storeObject: text
 	"
 	| familyName |
-	familyName _ FontFamily defaultFamilyName.
+	familyName := FontFamily defaultFamilyName.
 	^ (
 		(Text string: 'normal '),
-		(Text string: 'bold ' attributes: {(TextFontFamilyAndSize familyName: familyName pointSize: 17). TextEmphasis bold}),
-		(Text string: 'italic ' attributes: {(TextFontFamilyAndSize familyName: familyName pointSize: 6). TextEmphasis italic}),
-		(Text string: 'boldGreen ' attributes: {(TextFontFamilyAndSize familyName: familyName pointSize: 12). TextEmphasis bold. TextColor green}),
+		(Text string: 'bold ' attributes: {(TextFontFamily familyName: familyName). (TextFontSize pointSize: 17). TextEmphasis bold}),
+		(Text string: 'italic ' attributes: {(TextFontFamily familyName: familyName). (TextFontSize pointSize: 6). TextEmphasis italic}),
+		(Text string: 'boldGreen ' attributes: {(TextFontFamily familyName: familyName). (TextFontSize pointSize: 12). TextEmphasis bold. TextColor green}),
 		(Text string: 'red ' attributes: {TextColor red}),
 		(Text string: 'underlined ' attribute: (TextEmphasis underlined)),
 		(Text string: 'normal ' attributes: #())
 	)! !
 
-!RTFConversionTest class methodsFor: 'text samples' stamp: 'jmv 6/11/2020 16:35:02'!
+!RTFConversionTest class methodsFor: 'text samples' stamp: 'bp 9/12/2023 17:05:10'!
 textSample4
 	"
 	| text |
@@ -674,14 +674,14 @@ textSample4
 	Clipboard default storeObject: text
 	"
 	| familyName |
-	familyName _ FontFamily defaultFamilyName.
+	familyName := FontFamily defaultFamilyName.
 	^ (
 		(Text string: 'normal '),
-		(Text string: 'bold ' attributes: { (TextFontFamilyAndSize familyName: familyName pointSize: 17). TextEmphasis bold }),
-		(Text string: 'italic ' attributes: { (TextFontFamilyAndSize familyName: familyName pointSize: 6). TextEmphasis italic }),
-		(Text string: 'boldGreen ' attributes: { (TextFontFamilyAndSize familyName: familyName pointSize: 12). TextEmphasis bold. TextColor green }),
-		(Text string: 'boldGreen ' attributes: { (TextFontFamilyAndSize familyName: familyName pointSize: 12). TextEmphasis bold. TextColor green }),
-		(Text string: 'boldGreen ' attributes: { (TextFontFamilyAndSize familyName: familyName pointSize: 12). TextEmphasis bold. TextColor green }),
+		(Text string: 'bold ' attributes: { (TextFontFamily familyName: familyName). (TextFontSize pointSize: 17). TextEmphasis bold }),
+		(Text string: 'italic ' attributes: { (TextFontFamily familyName: familyName). (TextFontSize pointSize: 6). TextEmphasis italic }),
+		(Text string: 'boldGreen ' attributes: { (TextFontFamily familyName: familyName). (TextFontSize pointSize: 12). TextEmphasis bold. TextColor green }),
+		(Text string: 'boldGreen ' attributes: { (TextFontFamily familyName: familyName). (TextFontSize pointSize: 12). TextEmphasis bold. TextColor green }),
+		(Text string: 'boldGreen ' attributes: { (TextFontFamily familyName: familyName). (TextFontSize pointSize: 12). TextEmphasis bold. TextColor green }),
 		(Text string: 'red ' attributes: {TextColor red}),
 		(Text string: 'underlined ' attribute: (TextEmphasis underlined)),
 		(Text string: 'struckThrough ' attribute: (TextEmphasis struckThrough)),
@@ -698,17 +698,18 @@ textSample5
 	"
 	^'Hello', (Text withForm: (BoxedMorph new imageForm: 32)), 'world'! !
 
-!RTFConversionTest class methodsFor: 'text samples' stamp: 'jmv 11/22/2011 15:00'!
+!RTFConversionTest class methodsFor: 'text samples' stamp: 'bp 9/17/2023 18:19:11'!
 textSample6
 	"
 	| text |
 	text _ RTFConversionTest textSample6.
 	text edit.
 	Clipboard default storeObject: text
 	"
-	^'Tomá agüita, ñandú. Ñandú. 
-½´®¥¨øåß©Ý²Þ¬ç¦µ.
-¼´®Á¨ØÅÍÎÏ©ÓÔÞÒÇ¦ÐÂ' asText! !
+	"UnicodeString fromCodePoints: (#(84 111 109 225 32 97 103 252 105 116 97 44 32 241 97 110 100 250 46 32 209 97 110 100 250 46 32 10 189 180 174 165 168 248 229 223 131 169 221 178 222 172 173 231 166 181 46 10 188 180 174 193 168 216 197 205 206 207 169 211 212 222 210 173 199 166 208 194) collect: [:iso885915code | Character unicodeCodePoints at: iso885915code +1])"
+	^'Tomá agüita, ñandú. Ñandú. 
+ œŽ®¥šøåßℤ©Ý²Þ¬çŠµ.
+ ŒŽ®ÁšØÅÍÎÏ©ÓÔÞÒÇŠÐÂ' asText! !
 
 !RTFTokenTest methodsFor: 'as yet unclassified' stamp: 'MR 5/24/2006 12:10'!
 testCreateBlockClose