The Trunk: System-fbs.618.mcz

Frank Shearar uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-fbs.618.mcz

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

Name: System-fbs.618
Author: fbs
Time: 23 November 2013, 5:00:23.474 pm
UUID: 8fa2f394-ed71-0243-88b4-a2849b7367c9
Ancestors: System-fbs.617

Methods involving writing to change sets belong in the change sets package - System-Changes.

=============== Diff against System-fbs.617 ===============

Item was added:
+ ----- Method: TextStyle class>>writeSF2FamilyNamed:inDirectory:toChangeSet: (in category '*System-Changes-mime file in/out') -----
+ writeSF2FamilyNamed: familyName inDirectory: directoryName toChangeSet: csName
+ "
+ TextStyle writeSF2FamilyNamed: 'Accuny' inDirectory: 'AccunyCorrectedFeb252004Beta Folder' toChangeSet: 'AccunyInstall'.
+ "
+
+ |  family |
+ family := OrderedCollection new.
+ family addAll: (StrikeFont readStrikeFont2Family: familyName fromDirectory: (FileDirectory default fullNameFor: directoryName)) .
+ family do: [:f | f reset].
+ self
+ writeStyle: (TextStyle fontArray: family asArray)
+ named: familyName
+ toChangeSet: csName!

Item was added:
+ ----- Method: TextStyle class>>writeStyle:named:toChangeSet: (in category '*System-Changes-mime file in/out') -----
+ writeStyle: aTextStyle named: familyName toChangeSet: csName
+ "Write the text style to a change set, with a postscript that will re-load it.
+ NOTE: to do TTCFonts, you have to have a working ShortPointArray endianness conversion."
+ "
+ TTCFont recreateCache.
+ TextStyle writeStyle: (TextStyle named: #Arial) named: 'Arial' toChangeSet: 'ArialInstall'.
+
+ TextStyle writeStyle: (TextStyle named: #Accuny) named: 'Accuny' toChangeSet: 'AccunyInstall2'.
+ "
+
+ | cs mimeStream |
+
+ cs := ChangeSet basicNewNamed: csName.
+ cs adoptSelector: #collectionFromCompressedMIMEString: forClass: self class.
+ cs adoptSelector: #replaceStyle:with: forClass: self class.
+ cs adoptSelector: #replaceFontsIn:with: forClass: self class.
+ cs adoptSelector: #looseFontsFromFamily: forClass: self class.
+ ((aTextStyle fontArray copyWithout: nil) collect: [ :f | f class ]) asSet do: [ :cls  |
+ cs adoptSelector: #derivativeFonts forClass: cls.
+ cs adoptSelector: #releaseCachedState forClass: cls ].
+
+ cs preambleString: (String streamContents: [ :s |
+ s nextPutAll: '"Change Set: '; nextPutAll: csName; cr;
+ nextPutAll: 'Date: '; print: Date today; cr;
+ nextPutAll: 'Author: '; nextPutAll: Utilities authorName; cr; cr;
+ nextPutAll: 'Installs the text style '''; nextPutAll: familyName; nextPutAll: ''''; cr;
+ nextPutAll: 'from a compressed MIME encoding in the postscript."'; cr. ]).
+
+ mimeStream := aTextStyle compressedMIMEEncodedStream.
+
+ cs postscriptString: (String streamContents: [ :s | s
+ nextPutAll: '"Postscript:'; cr;
+ nextPutAll: 'Install the text style from the compressed MIME encoding, and replace the old one.';
+ nextPut: $"; cr;
+ nextPutAll: 'TextConstants at: #';
+ nextPutAll: familyName;
+ nextPutAll: ' ifPresent: [ :oldStyle | TextConstants at: #';
+ nextPutAll: familyName;
+ nextPutAll: 'OLD put: oldStyle. TextConstants removeKey: #';
+ nextPutAll: familyName;
+ nextPutAll: ' ].';
+ cr;
+ nextPutAll: 'TextStyle collectionFromCompressedMIMEString: ';
+ cr;
+ print: mimeStream contents;
+ nextPut: $.; cr; cr;
+ nextPutAll: 'TextConstants at: #';
+ nextPutAll: familyName;
+ nextPutAll: 'OLD ifPresent: [ :oldStyle | TextStyle replaceStyle: oldStyle with: (TextStyle named: ''';
+ nextPutAll: familyName;
+ nextPutAll: ''') ].';
+ cr;
+ nextPutAll: 'TextStyle replaceFontsIn: (TextStyle looseFontsFromFamily: ''';
+ nextPutAll: familyName;
+ nextPutAll: ''') with: (TextStyle named: ''';
+ nextPutAll: familyName;
+ nextPutAll: ''').';
+ cr ]).
+
+ cs fileOut.
+
+ !