SystemOrganization addCategory: #'PrettyPetit-Core'! SystemOrganization addCategory: #'PrettyPetit-Tests'! !String methodsFor: '*prettypetit-core-converting' stamp: 'lr 3/11/2010 09:00'! asDocument ^ PPTextDocument string: self! ! RBProgramNodeVisitor subclass: #PPNodeFormatter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PrettyPetit-Tests'! !PPNodeFormatter methodsFor: 'visiting-dispatching' stamp: 'lr 3/13/2010 15:43'! acceptArrayNode: aNode ^ (self formatStatements: aNode) group align encloseInSpaces encloseInBraces! ! !PPNodeFormatter methodsFor: 'visiting-dispatching' stamp: 'lr 3/12/2010 14:42'! acceptAssignmentNode: aNode ^ (self visitNode: aNode variable) + ':=' + (self visitNode: aNode value)! ! !PPNodeFormatter methodsFor: 'visiting-dispatching' stamp: 'lr 3/12/2010 14:43'! acceptBlockNode: aNode | sequence | sequence := PPSequenceDocument new. sequence , (self formatBlockArguments: aNode). sequence , (self visitNode: aNode body). ^ sequence separateVertical group align encloseInSpaces encloseInBrackets! ! !PPNodeFormatter methodsFor: 'visiting-dispatching' stamp: 'lr 3/12/2010 08:29'! acceptCascadeNode: aNode | sequence | sequence := PPSequenceDocument new. sequence , (self visitNode: aNode receiver). sequence , (self formatCascade: aNode). ^ sequence separateVertical nest: 4! ! !PPNodeFormatter methodsFor: 'visiting-dispatching' stamp: 'lr 3/12/2010 11:17'! acceptLiteralArrayNode: aNode | sequence | sequence := (aNode contents collect: [ :each | self visitNode: each ]) asDocument separateFill encloseInSpaces nest: 4. ^ aNode isForByteArray ifTrue: [ sequence encloseIn: '#[' and: ']' ] ifFalse: [ sequence encloseIn: '#(' and: ')' ]! ! !PPNodeFormatter methodsFor: 'visiting-dispatching' stamp: 'lr 3/11/2010 23:19'! acceptLiteralNode: aNode ^ aNode token storeString asDocument ! ! !PPNodeFormatter methodsFor: 'visiting-dispatching' stamp: 'lr 3/11/2010 18:39'! acceptMessageNode: aMessageNode ^ (self visitNode: aMessageNode receiver) / (self formatMessage: aMessageNode) align! ! !PPNodeFormatter methodsFor: 'visiting-dispatching' stamp: 'lr 3/12/2010 13:31'! acceptMethodNode: aNode | sequence | sequence := PPSequenceDocument new. sequence , (self formatMessage: aNode). sequence , (self formatComments: aNode). aNode pragmas do: [ :each | sequence , (self visitNode: each) ]. sequence , (self visitNode: aNode body). ^ sequence separateVertical nest: 4! ! !PPNodeFormatter methodsFor: 'visiting-dispatching' stamp: 'lr 3/11/2010 23:19'! acceptPragmaNode: aNode ^ (self formatMessage: aNode) encloseInAngles! ! !PPNodeFormatter methodsFor: 'visiting-dispatching' stamp: 'lr 3/11/2010 23:19'! acceptReturnNode: aNode ^ '^' asDocument + (self visitNode: aNode value)! ! !PPNodeFormatter methodsFor: 'visiting-dispatching' stamp: 'lr 3/11/2010 23:22'! acceptSequenceNode: aNode | sequence | sequence := PPSequenceDocument new. sequence , (self formatTemporaries: aNode). sequence , (self formatStatements: aNode). ^ sequence separateVertical! ! !PPNodeFormatter methodsFor: 'visiting-dispatching' stamp: 'lr 3/11/2010 23:19'! acceptVariableNode: aNode ^ aNode name asDocument! ! !PPNodeFormatter methodsFor: 'visiting' stamp: 'lr 3/13/2010 15:42'! format: aNode ^ PPPrettyFormatter new ribbon: 30; width: 60; format: (self visitNode: aNode)! ! !PPNodeFormatter methodsFor: 'formatting' stamp: 'lr 3/12/2010 13:49'! formatBlockArguments: aNode | sequence | aNode arguments isEmpty ifTrue: [ ^ PPEmptyDocument new ]. sequence := PPSequenceDocument new. aNode arguments do: [ :each | sequence add: ($: asDocument) , (self visitNode: each) ]. ^ sequence separateHorizontal + $| asDocument! ! !PPNodeFormatter methodsFor: 'formatting' stamp: 'lr 3/12/2010 13:49'! formatCascade: aNode | sequence | sequence := PPSequenceDocument new. aNode messages do: [ :each | sequence add: (self formatMessage: each) , (aNode messages last == each ifFalse: [ $; ]) asDocument ]. ^ sequence separateVertical! ! !PPNodeFormatter methodsFor: 'formatting' stamp: 'lr 3/12/2010 13:32'! formatComments: aNode ^ aNode comments inject: PPEmptyDocument new into: [ :sequence :interval | sequence , (aNode source copyFrom: interval first to: interval last) asDocument ]! ! !PPNodeFormatter methodsFor: 'formatting' stamp: 'lr 3/13/2010 15:45'! formatMessage: aNode | sequence | aNode arguments isEmpty ifTrue: [ ^ aNode selector asDocument ]. sequence := PPSequenceDocument new. 1 to: aNode arguments size do: [ :index | sequence add: (aNode selectorParts at: index) value asDocument + (self visitNode: (aNode arguments at: index)) ]. ^ sequence separateHorizontal! ! !PPNodeFormatter methodsFor: 'formatting' stamp: 'lr 3/12/2010 13:37'! formatStatements: aNode | sequence | sequence := PPSequenceDocument new. aNode statements do: [ :each | sequence add: (self visitNode: each) , (aNode statements last == each ifFalse: [ $. ]) asDocument ]. ^ sequence separateVertical! ! !PPNodeFormatter methodsFor: 'formatting' stamp: 'lr 3/12/2010 13:49'! formatTemporaries: aNode | sequence | aNode temporaries isEmpty ifTrue: [ ^ PPEmptyDocument new ]. sequence := PPSequenceDocument new. aNode temporaries do: [ :each | sequence add: (self visitNode: each) ]. ^ sequence separateFill align encloseInSpaces encloseIn: $| asDocument! ! !PPNodeFormatter methodsFor: 'private' stamp: 'lr 3/12/2010 08:27'! needsParenthesisFor: aNode | parent grandparent | aNode isValue ifFalse: [ ^ false ]. parent := aNode parent ifNil: [ ^ false ]. "(aNode isMessage and: [ parent isMessage and: [ parent receiver == aNode ] ]) ifTrue: [ grandparent := parent parent. (grandparent notNil and: [ grandparent isCascade ]) ifTrue: [ ^ true ] ]." (aNode precedence < parent precedence) ifTrue: [ ^ false ]. (aNode isAssignment and: [ parent isAssignment ]) ifTrue: [ ^ false ]. (aNode isAssignment and: [ aNode isCascade ]) ifTrue: [ ^ true ]. (aNode precedence = 0) ifTrue: [ ^ false ]. (aNode isMessage) ifFalse: [ ^ true ]. (aNode precedence = parent precedence) ifFalse: [ ^ true ]. (aNode isUnary) ifTrue: [ ^ false ]. (aNode isKeyword) ifTrue: [ ^ true ]. (parent receiver == aNode) ifFalse: [ ^ true ]. ^ false! ! !PPNodeFormatter methodsFor: 'visiting' stamp: 'lr 3/11/2010 14:17'! visitNode: aNode | document | document := super visitNode: aNode. (self needsParenthesisFor: aNode) ifTrue: [ document := document encloseInParens ]. ^ document! ! RBProgramNodeVisitor subclass: #PPNodeFormatter2 instanceVariableNames: 'stream' classVariableNames: '' poolDictionaries: '' category: 'PrettyPetit-Tests'! !PPNodeFormatter2 methodsFor: 'visiting-dispatching' stamp: 'lr 4/7/2010 12:30'! acceptArrayNode: aNode stream nextPut: ${; nest: 4 while: [ stream group: [ self formatStatements: aNode. stream softline ] ]; nextPut: $}! ! !PPNodeFormatter2 methodsFor: 'visiting-dispatching' stamp: 'lr 4/7/2010 12:06'! acceptAssignmentNode: aNode self visitNode: aNode variable. stream softline; nextPut: ':='; softline. self visitNode: aNode value! ! !PPNodeFormatter2 methodsFor: 'visiting-dispatching' stamp: 'lr 4/7/2010 12:28'! acceptBlockNode: aNode stream nextPut: $[; nest: 4 while: [ self formatBlockArguments: aNode. self visitNode: aNode body ]; nextPut: $]! ! !PPNodeFormatter2 methodsFor: 'visiting-dispatching' stamp: 'lr 4/7/2010 12:05'! acceptCascadeNode: aNode self visitNode: aNode receiver. stream nest: 4 while: [ stream softline. self formatCascade: aNode ]! ! !PPNodeFormatter2 methodsFor: 'visiting-dispatching' stamp: 'lr 4/7/2010 12:04'! acceptLiteralArrayNode: aNode aNode isForByteArray ifTrue: [ stream nextPutAll: '#[' ] ifFalse: [ stream nextPutAll: '#(' ]. stream nest: 4 while: [ aNode contents do: [ :each | self visitNode: each ] separatedBy: [ stream softline ] ]. aNode isForByteArray ifTrue: [ stream nextPut: $] ] ifFalse: [ stream nextPut: $) ]! ! !PPNodeFormatter2 methodsFor: 'visiting-dispatching' stamp: 'lr 4/7/2010 12:02'! acceptLiteralNode: aNode stream append: aNode token storeString! ! !PPNodeFormatter2 methodsFor: 'visiting-dispatching' stamp: 'lr 4/7/2010 12:00'! acceptMessageNode: aMessageNode self visitNode: aMessageNode receiver. stream softline. self formatMessage: aMessageNode! ! !PPNodeFormatter2 methodsFor: 'visiting-dispatching' stamp: 'lr 4/7/2010 12:10'! acceptMethodNode: aNode self formatMessage: aNode. stream nest: 4 while: [ self formatComments: aNode. self formatPragmas: aNode. self visitNode: aNode body ]! ! !PPNodeFormatter2 methodsFor: 'visiting-dispatching' stamp: 'lr 4/7/2010 12:10'! acceptPragmaNode: aNode stream newline; nextPut: $<. self formatMessage: aNode. stream nextPut: $>! ! !PPNodeFormatter2 methodsFor: 'visiting-dispatching' stamp: 'lr 4/7/2010 12:02'! acceptReturnNode: aNode stream nextPut: $^; softline. self visitNode: aNode value! ! !PPNodeFormatter2 methodsFor: 'visiting-dispatching' stamp: 'lr 4/7/2010 12:04'! acceptSequenceNode: aNode self formatTemporaries: aNode. self formatStatements: aNode! ! !PPNodeFormatter2 methodsFor: 'visiting-dispatching' stamp: 'lr 4/7/2010 12:17'! acceptVariableNode: aNode stream nextPutAll: aNode name! ! !PPNodeFormatter2 methodsFor: 'visiting' stamp: 'lr 4/7/2010 12:26'! format: aNode stream := PPPrettyStream new. self visitNode: aNode. ^ PPPrettyFormatter new ribbon: 30; width: 40; format: stream root! ! !PPNodeFormatter2 methodsFor: 'formatting' stamp: 'lr 4/7/2010 12:29'! formatBlockArguments: aNode | sequence | aNode arguments isEmpty ifTrue: [ ^ self ]. aNode arguments do: [ :each | stream softline; nextPut: $:. self visitNode: each ]. stream space; nextPut: $|! ! !PPNodeFormatter2 methodsFor: 'formatting' stamp: 'lr 4/7/2010 13:28'! formatCascade: aNode aNode messages do: [ :each | stream newline. self formatMessage: each ] separatedBy: [ stream nextPut: $; ]! ! !PPNodeFormatter2 methodsFor: 'formatting' stamp: 'lr 4/7/2010 12:18'! formatComments: aNode aNode comments isEmpty ifTrue: [ ^ self ]. aNode comments do: [ :each | stream newline; nextPutAll: (aNode source copyFrom: each first to: each last) ]. aNode isMethod ifTrue: [ stream newline ]! ! !PPNodeFormatter2 methodsFor: 'formatting' stamp: 'lr 4/7/2010 12:14'! formatMessage: aNode | sequence | aNode arguments isEmpty ifTrue: [ stream nextPutAll: aNode selector ] ifFalse: [ (1 to: aNode arguments size) do: [ :index | stream nextPutAll: (aNode selectorParts at: index) value; space. self visitNode: (aNode arguments at: index) ] separatedBy: [ stream softline ] ]! ! !PPNodeFormatter2 methodsFor: 'formatting' stamp: 'lr 4/7/2010 12:19'! formatPragmas: aNode aNode pragmas do: [ :each | self visitNode: each ]! ! !PPNodeFormatter2 methodsFor: 'formatting' stamp: 'lr 4/7/2010 13:30'! formatStatements: aNode aNode statements do: [ :each | aNode statements first == each ifTrue: [ stream softline ] ifFalse: [ stream newline ]. self visitNode: each ] separatedBy: [ stream nextPut: $. ]! ! !PPNodeFormatter2 methodsFor: 'formatting' stamp: 'lr 4/7/2010 12:32'! formatTemporaries: aNode | sequence | aNode temporaries isEmpty ifTrue: [ ^ self ]. stream softline; nextPut: $|; space. aNode temporaries do: [ :each | self visitNode: each ] separatedBy: [ stream softline ]. stream space; nextPut: $|! ! !PPNodeFormatter2 methodsFor: 'private' stamp: 'lr 4/7/2010 11:54'! needsParenthesisFor: aNode | parent grandparent | aNode isValue ifFalse: [ ^ false ]. parent := aNode parent ifNil: [ ^ false ]. "(aNode isMessage and: [ parent isMessage and: [ parent receiver == aNode ] ]) ifTrue: [ grandparent := parent parent. (grandparent notNil and: [ grandparent isCascade ]) ifTrue: [ ^ true ] ]." (aNode precedence < parent precedence) ifTrue: [ ^ false ]. (aNode isAssignment and: [ parent isAssignment ]) ifTrue: [ ^ false ]. (aNode isAssignment and: [ aNode isCascade ]) ifTrue: [ ^ true ]. (aNode precedence = 0) ifTrue: [ ^ false ]. (aNode isMessage) ifFalse: [ ^ true ]. (aNode precedence = parent precedence) ifFalse: [ ^ true ]. (aNode isUnary) ifTrue: [ ^ false ]. (aNode isKeyword) ifTrue: [ ^ true ]. (parent receiver == aNode) ifFalse: [ ^ true ]. ^ false! ! !PPNodeFormatter2 methodsFor: 'visiting' stamp: 'lr 4/7/2010 11:58'! visitNode: aNode | needsParenthesis | needsParenthesis := self needsParenthesisFor: aNode. needsParenthesis ifTrue: [ stream nextPut: $( ]. super visitNode: aNode. needsParenthesis ifTrue: [ stream nextPut: $) ]! ! !Object methodsFor: '*prettypetit-converting' stamp: 'lr 3/11/2010 14:21'! asDocument ^ PPTextDocument string: self printString! ! Object subclass: #PPDocument instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PrettyPetit-Core'! !PPDocument commentStamp: 'lr 3/11/2010 13:08' prior: 0! An abstract document.! !PPDocument methodsFor: 'operations' stamp: 'lr 3/11/2010 14:18'! + aDocument "Concatenate the receiver and aDocument with a non-breaking space in between." ^ self , ' ' asDocument , aDocument! ! !PPDocument methodsFor: 'operations' stamp: 'lr 3/11/2010 11:57'! , aDocument "Concatenate the receiver and aDocument." ^ PPSequenceDocument with: self with: aDocument! ! !PPDocument methodsFor: 'operations' stamp: 'lr 3/11/2010 09:37'! / aDocument "Concatenate the receiver and aDocument with a softline in between. This effectively puts the receiver and aDocument either next to each other with a aspace inbetween or underneath each other." ^ self , PPLineDocument softline , aDocument! ! !PPDocument methodsFor: 'operations' stamp: 'lr 3/11/2010 09:37'! // aDocument "Concatenate the receiver and aDocument with a softbreak in between. This effectively puts the receiver and aDocument either right next to each other or underneath each other." ^ self , PPLineDocument softbreak , aDocument! ! !PPDocument methodsFor: 'operations' stamp: 'lr 3/11/2010 09:37'! \ aDocument "Concatenate the receiver and aDocument with a line in between." ^ self , PPLineDocument line , aDocument! ! !PPDocument methodsFor: 'operations' stamp: 'lr 3/11/2010 09:37'! \\ aDocument "Concatenate the receiver and aDocument with a linebreak in between." ^ self , PPLineDocument linebreak , aDocument! ! !PPDocument methodsFor: 'private' stamp: 'lr 3/10/2010 22:30'! accept: aVisitor "Inform ther renderer of the kind of the node, so that it can do whatever it wants." self subclassResponsibility! ! !PPDocument methodsFor: 'private' stamp: 'lr 3/11/2010 13:08'! addTo: aSequenceDocument aSequenceDocument add: self! ! !PPDocument methodsFor: 'operations-alignment' stamp: 'lr 4/23/2010 17:42'! align "Align the receiver with the nesting level set to the current column." ^ PPPluggableDocument column: [ :column | PPPluggableDocument nesting: [ :nesting | self nest: column - nesting ] ]! ! !PPDocument methodsFor: 'converting' stamp: 'lr 3/11/2010 10:13'! asDocument ^ self! ! !PPDocument methodsFor: 'operations-enclose' stamp: 'lr 3/11/2010 14:14'! encloseIn: anObject "Enclose the receiving document with anObject at the beginning and end." ^ self encloseIn: anObject and: anObject! ! !PPDocument methodsFor: 'operations-enclose' stamp: 'lr 3/11/2010 22:48'! encloseIn: aLeftObject and: aRightObject "Enclose the receiving document in aLeftObject and aRightObject." ^ PPSequenceDocument new , aLeftObject , self , aRightObject! ! !PPDocument methodsFor: 'operations-enclose' stamp: 'lr 3/11/2010 14:14'! encloseInAngles "Enclose the receiver in angle brackets." ^ self encloseIn: $< and: $>! ! !PPDocument methodsFor: 'operations-enclose' stamp: 'lr 3/11/2010 14:15'! encloseInBraces "Enclose the receiver in curly braces." ^ self encloseIn: ${ and: $}! ! !PPDocument methodsFor: 'operations-enclose' stamp: 'lr 3/11/2010 14:15'! encloseInBrackets "Enclose the receiver in square brackets." ^ self encloseIn: $[ and: $]! ! !PPDocument methodsFor: 'operations-enclose' stamp: 'lr 3/11/2010 14:15'! encloseInParens "Enclose the receiver in parenthesis." ^ self encloseIn: $( and: $)! ! !PPDocument methodsFor: 'operations-enclose' stamp: 'lr 3/11/2010 22:50'! encloseInQuotes "Enclose the receiver in quotes." ^ self encloseIn: $"! ! !PPDocument methodsFor: 'operations-enclose' stamp: 'lr 3/11/2010 22:49'! encloseInSpaces "Enclose the receiver in spaces." ^ self encloseIn: $ ! ! !PPDocument methodsFor: 'operations-fillers' stamp: 'lr 4/23/2010 17:14'! fill: anInteger "Answer the receiver with spaces appended until the width is equal to anInteger." ^ self width: [ :width | width >= anInteger ifTrue: [ PPEmptyDocument new ] ifFalse: [ PPTextDocument spaces: anInteger - width ] ] ! ! !PPDocument methodsFor: 'operations-fillers' stamp: 'lr 3/11/2010 17:07'! fillBreak: anInteger "Answer the receiver with spaces appended until the width is equal to anInteger. If the width of x is already larger than i, the nesting level is increased by i and a line is appended. " ^ self width: [ :width | width > anInteger ifTrue: [ PPLineDocument linebreak nest: anInteger ] ifFalse: [ PPTextDocument spaces: anInteger - width ] ]! ! !PPDocument methodsFor: 'operations' stamp: 'lr 3/10/2010 21:59'! flatten "Answer a flattened representation of the receiver." ^ self! ! !PPDocument methodsFor: 'operations' stamp: 'lr 3/11/2010 09:26'! group "Answer the receiver with all line breaks undone or without changes." ^ PPUnionDocument with: self flatten with: self! ! !PPDocument methodsFor: 'operations-alignment' stamp: 'lr 3/11/2010 17:07'! hang: anInteger "Align the receiver with the nesting level set to the current column plus anInteger." ^ (self nest: anInteger) align! ! !PPDocument methodsFor: 'operations-alignment' stamp: 'lr 3/11/2010 17:08'! indent: anInteger "Indent the receiver with anInteger spaces." ^ ((PPTextDocument spaces: anInteger) , self) hang: anInteger! ! !PPDocument methodsFor: 'operations-alignment' stamp: 'lr 3/11/2010 17:08'! nest: anInteger "Answer a document that displays the receiver with the current nesting level increased by anInteger." ^ anInteger = 0 ifTrue: [ self ] ifFalse: [ PPNestDocument amount: anInteger document: self ]! ! !PPDocument methodsFor: 'printing' stamp: 'lr 3/11/2010 11:08'! printFormatOn: aStream PPPrettyFormatter new stream: aStream; start: self! ! !PPDocument methodsFor: 'printing' stamp: 'lr 3/11/2010 11:08'! printOn: aStream super printOn: aStream. aStream nextPut: $(. self printFormatOn: aStream. aStream nextPut: $)! ! !PPDocument methodsFor: 'operations-fillers' stamp: 'lr 4/23/2010 18:04'! width: aBlock "Append the document returned by aBlock to the receiver. aBlock is evaluated with the width of the formatted receiver." ^ PPPluggableDocument column: [ :first | PPSequenceDocument with: self with: (PPPluggableDocument column: [ :second | aBlock value: second - first ]) ]! ! PPDocument subclass: #PPEmptyDocument instanceVariableNames: '' classVariableNames: 'Default' poolDictionaries: '' category: 'PrettyPetit-Core'! !PPEmptyDocument commentStamp: 'lr 3/11/2010 13:08' prior: 0! An empty document.! !PPEmptyDocument class methodsFor: 'initialization' stamp: 'lr 3/10/2010 22:05'! initialize Default := self basicNew! ! !PPEmptyDocument class methodsFor: 'instance creation' stamp: 'lr 3/10/2010 22:05'! new ^ Default! ! !PPEmptyDocument methodsFor: 'private' stamp: 'lr 3/10/2010 22:30'! accept: aVisitor ^ aVisitor acceptEmptyDocument: self! ! !PPEmptyDocument methodsFor: 'private' stamp: 'lr 3/11/2010 13:09'! addTo: aSequenceDocument "Do not add the empty document to a sequence."! ! !PPEmptyDocument methodsFor: 'operations' stamp: 'lr 3/11/2010 09:17'! group ^ self! ! !PPEmptyDocument methodsFor: 'operations' stamp: 'lr 3/11/2010 17:07'! nest: anInteger ^ self! ! PPDocument subclass: #PPLineDocument instanceVariableNames: 'flattened' classVariableNames: '' poolDictionaries: '' category: 'PrettyPetit-Core'! !PPLineDocument commentStamp: 'lr 3/11/2010 13:14' prior: 0! A new line.! !PPLineDocument class methodsFor: 'instance creation' stamp: 'lr 3/15/2010 09:05'! flattened: aDocument "Answer a newline doucment that becomes aDocument when flattened." ^ self basicNew initializeFlattened: aDocument! ! !PPLineDocument class methodsFor: 'instance creation' stamp: 'lr 3/14/2010 14:11'! line "Answer a document that advances to the next line and indents to the current nesting level. It behaves like an a space if the document is flattened." ^ self flattened: PPTextDocument space! ! !PPLineDocument class methodsFor: 'instance creation' stamp: 'lr 3/14/2010 14:58'! linebreak "Answer a document that advances to the next line and indents to the current nesting level. It disappears if the document is flattened." ^ self flattened: PPEmptyDocument new! ! !PPLineDocument class methodsFor: 'instance creation' stamp: 'lr 3/14/2010 13:50'! new ^ self basicNew initializeFlatten: PPEmptyDocument new! ! !PPLineDocument class methodsFor: 'instance creation' stamp: 'lr 3/11/2010 09:35'! softbreak "Answer a document that is discarded if the resulting output fits the page, otherwise behave like #line." ^ self linebreak group! ! !PPLineDocument class methodsFor: 'instance creation' stamp: 'lr 3/11/2010 09:34'! softline "Answer a document that behaves like a space if the output fits the page, otherwise behaves like #line." ^ self line group! ! !PPLineDocument methodsFor: 'private' stamp: 'lr 3/10/2010 22:30'! accept: aVisitor ^ aVisitor acceptLineDocument: self! ! !PPLineDocument methodsFor: 'actions' stamp: 'lr 3/14/2010 15:47'! flatten ^ flattened! ! !PPLineDocument methodsFor: 'initialization' stamp: 'lr 3/14/2010 15:47'! initializeFlattened: aDocument flattened := aDocument! ! PPDocument subclass: #PPListDocument instanceVariableNames: 'documents' classVariableNames: '' poolDictionaries: '' category: 'PrettyPetit-Core'! !PPListDocument commentStamp: 'lr 3/11/2010 13:11' prior: 0! An abstract list of documents.! !PPListDocument class methodsFor: 'instance creation' stamp: 'lr 3/11/2010 11:59'! new ^ self withAll: OrderedCollection new! ! !PPListDocument class methodsFor: 'instance creation' stamp: 'lr 3/11/2010 17:26'! with: aDocument ^ self withAll: (OrderedCollection with: aDocument)! ! !PPListDocument class methodsFor: 'instance creation' stamp: 'lr 3/11/2010 11:59'! with: aFirstDocument with: aSecondDocument ^ self withAll: (OrderedCollection with: aFirstDocument with: aSecondDocument)! ! !PPListDocument class methodsFor: 'instance creation' stamp: 'lr 3/11/2010 11:59'! withAll: aCollection ^ self basicNew initializeWithAll: aCollection asOrderedCollection! ! !PPListDocument methodsFor: 'accessing' stamp: 'lr 3/10/2010 22:06'! documents ^ documents! ! !PPListDocument methodsFor: 'initialization' stamp: 'lr 3/11/2010 11:59'! initializeWithAll: anOrderedCollection documents := anOrderedCollection! ! PPListDocument subclass: #PPSequenceDocument instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PrettyPetit-Core'! !PPSequenceDocument commentStamp: 'lr 3/11/2010 13:11' prior: 0! A document sequence.! !PPSequenceDocument methodsFor: 'operations' stamp: 'lr 3/11/2010 15:10'! , anObject anObject asDocument addTo: self! ! !PPSequenceDocument methodsFor: 'private' stamp: 'lr 3/11/2010 11:58'! accept: aVisitor ^ aVisitor acceptSequenceDocument: self! ! !PPSequenceDocument methodsFor: 'adding' stamp: 'lr 3/11/2010 12:47'! add: aDocument documents addLast: aDocument! ! !PPSequenceDocument methodsFor: 'adding' stamp: 'lr 3/11/2010 12:47'! addAll: aCollection documents addAll: aCollection! ! !PPSequenceDocument methodsFor: 'operations-concate' stamp: 'lr 3/11/2010 17:58'! concate "Concate the documents of the receiver horizontally if they fit, otherwise separate vertically." ^ self concateVertical group! ! !PPSequenceDocument methodsFor: 'operations-concate' stamp: 'lr 3/11/2010 17:56'! concateFill "Concate the documents of the receiver horizontally as long as they fit the page, then insert a newline." ^ self fold: [ :a :b | a // b ]! ! !PPSequenceDocument methodsFor: 'operations-concate' stamp: 'lr 3/11/2010 17:55'! concateHorizontal "Concate the documents of the receiver horizontally." ^ self! ! !PPSequenceDocument methodsFor: 'operations-concate' stamp: 'lr 3/11/2010 17:57'! concateVertical "Conate the documents of the receiver vertically separated by a newline. If a group undoes the newlines the documents are directly concated." ^ self fold: [ :a :b | a \\ b ]! ! !PPSequenceDocument methodsFor: 'actions' stamp: 'lr 3/11/2010 13:20'! flatten ^ self class new addAll: (self documents collect: [ :each | each flatten ]); yourself! ! !PPSequenceDocument methodsFor: 'operations' stamp: 'lr 3/11/2010 17:24'! fold: aBlock | sequence | documents isEmpty ifTrue: [ ^ PPEmptyDocument new ]. documents size = 1 ifTrue: [ ^ documents first ]. sequence := self class with: documents first. 2 to: documents size do: [ :index | sequence := aBlock value: sequence value: (documents at: index) ]. ^ sequence! ! !PPSequenceDocument methodsFor: 'operations-separate' stamp: 'lr 3/11/2010 17:50'! separate "Separate the documents of the receiver horizontally separated by a space if they fit, otherwise separate vertically." ^ self separateVertical group! ! !PPSequenceDocument methodsFor: 'operations-separate' stamp: 'lr 3/11/2010 17:57'! separateFill "Separate the documents of the receiver horizontally by a space as long as they fit the page, then insert a newline." ^ self fold: [ :a :b | a / b ]! ! !PPSequenceDocument methodsFor: 'operations-separate' stamp: 'lr 3/11/2010 17:49'! separateHorizontal "Separate the documents of the receiver horizontally separated by a space." ^ self fold: [ :a :b | a + b ]! ! !PPSequenceDocument methodsFor: 'operations-separate' stamp: 'lr 3/11/2010 17:49'! separateVertical "Separate the documents of the receiver vertically separated by a newline. If a group undoes the newlines the documents remain separated by spaces." ^ self fold: [ :a :b | a \ b ]! ! PPListDocument subclass: #PPUnionDocument instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PrettyPetit-Core'! !PPUnionDocument commentStamp: 'lr 3/11/2010 13:17' prior: 0! A document union. Do not use this class directly, it has two invariants that need to be fulfilled at all times: (1) all documents are required to flatten to the same layout, and (2) the documents are sorted by increasing length of their first line.! !PPUnionDocument methodsFor: 'private' stamp: 'lr 3/10/2010 22:31'! accept: aVisitor ^ aVisitor acceptUnionDocument: self! ! !PPUnionDocument methodsFor: 'actions' stamp: 'lr 3/11/2010 13:21'! flatten ^ self documents isEmpty ifTrue: [ PPEmptyDocument new ] ifFalse: [ self documents first flatten ]! ! PPDocument subclass: #PPNestDocument instanceVariableNames: 'amount document' classVariableNames: '' poolDictionaries: '' category: 'PrettyPetit-Core'! !PPNestDocument class methodsFor: 'instance creation' stamp: 'lr 3/11/2010 13:13'! amount: anInteger document: aDocument ^ self basicNew initializeAmount: anInteger document: aDocument! ! !PPNestDocument methodsFor: 'private' stamp: 'lr 3/11/2010 17:06'! accept: aVisitor ^ aVisitor acceptNestDocument: self! ! !PPNestDocument methodsFor: 'accessing' stamp: 'lr 3/11/2010 13:13'! amount ^ amount! ! !PPNestDocument methodsFor: 'accessing' stamp: 'lr 3/11/2010 09:46'! document ^ document! ! !PPNestDocument methodsFor: 'initialization' stamp: 'lr 3/11/2010 13:13'! initializeAmount: anInteger document: aDocument amount := anInteger. document := aDocument! ! !PPNestDocument methodsFor: 'operations' stamp: 'lr 3/11/2010 17:07'! nest: anInteger ^ document nest: amount + anInteger! ! PPDocument subclass: #PPPluggableDocument instanceVariableNames: 'block' classVariableNames: '' poolDictionaries: '' category: 'PrettyPetit-Core'! !PPPluggableDocument class methodsFor: 'instance creation' stamp: 'lr 4/24/2010 10:21'! column: aBlock ^ self on: [ :formatter | aBlock value: formatter column ]! ! !PPPluggableDocument class methodsFor: 'instance creation' stamp: 'lr 4/24/2010 10:21'! nesting: aBlock ^ self on: [ :formatter | aBlock value: formatter nesting ]! ! !PPPluggableDocument class methodsFor: 'instance creation' stamp: 'lr 4/24/2010 10:20'! on: aBlock ^ self basicNew initializeOn: aBlock! ! !PPPluggableDocument methodsFor: 'private' stamp: 'lr 4/24/2010 10:21'! accept: aVisitor ^ aVisitor acceptPluggableDocument: self! ! !PPPluggableDocument methodsFor: 'accessing' stamp: 'lr 3/11/2010 09:46'! block ^ block! ! !PPPluggableDocument methodsFor: 'actions' stamp: 'lr 4/24/2010 10:22'! flatten ^ self class on: [ :formatter | (block value: formatter) flatten ]! ! !PPPluggableDocument methodsFor: 'initialization' stamp: 'lr 4/24/2010 10:21'! initializeOn: aBlock block := aBlock! ! PPDocument subclass: #PPTextDocument instanceVariableNames: 'string' classVariableNames: '' poolDictionaries: '' category: 'PrettyPetit-Core'! PPTextDocument class instanceVariableNames: 'spaces'! PPTextDocument class instanceVariableNames: 'spaces'! !PPTextDocument class methodsFor: 'initialization' stamp: 'lr 3/14/2010 13:58'! initialize spaces := Array new: 25. 1 to: spaces size do: [ :index | spaces at: index put: (self string: (String new: index - 1 withAll: Character space)) ]! ! !PPTextDocument class methodsFor: 'instance creation' stamp: 'lr 3/14/2010 14:33'! new self error: 'Instances can only be created using the dedicated constructors.'! ! !PPTextDocument class methodsFor: 'instance creation' stamp: 'lr 3/14/2010 14:10'! space "Answer a text document with a single space." ^ self spaces: 1! ! !PPTextDocument class methodsFor: 'instance creation' stamp: 'lr 3/14/2010 14:02'! spaces: anInteger "Answer a text document with anInteger spaces." ^ anInteger < spaces size ifTrue: [ spaces at: anInteger + 1 ] ifFalse: [ self string: (String new: anInteger withAll: Character space) ]! ! !PPTextDocument class methodsFor: 'instance creation' stamp: 'lr 3/14/2010 14:02'! string: aString "Answer a text document with aString." ^ self basicNew initializeString: aString! ! !PPTextDocument methodsFor: 'private' stamp: 'lr 3/10/2010 22:31'! accept: aVisitor ^ aVisitor acceptTextDocument: self! ! !PPTextDocument methodsFor: 'initialization' stamp: 'lr 3/10/2010 22:09'! initializeString: aString string := aString! ! !PPTextDocument methodsFor: 'operations' stamp: 'lr 3/11/2010 17:07'! nest: anInteger ^ self! ! !PPTextDocument methodsFor: 'accessing' stamp: 'lr 3/11/2010 09:46'! size ^ string size! ! !PPTextDocument methodsFor: 'accessing' stamp: 'lr 3/11/2010 09:05'! string ^ string! ! Object subclass: #PPFormatter instanceVariableNames: 'stream column' classVariableNames: '' poolDictionaries: '' category: 'PrettyPetit-Core'! PPFormatter subclass: #PPCompactFormatter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PrettyPetit-Core'! !PPCompactFormatter commentStamp: 'lr 3/11/2010 13:18' prior: 0! Format a document without unnecessary indentation. As there is no sophisticated pretty printing involved here the formatting is very fast. The resulting output contains fewer characters and is intended for machine reading only.! !PPCompactFormatter methodsFor: 'visiting-dispatching' stamp: 'lr 4/24/2010 10:24'! acceptLineDocument: aDocument column := 0. stream cr! ! !PPCompactFormatter methodsFor: 'visiting-dispatching' stamp: 'lr 3/11/2010 17:06'! acceptNestDocument: aDocument self visit: aDocument document! ! !PPCompactFormatter methodsFor: 'visiting-dispatching' stamp: 'lr 3/11/2010 08:26'! acceptUnionDocument: aDocument self visit: aDocument documents last! ! !PPCompactFormatter methodsFor: 'accessing-querying' stamp: 'lr 4/24/2010 10:25'! nesting ^ 0! ! !PPFormatter methodsFor: 'visiting-dispatching' stamp: 'lr 3/11/2010 08:16'! acceptEmptyDocument: aDocument! ! !PPFormatter methodsFor: 'visiting-dispatching' stamp: 'lr 3/11/2010 19:48'! acceptLineDocument: aDocument self subclassResponsibility! ! !PPFormatter methodsFor: 'visiting-dispatching' stamp: 'lr 3/11/2010 19:48'! acceptNestDocument: aDocument self subclassResponsibility! ! !PPFormatter methodsFor: 'visiting-dispatching' stamp: 'lr 4/24/2010 10:22'! acceptPluggableDocument: aDocument self visit: (aDocument block value: self)! ! !PPFormatter methodsFor: 'visiting-dispatching' stamp: 'lr 4/24/2010 10:30'! acceptSequenceDocument: aDocument self visitAll: aDocument documents! ! !PPFormatter methodsFor: 'visiting-dispatching' stamp: 'lr 4/24/2010 10:28'! acceptTextDocument: aDocument column := column + aDocument size. stream nextPutAll: aDocument string! ! !PPFormatter methodsFor: 'visiting-dispatching' stamp: 'lr 3/11/2010 19:48'! acceptUnionDocument: aDocument self subclassResponsibility! ! !PPFormatter methodsFor: 'accessing-querying' stamp: 'lr 4/24/2010 10:25'! column "Answer the current column of the reciever." ^ column! ! !PPFormatter methodsFor: 'visiting' stamp: 'lr 3/11/2010 16:49'! format: aDocument self start: aDocument. ^ stream contents! ! !PPFormatter methodsFor: 'initialization' stamp: 'lr 3/11/2010 10:30'! initialize stream := WriteStream on: (String new: 60)! ! !PPFormatter methodsFor: 'accessing-querying' stamp: 'lr 4/24/2010 10:25'! nesting "Answer the current nesting of the receiver." self subclassResponsibility! ! !PPFormatter methodsFor: 'copying' stamp: 'lr 4/24/2010 10:29'! postCopy super postCopy. stream := WriteStream on: (String new: 60)! ! !PPFormatter methodsFor: 'visiting' stamp: 'lr 4/24/2010 10:29'! start: aDocument column := 0. self visit: aDocument! ! !PPFormatter methodsFor: 'accessing' stamp: 'lr 3/11/2010 09:03'! stream ^ stream! ! !PPFormatter methodsFor: 'accessing' stamp: 'lr 3/11/2010 09:03'! stream: aStream stream := aStream! ! !PPFormatter methodsFor: 'visiting' stamp: 'lr 3/11/2010 08:58'! visit: aDocument aDocument accept: self! ! !PPFormatter methodsFor: 'visiting' stamp: 'lr 3/11/2010 08:25'! visitAll: aCollection aCollection do: [ :each | self visit: each ]! ! PPFormatter subclass: #PPPrettyFormatter instanceVariableNames: 'ribbon width nesting' classVariableNames: '' poolDictionaries: '' category: 'PrettyPetit-Core'! !PPPrettyFormatter methodsFor: 'visiting-dispatching' stamp: 'lr 4/24/2010 10:26'! acceptLineDocument: aDocument stream cr; nextPutAll: (String new: (column := nesting) withAll: $ )! ! !PPPrettyFormatter methodsFor: 'visiting-dispatching' stamp: 'lr 4/24/2010 10:26'! acceptNestDocument: aDocument nesting := nesting + aDocument amount. self visit: aDocument document. nesting := nesting - aDocument amount! ! !PPPrettyFormatter methodsFor: 'visiting-dispatching' stamp: 'lr 4/24/2010 10:26'! acceptUnionDocument: aDocument | available document | available := (width - column) min: (ribbon - column + nesting). 1 to: aDocument documents size - 1 do: [ :index | document := aDocument documents at: index. (self fits: document width: available) ifTrue: [ ^ self visit: document ] ]. self visit: aDocument documents last! ! !PPPrettyFormatter methodsFor: 'private' stamp: 'lr 3/15/2010 10:20'! fits: aDocument width: anInteger "Check if aDocument fits into the width anInteger." | string previous current | string := self copy format: aDocument. previous := 1. [ current := string indexOf: Character cr startingAt: previous ifAbsent: [ string size + 1 ]. current - previous <= anInteger ifFalse: [ ^ false ]. previous := current + 1. previous <= string size ] whileTrue. ^ true! ! !PPPrettyFormatter methodsFor: 'initialization' stamp: 'lr 3/11/2010 15:11'! initialize super initialize. ribbon := 80. width := 120! ! !PPPrettyFormatter methodsFor: 'accessing-querying' stamp: 'lr 4/24/2010 10:26'! nesting ^ nesting! ! !PPPrettyFormatter methodsFor: 'accessing' stamp: 'lr 3/11/2010 10:27'! ribbon: anInteger "The width of the ribbon, that is the maximal amount of non-indentation characters on a line." ribbon := anInteger! ! !PPPrettyFormatter methodsFor: 'visiting' stamp: 'lr 4/24/2010 10:29'! start: aDocument nesting := 0. super start: aDocument! ! !PPPrettyFormatter methodsFor: 'accessing' stamp: 'lr 3/11/2010 10:26'! width: anInteger "The width of the output page." width := anInteger! ! Object subclass: #PPPrettyStream instanceVariableNames: 'root sequence' classVariableNames: '' poolDictionaries: '' category: 'PrettyPetit-Core'! !PPPrettyStream methodsFor: 'alignment' stamp: 'lr 4/7/2010 11:53'! align: aBlock "Align the contents of aBlock with the nesting level set to the current column." ^ self with: aBlock wrapped: [ :doc | doc align ]! ! !PPPrettyStream methodsFor: 'accessing' stamp: 'lr 4/7/2010 11:56'! append: anObject "Add anObject to the current sequence." sequence add: anObject asDocument! ! !PPPrettyStream methodsFor: 'alignment' stamp: 'lr 4/7/2010 12:22'! group: aBlock "Group the contents of aBlock with all linebreaks undone." ^ self with: aBlock wrapped: [ :doc | doc group ]! ! !PPPrettyStream methodsFor: 'alignment' stamp: 'lr 4/7/2010 11:53'! hang: anInteger while: aBlock "Align the contens of aBlock with the nesting level set to the current column plus anInteger." ^ self with: aBlock wrapped: [ :doc | doc hang: anInteger ]! ! !PPPrettyStream methodsFor: 'alignment' stamp: 'lr 4/7/2010 11:50'! indent: anInteger while: aBlock "Indent the contents of aBlock with anInteger spaces." ^ self with: aBlock wrapped: [ :doc | doc indent: anInteger ]! ! !PPPrettyStream methodsFor: 'initialization' stamp: 'lr 3/15/2010 08:59'! initialize root := sequence := self newSequence! ! !PPPrettyStream methodsFor: 'alignment' stamp: 'lr 4/7/2010 11:51'! nest: anInteger while: aBlock "Increase the nesting level by anInteger for the contents of aBlock." ^ self with: aBlock wrapped: [ :doc | doc nest: anInteger ]! ! !PPPrettyStream methodsFor: 'private' stamp: 'lr 3/15/2010 08:59'! newSequence ^ PPSequenceDocument new! ! !PPPrettyStream methodsFor: 'streaming-linebreaks' stamp: 'lr 3/14/2010 15:55'! newline "Append a newline to the receiver, or a space if the document is flattened." self newline: PPTextDocument space! ! !PPPrettyStream methodsFor: 'streaming-linebreaks' stamp: 'lr 3/15/2010 08:53'! newline: anObject "Append a newline to the receiver, or anObject if the document is flattened." self append: (PPLineDocument flattened: anObject asDocument) ! ! !PPPrettyStream methodsFor: 'streaming' stamp: 'lr 3/14/2010 15:58'! nextPut: aCharacter "Append aCharacter to the receiver." self append: aCharacter! ! !PPPrettyStream methodsFor: 'streaming' stamp: 'lr 3/14/2010 15:57'! nextPutAll: aString "Append aString to the receiver." self append: aString! ! !PPPrettyStream methodsFor: 'printing' stamp: 'lr 3/15/2010 09:01'! printOn: aStream super printOn: aStream. aStream nextPut: $(. root printFormatOn: aStream. aStream nextPut: $)! ! !PPPrettyStream methodsFor: 'accessing' stamp: 'lr 4/7/2010 11:56'! root "Answer the root of the document tree." ^ root! ! !PPPrettyStream methodsFor: 'accessing' stamp: 'lr 4/7/2010 11:56'! sequence "Answer the current sequence." ^ sequence! ! !PPPrettyStream methodsFor: 'streaming-linebreaks' stamp: 'lr 3/15/2010 08:51'! softline "Append a space if the output fits the page, otherwise insert a newline." self softline: PPTextDocument space! ! !PPPrettyStream methodsFor: 'streaming-linebreaks' stamp: 'lr 3/15/2010 08:52'! softline: anObject "Append anObject if the output fits the page, otherwise insert a newline." self append: (PPLineDocument flattened: anObject asDocument) group! ! !PPPrettyStream methodsFor: 'streaming' stamp: 'lr 3/14/2010 15:57'! space "Append a non-breaking space to the receiver." self append: PPTextDocument space ! ! !PPPrettyStream methodsFor: 'grouping' stamp: 'lr 4/7/2010 11:52'! with: aBlock "Group the contents of aBlock in a new sequence." ^ self with: aBlock wrapped: [ :sequence | sequence ]! ! !PPPrettyStream methodsFor: 'grouping' stamp: 'lr 4/7/2010 11:53'! with: aBlock wrapped: aWrapBlock "Group the contents of aBlock in a new sequence and modify it using aWrapBlock." | parent result | parent := sequence. sequence := self newSequence. result := aBlock value. parent add: (aWrapBlock value: sequence). sequence := parent. ^ result! ! !UndefinedObject methodsFor: '*prettypetit-converting' stamp: 'lr 3/11/2010 15:33'! asDocument ^ PPEmptyDocument new! ! !Collection methodsFor: '*prettypetit' stamp: 'lr 3/11/2010 17:40'! asDocument ^ PPSequenceDocument withAll: (self collect: [ :each | each asDocument ])! ! !Character methodsFor: '*prettypetit-core-converting' stamp: 'lr 3/11/2010 10:17'! asDocument ^ (String with: self) asDocument! ! TestCase subclass: #PPFormatterTests instanceVariableNames: 'document formatter' classVariableNames: '' poolDictionaries: '' category: 'PrettyPetit-Tests'! PPFormatterTests subclass: #PPCompactFormatterTests instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PrettyPetit-Tests'! !PPCompactFormatterTests methodsFor: 'accessing' stamp: 'lr 3/11/2010 14:36'! formatterClass ^ PPCompactFormatter! ! !PPCompactFormatterTests methodsFor: 'testing' stamp: 'lr 3/11/2010 20:06'! testAlign super testAlign. self assert: document format: 'hi nice\\world'! ! !PPCompactFormatterTests methodsFor: 'testing-concate' stamp: 'lr 3/11/2010 19:44'! testConcate super testConcate. self assert: document format: '10\\200\\3000\\40000'! ! !PPCompactFormatterTests methodsFor: 'testing-concate' stamp: 'lr 3/11/2010 19:44'! testConcateFill super testConcateFill. self assert: document format: '10\\200\\3000\\40000'! ! !PPCompactFormatterTests methodsFor: 'testing-concate' stamp: 'lr 3/11/2010 19:44'! testConcateHorizontal super testConcateHorizontal. self assert: document format: '10200300040000'! ! !PPCompactFormatterTests methodsFor: 'testing-concate' stamp: 'lr 3/11/2010 19:44'! testConcateVertical super testConcateVertical. self assert: document format: '10\\200\\3000\\40000'! ! !PPCompactFormatterTests methodsFor: 'testing-fillers' stamp: 'lr 4/23/2010 17:17'! testFill super testFill. self assert: document format: 'let empty :: Doc\\nest :: Int -> Doc -> Doc\\linebreak :: Doc'! ! !PPCompactFormatterTests methodsFor: 'testing-fillers' stamp: 'lr 4/23/2010 17:18'! testFillBreak super testFillBreak. self assert: document format: 'let empty :: Doc\\nest :: Int -> Doc -> Doc\\linebreak\\ :: Doc'! ! !PPCompactFormatterTests methodsFor: 'testing' stamp: 'lr 3/11/2010 20:07'! testHang super testHang. self assert: document format: 'the\\hang\\combinator\\indents\\these\\words\\!!'! ! !PPCompactFormatterTests methodsFor: 'testing' stamp: 'lr 3/11/2010 20:08'! testNest super testNest. self assert: document format: ' the\\nest\\combinator\\indents\\these\\words\\!!'! ! !PPCompactFormatterTests methodsFor: 'testing-separate' stamp: 'lr 3/11/2010 19:45'! testSeparate super testSeparate. self assert: document format: '10\\200\\3000\\40000'! ! !PPCompactFormatterTests methodsFor: 'testing-separate' stamp: 'lr 3/11/2010 19:45'! testSeparateFill super testSeparateFill. self assert: document format: '10\\200\\3000\\40000'! ! !PPCompactFormatterTests methodsFor: 'testing-separate' stamp: 'lr 3/11/2010 19:45'! testSeparateHorizontal super testSeparateHorizontal. self assert: document format: '10 200 3000 40000'! ! !PPCompactFormatterTests methodsFor: 'testing-separate' stamp: 'lr 3/11/2010 19:45'! testSeparateVertical super testSeparateVertical. self assert: document format: '10\\200\\3000\\40000'! ! !PPCompactFormatterTests methodsFor: 'testing-fillers' stamp: 'lr 4/23/2010 16:30'! testWidth super testWidth. self assert: document format: 'a1\\ab2\\abc3\\abcd4\\abcde5'! ! !PPFormatterTests class methodsFor: 'testing' stamp: 'lr 3/11/2010 14:36'! isAbstract ^ self name = #PPFormatterTests! ! !PPFormatterTests class methodsFor: 'testing' stamp: 'lr 3/11/2010 18:14'! shouldInheritSelectors ^ true! ! !PPFormatterTests methodsFor: 'utilities' stamp: 'lr 3/11/2010 16:50'! assert: aDocument format: aString | expected formatted | expected := aString copyReplaceAll: '\\' with: (String with: Character cr). formatted := formatter stream: String new writeStream; format: aDocument. self assert: expected = formatted description: 'Expected ' , aString printString , ', but got ' , (formatted copyReplaceAll: (String with: Character cr) with: '\\') printString ! ! !PPFormatterTests methodsFor: 'utilities' stamp: 'lr 3/11/2010 16:12'! format: aDocument ^ formatter format: aDocument! ! !PPFormatterTests methodsFor: 'accessing' stamp: 'lr 3/11/2010 16:19'! formatter ^ formatter! ! !PPFormatterTests methodsFor: 'accessing' stamp: 'lr 3/11/2010 14:36'! formatterClass ^ PPFormatter! ! !PPFormatterTests methodsFor: 'running' stamp: 'lr 3/11/2010 16:13'! setUp super setUp. formatter := self formatterClass new! ! !PPFormatterTests methodsFor: 'testing' stamp: 'lr 3/11/2010 16:06'! testAlign document := 'hi' asDocument + ('nice' asDocument \ 'world' asDocument) align! ! !PPFormatterTests methodsFor: 'testing-concate' stamp: 'lr 3/11/2010 19:34'! testConcate document := #(10 200 3000 40000) asDocument concate! ! !PPFormatterTests methodsFor: 'testing-concate' stamp: 'lr 3/11/2010 19:34'! testConcateFill document := #(10 200 3000 40000) asDocument concateFill! ! !PPFormatterTests methodsFor: 'testing-concate' stamp: 'lr 3/11/2010 19:35'! testConcateHorizontal document := #(10 200 3000 40000) asDocument concateHorizontal! ! !PPFormatterTests methodsFor: 'testing-concate' stamp: 'lr 3/11/2010 19:36'! testConcateVertical document := #(10 200 3000 40000) asDocument concateVertical! ! !PPFormatterTests methodsFor: 'testing-enclose' stamp: 'lr 3/11/2010 18:13'! testEncloseIn document := 'foo' asDocument encloseIn: $x. self assert: document format: 'xfoox'! ! !PPFormatterTests methodsFor: 'testing-enclose' stamp: 'lr 3/11/2010 18:13'! testEncloseInAnd document := 'foo' asDocument encloseIn: $x and: $y. self assert: document format: 'xfooy'! ! !PPFormatterTests methodsFor: 'testing-enclose' stamp: 'lr 3/11/2010 18:13'! testEncloseInAngles document := 'foo' asDocument encloseInAngles. self assert: document format: ''! ! !PPFormatterTests methodsFor: 'testing-enclose' stamp: 'lr 3/11/2010 18:14'! testEncloseInBraces document := 'foo' asDocument encloseInBraces. self assert: document format: '{foo}'! ! !PPFormatterTests methodsFor: 'testing-enclose' stamp: 'lr 3/11/2010 18:14'! testEncloseInBrackets document := 'foo' asDocument encloseInBrackets. self assert: document format: '[foo]'! ! !PPFormatterTests methodsFor: 'testing-enclose' stamp: 'lr 3/11/2010 18:14'! testEncloseInParens document := 'foo' asDocument encloseInParens. self assert: document format: '(foo)'! ! !PPFormatterTests methodsFor: 'testing-enclose' stamp: 'lr 3/11/2010 22:52'! testEncloseInSpaces document := 'foo' asDocument encloseInSpaces. self assert: document format: ' foo '! ! !PPFormatterTests methodsFor: 'testing-fillers' stamp: 'lr 4/23/2010 17:16'! testFill | items | items := #(('empty' 'Doc') ('nest' 'Int -> Doc -> Doc') ('linebreak' 'Doc')) collect: [ :each | (each first asDocument fill: 6) + '::' + each second asDocument ]. document := 'let' asDocument + items asDocument concateVertical align! ! !PPFormatterTests methodsFor: 'testing-fillers' stamp: 'lr 4/23/2010 17:16'! testFillBreak | items | items := #(('empty' 'Doc') ('nest' 'Int -> Doc -> Doc') ('linebreak' 'Doc')) collect: [ :each | (each first asDocument fillBreak: 6) + '::' + each second asDocument ]. document := 'let' asDocument + items asDocument concateVertical align! ! !PPFormatterTests methodsFor: 'testing' stamp: 'lr 3/11/2010 16:23'! testHang document := ('the' asDocument / 'hang' asDocument / 'combinator' asDocument / 'indents' asDocument / 'these' asDocument / 'words' asDocument / '!!' asDocument) hang: 4! ! !PPFormatterTests methodsFor: 'testing' stamp: 'lr 3/11/2010 17:08'! testNest document := ('the' asDocument / 'nest' asDocument / 'combinator' asDocument / 'indents' asDocument / 'these' asDocument / 'words' asDocument / '!!' asDocument) indent: 4! ! !PPFormatterTests methodsFor: 'testing-separate' stamp: 'lr 3/11/2010 19:37'! testSeparate document := #(10 200 3000 40000) asDocument separate! ! !PPFormatterTests methodsFor: 'testing-separate' stamp: 'lr 3/11/2010 19:37'! testSeparateFill document := #(10 200 3000 40000) asDocument separateFill! ! !PPFormatterTests methodsFor: 'testing-separate' stamp: 'lr 3/11/2010 19:37'! testSeparateHorizontal document := #(10 200 3000 40000) asDocument separateHorizontal! ! !PPFormatterTests methodsFor: 'testing-separate' stamp: 'lr 3/11/2010 19:37'! testSeparateVertical document := #(10 200 3000 40000) asDocument separateVertical! ! !PPFormatterTests methodsFor: 'testing-fillers' stamp: 'lr 4/23/2010 16:29'! testWidth document := (#('a' 'ab' 'abc' 'abcd' 'abcde') collect: [ :each | each asDocument width: [ :width | width asString asDocument ] ]) asDocument concateVertical! ! PPFormatterTests subclass: #PPPrettyFormatterTests instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PrettyPetit-Tests'! !PPPrettyFormatterTests methodsFor: 'accessing' stamp: 'lr 3/11/2010 14:36'! formatterClass ^ PPPrettyFormatter! ! !PPPrettyFormatterTests methodsFor: 'testing' stamp: 'lr 3/11/2010 16:15'! testAlign super testAlign. self assert: document format: 'hi nice\\ world'! ! !PPPrettyFormatterTests methodsFor: 'testing-concate' stamp: 'lr 3/11/2010 19:34'! testConcate super testConcate. self assert: document format: '10200300040000'. formatter ribbon: 6; width: 15. self assert: document format: '10\\200\\3000\\40000'! ! !PPPrettyFormatterTests methodsFor: 'testing-concate' stamp: 'lr 3/11/2010 19:35'! testConcateFill super testConcateFill. self assert: document format: '10200300040000'. formatter ribbon: 4; width: 10. self assert: document format: '10200\\300040000'! ! !PPPrettyFormatterTests methodsFor: 'testing-concate' stamp: 'lr 3/11/2010 19:35'! testConcateHorizontal super testConcateHorizontal. self assert: document format: '10200300040000'. formatter ribbon: 4; width: 10. self assert: document format: '10200300040000'! ! !PPPrettyFormatterTests methodsFor: 'testing-concate' stamp: 'lr 3/11/2010 19:35'! testConcateVertical super testConcateVertical. self assert: document format: '10\\200\\3000\\40000'. formatter ribbon: 6; width: 15. self assert: document format: '10\\200\\3000\\40000'! ! !PPPrettyFormatterTests methodsFor: 'testing-fillers' stamp: 'lr 3/11/2010 19:36'! testFill super testFill. self assert: document format: 'let empty :: Doc\\ nest :: Int -> Doc -> Doc\\ linebreak :: Doc'! ! !PPPrettyFormatterTests methodsFor: 'testing-fillers' stamp: 'lr 3/11/2010 19:36'! testFillBreak super testFillBreak. self assert: document format: 'let empty :: Doc\\ nest :: Int -> Doc -> Doc\\ linebreak\\ :: Doc'! ! !PPPrettyFormatterTests methodsFor: 'testing' stamp: 'lr 3/11/2010 16:28'! testHang super testHang. self formatter ribbon: 8; width: 20. self assert: document format: 'the hang combinator\\ indents these\\ words !!'! ! !PPPrettyFormatterTests methodsFor: 'testing' stamp: 'lr 3/11/2010 16:28'! testNest super testNest. self formatter ribbon: 8; width: 20. self assert: document format: ' the nest\\ combinator\\ indents these\\ words !!'! ! !PPPrettyFormatterTests methodsFor: 'testing-separate' stamp: 'lr 3/11/2010 19:37'! testSeparate super testSeparate. self assert: document format: '10 200 3000 40000'. formatter ribbon: 6; width: 15. self assert: document format: '10\\200\\3000\\40000'! ! !PPPrettyFormatterTests methodsFor: 'testing-separate' stamp: 'lr 3/11/2010 19:37'! testSeparateFill super testSeparateFill. self assert: document format: '10 200 3000 40000'. formatter ribbon: 6; width: 15. self assert: document format: '10 200\\3000 40000'! ! !PPPrettyFormatterTests methodsFor: 'testing-separate' stamp: 'lr 3/11/2010 19:37'! testSeparateHorizontal super testSeparateHorizontal. self assert: document format: '10 200 3000 40000'. formatter ribbon: 4; width: 10. self assert: document format: '10 200 3000 40000'! ! !PPPrettyFormatterTests methodsFor: 'testing-separate' stamp: 'lr 3/11/2010 19:37'! testSeparateVertical super testSeparateVertical. self assert: document format: '10\\200\\3000\\40000'. formatter ribbon: 6; width: 15. self assert: document format: '10\\200\\3000\\40000'! ! !PPPrettyFormatterTests methodsFor: 'testing-fillers' stamp: 'lr 4/23/2010 16:29'! testWidth super testWidth. self assert: document format: 'a1\\ab2\\abc3\\abcd4\\abcde5'! ! TestCase subclass: #PPPrettyTests instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PrettyPetit-Tests'! !PPPrettyTests class methodsFor: 'accessing' stamp: 'lr 3/11/2010 19:46'! packageNamesUnderTest ^ #('PrettyPetit')! ! !PPPrettyTests methodsFor: 'testing-text' stamp: 'lr 3/11/2010 14:37'! testCharacterText | document | document := $a asDocument. self assert: document string = 'a'. self assert: document size = 1! ! !PPPrettyTests methodsFor: 'testing-sequence' stamp: 'lr 3/11/2010 15:10'! testCommaSequence | document | document := PPSequenceDocument new. document , '1' asDocument. self assert: document documents size = 1. self assert: document documents last string = '1'. document , '2'. self assert: document documents size = 2. self assert: document documents last string = '2'! ! !PPPrettyTests methodsFor: 'testing-sequence' stamp: 'lr 3/11/2010 15:08'! testEmtpySequence | document | document := PPSequenceDocument new. self assert: document documents isEmpty! ! !PPPrettyTests methodsFor: 'testing-text' stamp: 'lr 3/11/2010 14:37'! testIntegerText | document | document := 12 asDocument. self assert: document string = '12'. self assert: document size = 2! ! !PPPrettyTests methodsFor: 'testing-text' stamp: 'lr 3/11/2010 14:37'! testStringText | document | document := 'abc' asDocument. self assert: document string = 'abc'. self assert: document size = 3! ! PPEmptyDocument initialize! PPTextDocument initialize!