'From Squeak 2.3 of January 14, 1999 on 1 February 2000 at 5:26:48 pm'! "Change Set: TeXFileOut 20000201 Date: February 1, 2000 Author: Andres Valloud Adds Smalltalk source to TeX translation automatically done from selection items in the browser menues. Important notice: If you were using TeXFileOut before, then you will need to change your font macro definition for Sans Serif from \ss to \sf. This is done so that it does not collide with the German double s character. New since the 19980810 release: * Less methods added to system classes (no String methods). * As a consequence, faster. * Works in Morphic. * Independent of Browser menu updates by the Squeak Central. * New useVboxes preference. When turned on, it avoids splitting methods in multiple pages. But sometimes it may produce underfull or overfull vboxes, depending on the length of the methods. By default, it is enabled. * Class comments and an usage guide. (this time for real). * Fixed filing out class comments. They were not being parsed neither typeset. SqR!! "! Object subclass: #StringParser instanceVariableNames: 'parser ocParser fastOutDetermination parserKeys ocParserKeys ' classVariableNames: '' poolDictionaries: '' category: 'Mathematics-TeX File Out'! Object subclass: #TeXFileOut instanceVariableNames: 'target fonts parser charsPerLine rightMargin currentWord commenting useVboxes ' classVariableNames: '' poolDictionaries: '' category: 'Mathematics-TeX File Out'! TeXFileOut class instanceVariableNames: 'preferences '! Browser subclass: #TeXFileOutBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Interface-Browser'! !ClassDescription methodsFor: 'Private - Tex fileOut' stamp: 'SqR!!!!!!!! 7/24/1998 17:49'! texFileOutCategoriesUsing: texer "File out all the categories with their methods of the receiver. Use TeX format" self organization categories asSortedCollection do: [:each | self texFileOutCategory: each using: texer]! ! !ClassDescription methodsFor: 'Private - Tex fileOut' stamp: 'SqR!!!! 9/10/1999 11:04'! texFileOutCategory: aCategory "File out a category of methods using TeX format" | fileStream | fileStream _ FileStream newFileNamed: self name , '-' , aCategory , '.tex'. self texFileOutCategory: aCategory using: (TeXFileOut new: fileStream). fileStream close! ! !ClassDescription methodsFor: 'Private - Tex fileOut' stamp: 'SqR!!!!!!!! 7/24/1998 17:47'! texFileOutCategory: aCategory using: texer "File out a category of methods using texer as the TeX formatter" texer outputCategory: aCategory. (self organization listAtCategoryNamed: aCategory) do: [:some | self texFileOutMethod: some using: texer] ! ! !ClassDescription methodsFor: 'Private - Tex fileOut' stamp: 'SqR!!!! 9/10/1999 11:04'! texFileOutMethod: selector "File out the method for the message whose selector is selector. Create a file named as the selector plus '.tex'" | fileStream nameBody | (self includesSelector: selector) ifFalse: [^ self halt: 'Selector not found']. nameBody _ self name , '-' , (selector copyReplaceAll: ':' with: ''). fileStream _ FileStream newFileNamed: nameBody , FileDirectory dot, 'tex'. self texFileOutMethod: selector using: (TeXFileOut new: fileStream). fileStream close! ! !ClassDescription methodsFor: 'Private - Tex fileOut' stamp: 'SqR!!!!!!!! 7/24/1998 17:51'! texFileOutMethod: selector using: texer "File out the method for the message whose selector is selector using texer as the TeX formatter" | methodSource | methodSource _ ReadWriteStream on: (String new: 32768). self printMethodChunk: selector withPreamble: false on: methodSource moveSource: false toFile: nil. methodSource reset. texer methodSource: methodSource ! ! !Class methodsFor: 'TeX fileOut' stamp: 'SqR!!!!!!!!!!!!!!!! 7/14/1998 22:15'! texFileOut "File out the receiver into a file named as the receiver with extension 'tex'. Use TeX format" | fileStream | fileStream _ FileStream fileNamed: self class name asString, FileDirectory dot, 'tex'. self texFileOutOn: fileStream. fileStream close! ! !Class methodsFor: 'TeX fileOut' stamp: 'SqR!!!! 9/10/1999 11:04'! texFileOutClassDefinitionOn: aStream "Output the definition of the receiver on aStream. Use TeX format" self texFileOutClassDefinitionUsing: (TeXFileOut new: aStream)! ! !Class methodsFor: 'TeX fileOut' stamp: 'SqR!!!!!!!!!!!!!!!! 7/19/1998 21:57'! texFileOutClassDefinitionUsing: texer "Output the definition of the receiver using texer as the TeX formatter" "Output class definition" texer class: self name kind: self kindOfSubclass subclassOf: self superclass name category: (SystemOrganization categoryOfElement: self name) iVars: self instanceVariablesString cVars: self classVariablesString pDicts: self sharedPoolsString! ! !Class methodsFor: 'TeX fileOut' stamp: 'SqR!!!! 9/10/1999 11:04'! texFileOutOn: aStream "File out the receiver into aStream. Use TeX format" self texFileOutUsing: (TeXFileOut new: aStream)! ! !Class methodsFor: 'TeX fileOut' stamp: 'SqR!!!!!!!! 7/24/1998 17:50'! texFileOutUsing: texer "File out the receiver. Use TeX format" "Shared Pools not supported yet" self texFileOutClassDefinitionUsing: texer. "Output class comments, if any" texer classComments: self organization classComment. "Continue with the metaclass" self class nonTrivial ifTrue: [texer outputClassProtocol. self class texFileOutUsing: texer]. "Now output the data for the class" methodDict size > 0 ifTrue: [ texer outputInstanceProtocol. self texFileOutCategoriesUsing: texer ]! ! !Browser class methodsFor: 'instance creation' stamp: 'SqR!!!! 9/8/1999 12:15'! basicNew ^super new systemOrganizer: SystemOrganization! ! !Browser class methodsFor: 'instance creation' stamp: 'SqR!!!! 9/8/1999 12:16'! new ^TeXFileOutBrowser basicNew! ! !CustomMenu methodsFor: 'accessing' stamp: 'SqR!!!! 9/8/1999 12:45'! labels ^labels! ! !CustomMenu methodsFor: 'accessing' stamp: 'SqR!!!! 9/8/1999 12:40'! lines ^dividers! ! !FileContentsBrowser class methodsFor: 'instance creation' stamp: 'SqR!!!! 9/9/1999 12:57'! new "TeXFileOut support" ^super basicNew! ! !HierarchyBrowser class reorganize! ('instance creation' new) ! !HierarchyBrowser class methodsFor: 'instance creation' stamp: 'SqR!!!! 9/9/1999 12:58'! new "TeXFileOut support" ^super basicNew! ! !MessageSet class methodsFor: 'instance creation' stamp: 'SqR!!!! 9/9/1999 12:56'! new "TeXFileOut support" ^super basicNew! ! !Metaclass reorganize! ('initialize-release' instanceVariableNames: newNamed: subclassOf: updateInstancesFrom:) ('accessing' isMeta isSystemDefined name soleInstance theNonMetaClass) ('copying' copy copyForValidation veryDeepCopyWith:) ('instance creation' new) ('instance variables' addInstVarName: removeInstVarName:) ('pool variables' classPool) ('class hierarchy' name:inEnvironment:subclassOf:instanceVariableNames:variable:words:pointers:classVariableNames:poolDictionaries:category:comment:changed: name:inEnvironment:subclassOf:instanceVariableNames:variable:words:pointers:weak:classVariableNames:poolDictionaries:category:comment:changed: subclasses subclassesDo:) ('compiling' acceptsLoggingOfCompilation possibleVariablesFor:continuedFrom: scopeHas:ifTrue: wantsChangeSetLogging) ('Private - TeX fileOut' texFileOutUsing:) ('fileIn/Out' definition fileOutOn:moveSource:toFile: nonTrivial objectForDataStream: storeDataOn:) ! !Metaclass methodsFor: 'Private - TeX fileOut' stamp: 'SqR!!!!!!!! 7/24/1998 17:47'! texFileOutUsing: texer "File out the receiver. Use TeX format" "Hyper alpha state" "Output the data for the class" self organization categories asSortedCollection do: [:each | self texFileOutCategory: each using: texer]! ! !Stream methodsFor: 'accessing'! nextLine "Answer the next line of text in the receiver" | result cr current | result _ OrderedCollection new. cr _ Character cr. current _ 0 asCharacter. [current = cr or: [self atEnd]] whileFalse: [current _ self next. result add: current]. result add: current. (self atEnd not and: [self peek = Character linefeed]) ifTrue: [result add: self next]. ^String newFrom: result! ! !PositionableStream methodsFor: 'accessing'! inclusiveUpTo: anObject "Answer a subcollection from the current access position to the occurrence (if any) of anObject in the receiver. If anObject is not in the collection, answer the entire rest of the receiver." | newStream last | newStream _ WriteStream on: (collection species new: 100). [self atEnd or: [last = anObject]] whileFalse: [newStream nextPut: (last _ self next)]. ^newStream contents! ! !StringHolder methodsFor: 'message list menu' stamp: 'SqR!!!!!!!!!!!!!!!! 7/19/1998 21:14'! texFileOutMessage "File out the selected message using tex format" self selectedMessageName ifNotNil: [ self selectedClassOrMetaClass texFileOutMethod: self selectedMessageName]! ! !StringParser reorganize! ('Accessing' parseKeyAmount) ('Parser loading' doNotParse: loadDictionary: parse:as: parsedFor: parses: unloadDictionary:) ('Parser loading (open close)' doNotocParse: ocParses: parse:whenOpenAs:whenClosedAs:) ('Parsing' initializeOpenClosed parse:) ('Printing' printOn:) ('Private' initialize) ('Private - Enumerating' allParserKeysDo:) ('Private - Fast Out Determination' fastOutFor: rebuildFastOut updateFastOut:) ('Private - Parser manteinance' ensureSubParser: ensureSubocParser: ensureUsefulSubParser: ensureUsefulSubocParser:) ('Private - Parsing' parse:at:) ! !StringParser methodsFor: 'Accessing' stamp: 'SqR!!!!!!!! 8/2/1998 03:27'! parseKeyAmount "Answer the amount of parsing keys" ^(parser inject: 0 into: [:total :each | total + each size]) + (ocParser inject: 0 into: [:total2 :each2 | total2 + each2 size])! ! !StringParser methodsFor: 'Parser loading' stamp: 'SqR!!!!!!!! 8/2/1998 02:55'! doNotParse: aSubstring "Leave occurrences of aSubstring alone" (parserKeys includes: aSubstring size) ifTrue: [ (parser at: aSubstring size) removeKey: aSubstring ifAbsent: []. self ensureUsefulSubParser: aSubstring size. self rebuildFastOut. ]! ! !StringParser methodsFor: 'Parser loading' stamp: 'SqR!!!!!!!! 8/2/1998 20:43'! loadDictionary: aDictionary "Parse every key in aDictionary as its corresponding value" aDictionary associationsDo: [:each | self parse: each key as: each value]! ! !StringParser methodsFor: 'Parser loading' stamp: 'SqR!!!!!!!! 8/2/1998 02:25'! parse: aKey as: aReplacement "Set the parser to parse aKey as aReplacement" self ensureSubParser: aKey size. (parser at: aKey size) at: aKey put: aReplacement. self updateFastOut: aKey! ! !StringParser methodsFor: 'Parser loading' stamp: 'SqR!!!!!!!! 8/2/1998 02:13'! parsedFor: aSubstring "Answer the replacement the receiver uses for aSubstring. If no replacement is used, answer nil" (parserKeys includes: aSubstring size) ifFalse: [^nil]. ^(parser at: aSubstring size) at: aSubstring ifAbsent: []! ! !StringParser methodsFor: 'Parser loading' stamp: 'SqR!!!!!!!! 8/2/1998 02:13'! parses: aSubstring "Answer true if the receiver parses aSubstring" ^(self parsedFor: aSubstring) isNil not! ! !StringParser methodsFor: 'Parser loading' stamp: 'SqR!!!!!!!! 8/2/1998 02:15'! unloadDictionary: aDictionary "Do not parse any key in aDictionary" aDictionary associationsDo: [:each | self doNotParse: each key]! ! !StringParser methodsFor: 'Parser loading (open close)' stamp: 'SqR!!!!!!!! 8/2/1998 02:56'! doNotocParse: aSubstring "Leave occurrences of aSubstring alone" (ocParserKeys includes: aSubstring size) ifTrue: [ (ocParser at: aSubstring size) removeKey: aSubstring ifAbsent: []. self ensureUsefulSubocParser: aSubstring size. self rebuildFastOut. ]! ! !StringParser methodsFor: 'Parser loading (open close)' stamp: 'SqR!!!!!!!! 8/2/1998 03:30'! ocParses: aSubstring "Answer true if the receiver open closed parses aSubstring" (ocParserKeys includes: aSubstring size) ifFalse: [^false]. ^(ocParser at: aSubstring size) includesKey: aSubstring! ! !StringParser methodsFor: 'Parser loading (open close)' stamp: 'SqR!!!!!!!! 8/2/1998 03:25'! parse: aKey whenOpenAs: openRep whenClosedAs: closedRep "Parse aKey as openRep when it's open (odd occurrence) and as closedRep when it's closed (even occurrence)" self ensureSubocParser: aKey size. (ocParser at: aKey size) at: aKey put: (Array with: 2 with: openRep with: closedRep). self updateFastOut: aKey! ! !StringParser methodsFor: 'Parsing' stamp: 'SqR!!!!!!!! 8/2/1998 20:59'! initializeOpenClosed "Initialize the open closed parsing" ocParserKeys do: [:each | (ocParser at: each) do: [:some | some at: 1 put: 2] ]! ! !StringParser methodsFor: 'Parsing' stamp: 'SqR!!!!!!!! 8/2/1998 20:59'! parse: aString "Answer the parsed string for aString" | index answer currentParsed skip aStringSize temp | answer _ OrderedCollection new: (aString size * 1.1) truncated. index _ 1. aStringSize _ aString size. [index > aStringSize] whileFalse: [ (self fastOutFor: (aString at: index)) ifTrue: [answer add: (aString at: index). index _ index + 1] ifFalse: [ currentParsed _ nil. skip _ parserKeys detect: [:one | one + index - 1 > aStringSize ifFalse: [currentParsed _ (parser at: one) at: (aString copyFrom: index to: index + one - 1) ifAbsent: []]. currentParsed isNil not ] ifNone: [ ocParserKeys detect: [:another | another + index - 1 > aStringSize ifFalse: [ temp _ (ocParser at: another) at: (aString copyFrom: index to: index + another - 1) ifAbsent: []. temp isNil ifFalse: [ currentParsed _ temp at: (temp at: 1). temp at: 1 put: (temp at: 1) - 1 \\ 2 + 2. ]. ]. currentParsed isNil not ] ifNone: [] ]. skip isNil ifTrue: [answer add: (aString at: index). index _ index + 1] ifFalse: [answer addAll: currentParsed. index _ index + skip]. ]. ]. ^String newFrom: answer! ! !StringParser methodsFor: 'Printing' stamp: 'SqR!!!!!!!! 8/2/1998 02:22'! printOn: aStream "Blah!!" | keys | aStream nextPutAll: self class name. aStream nextPut: $(. keys _ self parseKeyAmount. keys printOn: aStream. keys = 1 ifTrue: [aStream nextPutAll: ' key)'] ifFalse: [aStream nextPutAll: ' keys)']! ! !StringParser methodsFor: 'Private' stamp: 'SqR!!!!!!!! 8/2/1998 02:49'! initialize "Initialize the receiver" parser _ Dictionary new. parserKeys _ SortedCollection sortBlock: [:one :another | another < one]. ocParser _ Dictionary new. ocParserKeys _ SortedCollection sortBlock: [:one :another | another < one]. self rebuildFastOut! ! !StringParser methodsFor: 'Private - Enumerating' stamp: 'SqR!!!!!!!! 8/2/1998 02:49'! allParserKeysDo: aBlock "Evaluate aBlock for all the keys of the parser" parser do: [:each | each keys do: aBlock]. ocParser do: [:each | each keys do: aBlock].! ! !StringParser methodsFor: 'Private - Fast Out Determination' stamp: 'SqR!!!!!!!! 8/2/1998 02:33'! fastOutFor: aCharacter "Answer if a fast out can be performed on aCharacter" ^fastOutDetermination at: aCharacter asciiValue + 1! ! !StringParser methodsFor: 'Private - Fast Out Determination' stamp: 'SqR!!!!!!!! 8/2/1998 17:10'! rebuildFastOut "Rebuild the fast out determination cache" fastOutDetermination _ Array new: 256. fastOutDetermination atAllPut: true. self allParserKeysDo: [:each | self updateFastOut: each]! ! !StringParser methodsFor: 'Private - Fast Out Determination' stamp: 'SqR!!!!!!!! 8/2/1998 17:10'! updateFastOut: aKey "Update the fast out determination cache" fastOutDetermination at: (aKey at: 1) asciiValue + 1 put: false! ! !StringParser methodsFor: 'Private - Parser manteinance' stamp: 'SqR!!!!!!!! 8/2/1998 02:11'! ensureSubParser: anInteger "Ensure the sub parser for anInteger character parsing keys exists and is operational" (parserKeys includes: anInteger) ifFalse: [ parser at: anInteger put: Dictionary new. parserKeys add: anInteger ]! ! !StringParser methodsFor: 'Private - Parser manteinance' stamp: 'SqR!!!!!!!! 8/2/1998 02:50'! ensureSubocParser: anInteger "Ensure the sub ocParser for anInteger character parsing keys exists and is operational" (ocParserKeys includes: anInteger) ifFalse: [ ocParser at: anInteger put: Dictionary new. ocParserKeys add: anInteger ]! ! !StringParser methodsFor: 'Private - Parser manteinance' stamp: 'SqR!!!!!!!! 8/2/1998 02:19'! ensureUsefulSubParser: anInteger "Ensure the sub parser for anInteger character parsing keys is useful. Otherwise, delete it" ((parserKeys includes: anInteger) and: [(parser at: anInteger) size = 0]) ifTrue: [ parser removeKey: anInteger. parserKeys removeAt: (parserKeys indexOf: anInteger) ]! ! !StringParser methodsFor: 'Private - Parser manteinance' stamp: 'SqR!!!!!!!! 8/2/1998 02:51'! ensureUsefulSubocParser: anInteger "Ensure the sub ocParser for anInteger character parsing keys is useful. Otherwise, delete it" ((ocParserKeys includes: anInteger) and: [(ocParser at: anInteger) size = 0]) ifTrue: [ ocParser removeKey: anInteger. ocParserKeys removeAt: (ocParserKeys indexOf: anInteger) ]! ! !StringParser methodsFor: 'Private - Parsing' stamp: 'SqR!!!!!!!! 8/2/1998 03:03'! parse: aString at: anIndex "Answer the parsing of aString at anIndex" | answer | parserKeys do: [:each | each + anIndex - 1 > aString size ifFalse: [ answer _ (parser at: each) at: (aString copyFrom: anIndex to: anIndex + each - 1). answer isNil ifFalse: [^answer]. ]. ]. ocParserKeys do: [:each | each + anIndex - 1 > aString size ifFalse: [ answer _ (ocParser at: each) at: (aString copyFrom: anIndex to: anIndex + each - 1). answer isNil ifFalse: [^answer]. ]. ]. ^(aString at: anIndex) asString! ! !StringParser class reorganize! ('Instance creation' new) ! !StringParser class methodsFor: 'Instance creation' stamp: 'SqR!!!!!!!! 8/2/1998 01:37'! new "Answer a new instance of the receiver" ^super new initialize! ! !SystemOrganizer reorganize! ('fileIn/Out' fileOutCategory: fileOutCategory:asHtml: fileOutCategory:on: objectForDataStream: superclassOrder:) ('remove' removeCategoriesMatching: removeMissingClasses removeSystemCategory:) ('TeX fileOut' texFileOutCategory: texFileOutCategory:using:) ! !SystemOrganizer methodsFor: 'TeX fileOut' stamp: 'SqR!!!! 9/10/1999 11:04'! texFileOutCategory: category "Store on the file named category (a string) concatenated with '.tex' all the classes associated with the category. Use TeX format" | fileStream | fileStream _ FileStream fileNamed: category, FileDirectory dot, 'tex'. self texFileOutCategory: category using: (TeXFileOut new: fileStream). fileStream close! ! !SystemOrganizer methodsFor: 'TeX fileOut' stamp: 'SqR!!!!!!!!!!!!!!!! 7/19/1998 21:42'! texFileOutCategory: category using: texer "Fileout all the classes associated with the category. Use texer as the TeX formatter. Does not support shared pools yet." Cursor write showWhile: [(self superclassOrder: category) do: [:class | class texFileOutUsing: texer]]! ! Smalltalk renameClassNamed: #TexFileOut as: #TeXFileOut! !TeXFileOut commentStamp: 'SqR!! 2/1/2000 17:08' prior: 0! TeXFileOut uses 4 fonts for preparing its output. They are referenced through the macros \rm, \sf, \ssit and \ssbf. Of these four macros, only one is standard for plain tex. You will need to define the other three. The fonts meant to be used with these macros are: \sf -> CMSS10 \ssit -> CMSSI10 \ssbf -> CMSSBX10 Here is a way to make the font definition easy. First, we will create a file named fileout.tex In this file, we will put: % Sans serif \font\sf = cmss10 %Sans serif \font\ssit = cmssi10 %Sans serif italic \font\ssbf = cmssbx10 %Sans serif boldface extended As you can see, these are font name definitions. It means that once these are read, you (or TeXFileOut) can use \sf, \ssit and \ssbf to refer to fonts. Now, to include this in everything you write, you can use the \input macro. So, your TeX documents would look like: \input fileout.tex % Your text comes here \bye Note that each file read by \input should not contain a \bye at the end. It behaves like the include mechanism for Pascal, C and Assembler. I made TeXFileOut thinking that I would avoid macro definition by TeXFileOut, because then it could overwrite your own macros by accident. The price is that the font macros have to be defined first. Also, TeXFileOut outputs .tex files proper for the \input mechanism only. This is so because TeXFileOut was designed to help preparing notes for class. Also, this mechanism makes updating such notes much easier. Let's say you have produced .tex files for the Date and Time classes. Then, your document will look like this: \input fileout.tex % Some text, and now comes the class Date: \input date.tex % And then we continue with our text, and then we want the class Time: \input time.tex % Then we reach the end, so we have to use \bye \bye In order to update the notes, all you have to do is to generate a new version of the files date.tex and time.tex. If you have any comments or suggestions, please send me a mail to sqrmax@cvtci.com.ar. I also read the MathMorphs list. You will find other users of TeXFileOut there. If you want to subscribe, send a mail to majordomo@dm.uba.ar with "subscribe mathmorphs" in the message body.! !TeXFileOut reorganize! ('File out' class:kind:subclassOf:category:iVars:cVars:pDicts: classComments: methodSource: outputBanner: outputCategory: outputClassComments outputClassProtocol outputInstanceProtocol) ('File out fonts' fontFor: setDefaultFonts setFontFor:to:) ('Presets' replaceTabWith: rightMargin rightMargin: tabReplacement) ('TeX control' bigSkip closeBlock closeItemVBox closeLine closeVbox commenting: crLf emptyItem: endSection medSkip noIndent openFontBlock: openFontBlockWithFontFor: openItemVBox openLine openVbox setFontTo: smallSkip terminateLine) ('Private - Initializing' initialize: initializeParser stampVersion useVboxes:) ('Private - Method file out' methodCodeLine: methodEndLine methodSelector: noCrLfs: shorten:) ('Private - Text parsing' ?!! nextPut: nextPutAll: nextPutComments: nextPutLine: tryToFlush:) ! !TeXFileOut methodsFor: 'File out' stamp: 'SqR!!!! 2/1/2000 17:20'! class: className kind: kindOfSubclass subclassOf: superclassName category: cat iVars: iVars cVars: cVars pDicts: pDicts "Output a class definition with the given parameters" "Open section" self nextPutComments: 'Class definition submitted for class: ', className, '.'. self openVbox. self openFontBlockWithFontFor: #normal. self crLf. "First line containing class name" self noIndent. self openFontBlockWithFontFor: #bold. self nextPutAll: superclassName, kindOfSubclass. self closeBlock. self nextPutLine: className. "Subsequent lines containing class data" self crLf. cat isEmpty ifFalse: [self emptyItem: 'Category: ', cat]. iVars isEmpty ifFalse: [self emptyItem: 'Instance variable names: ', iVars]. cVars isEmpty ifFalse: [self emptyItem: 'Class variable names: ', cVars]. pDicts isEmpty ifFalse: [self emptyItem: 'Shared pool dictionaries: ', pDicts]. self closeBlock closeVbox endSection tryToFlush: true! ! !TeXFileOut methodsFor: 'File out' stamp: 'SqR!!!! 2/1/2000 17:23'! classComments: aString "Output class comments in aString" | rS | aString isEmpty ifTrue: [^self]. rS _ ReadStream on: aString. self nextPutComments: 'Comments submitted.'. self outputClassComments bigSkip smallSkip noIndent. parser initializeOpenClosed. self openFontBlockWithFontFor: #comments. [rS atEnd] whileFalse: [self methodCodeLine: self ?!! rS nextLine]. self closeBlock. self endSection. self tryToFlush: true! ! !TeXFileOut methodsFor: 'File out' stamp: 'SqR!!!! 9/10/1999 12:43'! methodSource: aStream "Output the method source in aStream" | currentLine | self crLf nextPutComments: 'Method submitted.'. parser initializeOpenClosed. self openVbox. self openFontBlockWithFontFor: #normal. self bigSkip. currentLine _ aStream nextLine. self methodSelector: (self noCrLfs: currentLine). [aStream atEnd] whileFalse: [ currentLine _ self noCrLfs: aStream nextLine. aStream atEnd ifTrue: [currentLine _ currentLine copyFrom: 1 to: currentLine size - 1]. self methodCodeLine: currentLine ]. self closeBlock closeVbox endSection tryToFlush: true! ! !TeXFileOut methodsFor: 'File out' stamp: 'SqR!!!! 2/1/2000 17:12'! outputBanner: aString "Output a class comments banner" self bigSkip medSkip noIndent. self openFontBlockWithFontFor: #bold. self nextPutAll: aString. self closeBlock. self crLf.! ! !TeXFileOut methodsFor: 'File out' stamp: 'SqR!!!!!!!!!!!!!!!! 7/14/1998 23:04'! outputCategory: aString "Output a category banner" self bigSkip smallSkip noIndent. self openFontBlockWithFontFor: #bold. self nextPutAll: 'Methods for category: ', aString. self closeBlock. self crLf.! ! !TeXFileOut methodsFor: 'File out' stamp: 'SqR!!!! 2/1/2000 17:12'! outputClassComments "Output a class comments banner" self outputBanner: 'Class comments'! ! !TeXFileOut methodsFor: 'File out' stamp: 'SqR!!!! 2/1/2000 17:12'! outputClassProtocol "Output a class protocol banner" self outputBanner: 'Class protocol'! ! !TeXFileOut methodsFor: 'File out' stamp: 'SqR!!!! 2/1/2000 17:12'! outputInstanceProtocol "Output an instance protocol banner" self outputBanner: 'Instance protocol'! ! !TeXFileOut methodsFor: 'File out fonts' stamp: 'SqR!!!!!!!!!!!!!!!! 7/13/1998 01:04'! fontFor: aSymbol "Answer the font corresponding to aSymbol" ^fonts at: aSymbol! ! !TeXFileOut methodsFor: 'File out fonts' stamp: 'SqR!!!! 1/31/2000 20:53'! setDefaultFonts "Set the default fonts" fonts at: #bold put: 'ssbf'. fonts at: #normal put: 'sf'. fonts at: #italic put: 'ssit'. fonts at: #comments put: 'rm'! ! !TeXFileOut methodsFor: 'File out fonts' stamp: 'SqR!!!!!!!!!!!!!!!! 7/13/1998 00:13'! setFontFor: aSymbol to: aString "Set the font corresponding to aSymbol to aString. Please do not add useless fonts" (fonts includesKey: aSymbol) ifFalse: [^self error: 'Useless font']. fonts at: aSymbol put: aString! ! !TeXFileOut methodsFor: 'Presets' stamp: 'SqR!!!!!!!! 7/24/1998 04:16'! replaceTabWith: aString "Replace the tab characters with the TeX expression contained in aString" (parser at: 1) at: Character tab asString put: aString! ! !TeXFileOut methodsFor: 'Presets' stamp: 'SqR!!!!!!!!!!!!!!!! 7/14/1998 23:06'! rightMargin "Answer the right margin for outputting a tex source" ^rightMargin! ! !TeXFileOut methodsFor: 'Presets' stamp: 'SqR!!!!!!!!!!!!!!!! 7/14/1998 23:06'! rightMargin: anInteger "Set the right margin for outputting a tex source to anInteger characters" rightMargin _ anInteger! ! !TeXFileOut methodsFor: 'Presets' stamp: 'SqR!!!!!!!! 7/24/1998 04:16'! tabReplacement "Answer the current tab replacement" ^(parser at: 1) at: Character tab asString! ! !TeXFileOut methodsFor: 'TeX control' stamp: 'SqR!!!!!!!! 7/24/1998 03:28'! bigSkip "Output a bigskip" self crLf. self nextPutLine: '\bigskip'! ! !TeXFileOut methodsFor: 'TeX control' stamp: 'SqR!!!!!!!!!!!!!!!! 7/14/1998 23:01'! closeBlock "Close a block" self nextPutAll: '}'! ! !TeXFileOut methodsFor: 'TeX control' stamp: 'SqR!!!!!!!!!!!!!!!! 7/14/1998 23:01'! closeItemVBox "Close an item vbox" self nextPutAll: '}$$'! ! !TeXFileOut methodsFor: 'TeX control' stamp: 'SqR!!!!!!!!!!!!!!!! 7/14/1998 23:01'! closeLine "Close a line" self closeBlock crLf! ! !TeXFileOut methodsFor: 'TeX control' stamp: 'SqR!!!! 9/10/1999 12:38'! closeVbox "Close an vbox" useVboxes ifTrue: [self nextPutAll: '}']! ! !TeXFileOut methodsFor: 'TeX control' stamp: 'SqR!!!!!!!! 7/24/1998 18:13'! commenting: aBoolean "Set the commenting feature on or off" commenting _ aBoolean! ! !TeXFileOut methodsFor: 'TeX control' stamp: 'SqR!!!!!!!! 7/24/1998 18:48'! crLf "Output a cr lf pair" self tryToFlush: true. self terminateLine! ! !TeXFileOut methodsFor: 'TeX control' stamp: 'SqR!!!!!!!! 7/24/1998 03:29'! emptyItem: aString "Append an empty item" self nextPutLine: '\item{} ', aString! ! !TeXFileOut methodsFor: 'TeX control' stamp: 'SqR!!!! 9/10/1999 12:50'! endSection "End a section" self crLf crLf! ! !TeXFileOut methodsFor: 'TeX control' stamp: 'SqR!!!! 9/10/1999 12:48'! medSkip "Output a medskip" self nextPutLine: '\medskip'. self crLf ! ! !TeXFileOut methodsFor: 'TeX control' stamp: 'SqR!!!!!!!! 7/24/1998 17:58'! noIndent "Output a noIndent" self nextPutAll: '\noindent '! ! !TeXFileOut methodsFor: 'TeX control' stamp: 'SqR!!!!!!!!!!!!!!!! 7/14/1998 23:03'! openFontBlock: aFontName "Open a font block" self nextPutAll: '{\', aFontName, ' '! ! !TeXFileOut methodsFor: 'TeX control' stamp: 'SqR!!!!!!!!!!!!!!!! 7/14/1998 23:03'! openFontBlockWithFontFor: aSymbol "Open a font block" self openFontBlock: (self fontFor: aSymbol)! ! !TeXFileOut methodsFor: 'TeX control' stamp: 'SqR!!!!!!!!!!!!!!!! 7/14/1998 23:03'! openItemVBox "Open an item vbox" self nextPutAll: '$$\vbox{'! ! !TeXFileOut methodsFor: 'TeX control' stamp: 'SqR!!!!!!!!!!!!!!!! 7/14/1998 23:03'! openLine "Open a line" self nextPutAll: '\line{'! ! !TeXFileOut methodsFor: 'TeX control' stamp: 'SqR!!!! 9/10/1999 12:31'! openVbox "Open an vbox" useVboxes ifTrue: [ self nextPutAll: '\vbox{'. self crLf ]! ! !TeXFileOut methodsFor: 'TeX control' stamp: 'SqR!!!!!!!!!!!!!!!! 7/14/1998 23:03'! setFontTo: aSymbol "Set the font to the one stored for aSymbol" self nextPutAll: '\', (self fontFor: aSymbol)! ! !TeXFileOut methodsFor: 'TeX control' stamp: 'SqR!!!! 9/10/1999 12:48'! smallSkip "Output a smallskip" self nextPutLine: '\smallskip'. self crLf! ! !TeXFileOut methodsFor: 'TeX control' stamp: 'SqR!!!!!!!! 7/24/1998 18:48'! terminateLine "Terminate the current line of output and update all stuff to process next line" target cr lf. charsPerLine _ 0 ! ! !TeXFileOut methodsFor: 'Private - Initializing' stamp: 'SqR!!!! 9/10/1999 10:55'! initialize: aStream "Initialize the receiver" fonts _ Dictionary new. self setDefaultFonts. charsPerLine _ 0. rightMargin _ 72. useVboxes _ false. currentWord _ String new. target _ aStream. commenting _ false. self initializeParser. self stampVersion! ! !TeXFileOut methodsFor: 'Private - Initializing' stamp: 'SqR!!!! 1/31/2000 21:25'! initializeParser "Initialize the parser" | parser1 parser2 parser3 | parser1 _ Dictionary new. parser1 at: '_' put: '$\leftarrow$'. parser1 at: '^' put: '$\uparrow$'. parser1 at: '\' put: '$\backslash$'. parser1 at: '$' put: '\$'. parser1 at: '%' put: '\%'. parser1 at: '{' asString put: '$\{$'. parser1 at: '}' asString put: '$\}$'. parser1 at: '&' put: '\&'. parser1 at: '#' put: '\#'. parser1 at: '|' put: '$|$'. parser1 at: '>' put: '$>$'. parser1 at: '<' put: '$<$'. parser1 at: '-' put: '$-$'. parser1 at: '+' put: '$+$'. parser1 at: '*' put: '$\times$'. parser1 at: '/' put: '$/$'. parser1 at: '~' put: '$\sim$'. "\~{}" parser1 at: '=' put: '$=$'. parser1 at: Character tab asString put: '\quad '. parser2 _ Dictionary new. parser2 at: '>=' put: '$\geq$'. parser2 at: '<=' put: '$\leq$'. parser2 at: '~=' put: '$\not =$'. parser2 at: '[]' put: '[$\,$]'. parser2 at: ']]' put: ']$\,$]'. parser2 at: '!!!!' put: '!!'. parser2 at: '''''' put: '''$\,$'''. parser2 at: '->' put: '$\rightarrow$'. parser2 at: ':=' put: '$\leftarrow$'. parser3 _ Dictionary new. parser3 at: '[]]' put: '[$\,$]$\,$]'. parser _ StringParser new. parser loadDictionary: parser1. parser loadDictionary: parser2. parser loadDictionary: parser3. parser parse: '"' whenOpenAs: '``' whenClosedAs: '"'! ! !TeXFileOut methodsFor: 'Private - Initializing' stamp: 'SqR!!!! 2/1/2000 16:57'! stampVersion "Stamp a version notice on the fileout" self nextPutComments: 'TeXFileOut version 20000201 by Andres Valloud (SqR!!)'. target cr lf! ! !TeXFileOut methodsFor: 'Private - Initializing' stamp: 'SqR!!!! 9/10/1999 11:24'! useVboxes: aBoolean useVboxes _ aBoolean! ! !TeXFileOut methodsFor: 'Private - Method file out' stamp: 'SqR!!!! 9/10/1999 12:48'! methodCodeLine: aString "Output a method code line" (aString detect: [:one | one asciiValue > 32] ifNone: []) isNil ifTrue: [self medSkip] ifFalse: [ self noIndent. self nextPutAll: self ?!! aString. self methodEndLine ]! ! !TeXFileOut methodsFor: 'Private - Method file out' stamp: 'SqR!!!!!!!! 7/24/1998 03:58'! methodEndLine "End a method line" self crLf crLf! ! !TeXFileOut methodsFor: 'Private - Method file out' stamp: 'SqR!!!! 9/7/1999 19:30'! methodSelector: aString "Output a method selector" | data bold words | self noIndent. data _ ReadStream on: aString. bold _ true. words _ 0. [data atEnd] whileFalse: [ bold ifTrue: [self openFontBlockWithFontFor: #bold] ifFalse: [self openFontBlockWithFontFor: #italic]. self nextPutAll: (self ?!! (self shorten: (data nextDelimited: Character space))). (data atEnd or: [bold]) ifFalse: [self nextPutAll: '\/ ']. self closeBlock. (data atEnd not and: [bold]) ifTrue: [self nextPut: $~]. bold _ bold not. words _ words + 1. words \\ 8 = 0 ifTrue: [self crLf" crLf. self noIndent"]. ]. self methodEndLine! ! !TeXFileOut methodsFor: 'Private - Method file out' stamp: 'SqR!!!! 9/8/1999 12:28'! noCrLfs: aString ^aString reject: [:one | one == Character cr or: [one == Character lf]]! ! !TeXFileOut methodsFor: 'Private - Method file out' stamp: 'SqR!!!! 9/7/1999 19:30'! shorten: aString "Answer aString with no trailing spaces" aString size to: 1 by: -1 do: [:each | (aString at: each) == Character space ifFalse: [^aString copyFrom: 1 to: each] ]. ^''! ! !TeXFileOut methodsFor: 'Private - Text parsing' stamp: 'SqR!!!!!!!! 8/2/1998 17:13'! ?!! aString "Answer aString parsed for TeX" ^parser parse: aString! ! !TeXFileOut methodsFor: 'Private - Text parsing' stamp: 'SqR!!!!!!!!!!!!!!!! 7/14/1998 23:54'! nextPut: aCharacter "Output a character" currentWord _ currentWord, aCharacter asString. self tryToFlush: false! ! !TeXFileOut methodsFor: 'Private - Text parsing' stamp: 'SqR!!!!!!!!!!!!!!!! 7/14/1998 23:59'! nextPutAll: aString "Output a string" | stream | stream _ ReadStream on: aString. [stream atEnd] whileFalse: [ currentWord _ currentWord, (stream inclusiveUpTo: Character space). self tryToFlush: false ]! ! !TeXFileOut methodsFor: 'Private - Text parsing' stamp: 'SqR!!!!!!!! 7/24/1998 18:59'! nextPutComments: aString "Output aString followed by cr and lf. Add comment strings so that TeX ignores it" self commenting: true. self nextPutAll: '% ', aString. self crLf. self commenting: false! ! !TeXFileOut methodsFor: 'Private - Text parsing' stamp: 'SqR!!!!!!!! 7/24/1998 03:27'! nextPutLine: aString "Output aString followed by cr and lf" self nextPutAll: aString. self crLf! ! !TeXFileOut methodsFor: 'Private - Text parsing' stamp: 'SqR!!!! 9/7/1999 19:31'! tryToFlush: forced "Attempt to flush the current word" | toWrite overflow | overflow _ charsPerLine + 1 + currentWord size > rightMargin. (currentWord size ~= 0 and: [(currentWord last = Character space or: [forced])]) ifTrue: [ overflow ifTrue: [self terminateLine]. charsPerLine = 0 ifTrue: [toWrite _ self shorten: currentWord] ifFalse: [toWrite _ Character space asString, (self shorten: currentWord)]. commenting & overflow ifTrue: [toWrite _ '% ', toWrite]. target nextPutAll: toWrite. charsPerLine _ charsPerLine + toWrite size. currentWord _ '' ]! ! !TeXFileOut commentStamp: 'SqR!! 2/1/2000 17:08' prior: 0! TeXFileOut uses 4 fonts for preparing its output. They are referenced through the macros \rm, \sf, \ssit and \ssbf. Of these four macros, only one is standard for plain tex. You will need to define the other three. The fonts meant to be used with these macros are: \sf -> CMSS10 \ssit -> CMSSI10 \ssbf -> CMSSBX10 Here is a way to make the font definition easy. First, we will create a file named fileout.tex In this file, we will put: % Sans serif \font\sf = cmss10 %Sans serif \font\ssit = cmssi10 %Sans serif italic \font\ssbf = cmssbx10 %Sans serif boldface extended As you can see, these are font name definitions. It means that once these are read, you (or TeXFileOut) can use \sf, \ssit and \ssbf to refer to fonts. Now, to include this in everything you write, you can use the \input macro. So, your TeX documents would look like: \input fileout.tex % Your text comes here \bye Note that each file read by \input should not contain a \bye at the end. It behaves like the include mechanism for Pascal, C and Assembler. I made TeXFileOut thinking that I would avoid macro definition by TeXFileOut, because then it could overwrite your own macros by accident. The price is that the font macros have to be defined first. Also, TeXFileOut outputs .tex files proper for the \input mechanism only. This is so because TeXFileOut was designed to help preparing notes for class. Also, this mechanism makes updating such notes much easier. Let's say you have produced .tex files for the Date and Time classes. Then, your document will look like this: \input fileout.tex % Some text, and now comes the class Date: \input date.tex % And then we continue with our text, and then we want the class Time: \input time.tex % Then we reach the end, so we have to use \bye \bye In order to update the notes, all you have to do is to generate a new version of the files date.tex and time.tex. If you have any comments or suggestions, please send me a mail to sqrmax@cvtci.com.ar. I also read the MathMorphs list. You will find other users of TeXFileOut there. If you want to subscribe, send a mail to majordomo@dm.uba.ar with "subscribe mathmorphs" in the message body.! !TeXFileOut class reorganize! ('Instance creation' initialize new: useVboxes:) ! !TeXFileOut class methodsFor: 'Instance creation' stamp: 'SqR!!!! 9/10/1999 11:00'! initialize preferences _ Dictionary new! ! !TeXFileOut class methodsFor: 'Instance creation' stamp: 'SqR!!!! 9/10/1999 11:01'! new: aStream "Answer a new instance of the receiver" ^(self new initialize: aStream) useVboxes: (preferences at: #useVboxes ifAbsent: [false])! ! !TeXFileOut class methodsFor: 'Instance creation' stamp: 'SqR!!!! 9/10/1999 11:01'! useVboxes: aBoolean "Set the useVboxes preference to aBoolean" preferences at: #useVboxes put: aBoolean! ! !TeXFileOutBrowser methodsFor: 'menues' stamp: 'SqR!!!! 9/8/1999 13:22'! classListMenu: aMenu "Append TeXFileOut items" | superMenu labels lines selections menu | menu _ aMenu isMorph ifTrue: [aMenu copy] ifFalse: [aMenu deepCopy]. superMenu _ super classListMenu: aMenu. ^aMenu isMorph ifTrue: [aMenu addLine. aMenu add: 'TeXFileOut' action: #texFileOutClass] ifFalse: [ labels _ superMenu labels copy. labels add: 'TeXFileOut'. lines _ superMenu lines copyWith: superMenu labels size. selections _ superMenu selections copyWith: #texFileOutClass. menu labels: labels lines: lines selections: selections ]! ! !TeXFileOutBrowser methodsFor: 'menues' stamp: 'SqR!!!! 9/8/1999 13:21'! messageCategoryMenu: aMenu "Append TeXFileOut items" | superMenu labels lines selections menu | menu _ aMenu isMorph ifTrue: [aMenu copy] ifFalse: [aMenu deepCopy]. superMenu _ super messageCategoryMenu: aMenu. ^aMenu isMorph ifTrue: [aMenu addLine. aMenu add: 'TeXFileOut' action: #texFileOutMessageCategories] ifFalse: [ labels _ superMenu labels copy. labels add: 'TeXFileOut'. lines _ superMenu lines copyWith: superMenu labels size. selections _ superMenu selections copyWith: #texFileOutMessageCategories. menu labels: labels lines: lines selections: selections ]! ! !TeXFileOutBrowser methodsFor: 'menues' stamp: 'SqR!!!! 9/8/1999 13:20'! messageListMenu: aMenu shifted: shifted "Append TeXFileOut items" | superMenu labels lines selections menu | ^shifted ifTrue: [super messageListMenu: aMenu shifted: shifted] ifFalse: [ menu _ aMenu isMorph ifTrue: [aMenu copy] ifFalse: [aMenu deepCopy]. superMenu _ super messageListMenu: aMenu shifted: shifted. ^aMenu isMorph ifTrue: [aMenu addLine. aMenu add: 'TeXFileOut' action: #texFileOutClass] ifFalse: [ labels _ superMenu labels copy. labels add: 'TeXFileOut'. lines _ superMenu lines copyWith: superMenu labels size. selections _ superMenu selections copyWith: #texFileOutClass. menu labels: labels lines: lines selections: selections ] ]! ! !TeXFileOutBrowser methodsFor: 'menues' stamp: 'SqR!!!! 9/8/1999 13:16'! systemCategoryMenu: aMenu "Append TeXFileOut items" | superMenu labels lines selections menu | menu _ aMenu isMorph ifTrue: [aMenu copy] ifFalse: [aMenu deepCopy]. superMenu _ super systemCategoryMenu: aMenu. ^aMenu isMorph ifTrue: [aMenu addLine. aMenu add: 'TeXFileOut' action: #texFileOutSystemCategory] ifFalse: [ labels _ superMenu labels copy. labels add: 'TeXFileOut'. lines _ superMenu lines copyWith: superMenu labels size. selections _ superMenu selections copyWith: #texFileOutSystemCategory. menu labels: labels lines: lines selections: selections ]! ! !TeXFileOutBrowser methodsFor: 'menues' stamp: 'SqR!!!! 9/8/1999 12:55'! texFileOutClass "Print a description of the selected class onto a file whose name is the category name followed by .tex. Use TeX format" Cursor write showWhile: [classListIndex ~= 0 ifTrue: [self selectedClass texFileOut]]! ! !TeXFileOutBrowser methodsFor: 'menues' stamp: 'SqR!!!! 9/8/1999 12:56'! texFileOutMessageCategories "Print a description of the selected message category of the selected class onto an external file." Cursor write showWhile: [messageCategoryListIndex ~= 0 ifTrue: [self selectedClassOrMetaClass texFileOutCategory: self selectedMessageCategoryName] ]! ! !TeXFileOutBrowser methodsFor: 'menues' stamp: 'SqR!!!! 9/8/1999 12:54'! texFileOutSystemCategory "Print a description of each class in the selected category onto a file whose name is the category name followed by .tex. Use TeX format" Cursor write showWhile: [ systemCategoryListIndex ~= 0 ifTrue: [systemOrganizer texFileOutCategory: self selectedSystemCategoryName] ]! ! !WriteStream methodsFor: 'character writing'! lf "Append a line feed character to the receiver." self nextPut: Character linefeed! ! TeXFileOut removeSelector: #beginSection! TeXFileOut removeSelector: #closeVBox! TeXFileOut removeSelector: #openVBox! TeXFileOut initialize! "Postscript:" TeXFileOut initialize.!