Imported more files
This commit is contained in:
Nicolas Petton
parent
632562b358
commit
3d0d90bfcf
|
|
@ -0,0 +1,107 @@
|
|||
GRObject subclass: GRCodec [
|
||||
|
||||
<comment: 'A codec defines how Seaside communicates without the outside world and how outside data is converted into the image (decoding) and back outside the image (encoding). The codec is essentially a stream factory that provides wrappers around standard streams. All streams do support binary mode for non-converted transfer.'>
|
||||
<category: 'Grease-Core-Text'>
|
||||
|
||||
GRCodec class >> allCodecs [
|
||||
"Answer all codecs supported in this system. This is a collection of codec instances."
|
||||
|
||||
<category: 'accessing'>
|
||||
^self subclasses inject: self codecs asArray
|
||||
into: [:result :each | result , each allCodecs]
|
||||
]
|
||||
|
||||
GRCodec class >> codecs [
|
||||
"Answer a collection of possible codecs of the receiver. To be overridden by concrete subclasses."
|
||||
|
||||
<category: 'accessing'>
|
||||
^#()
|
||||
]
|
||||
|
||||
GRCodec class >> forEncoding: aString [
|
||||
"Answer a new codec instance for the given encoding name. Raise an WAUnsupportedEncodingError if the encoding name is not supported by this image."
|
||||
|
||||
<category: 'instance creation'>
|
||||
self allSubclassesDo: [:each |
|
||||
(each supportsEncoding: aString) ifTrue: [
|
||||
^each basicForEncoding: aString]].
|
||||
self unsupportedEncoding: aString
|
||||
]
|
||||
|
||||
GRCodec class >> supportsEncoding: aString [
|
||||
"Answer whether the the given encoding name is supported by this codec class."
|
||||
|
||||
<category: 'testing'>
|
||||
self subclassResponsibility
|
||||
]
|
||||
|
||||
GRCodec class >> basicForEncoding: aString [
|
||||
"Create the actual instance."
|
||||
|
||||
<category: 'private'>
|
||||
self subclassResponsibility
|
||||
]
|
||||
|
||||
GRCodec class >> unsupportedEncoding: aString [
|
||||
"Signal an unsupported encoding."
|
||||
|
||||
<category: 'private'>
|
||||
GRUnsupportedEncodingError signal: 'unsupported encoding: ' , aString
|
||||
]
|
||||
|
||||
name [
|
||||
"Answer a human readable string of the receivers encoding policy."
|
||||
|
||||
<category: 'accessing'>
|
||||
self subclassResponsibility
|
||||
]
|
||||
|
||||
url [
|
||||
"Answer a codec that is responsible to encode and decode URLs. In most cases an UTF-8 codec is the only valid choice, but subclasses might decide to do something else."
|
||||
|
||||
<category: 'accessing'>
|
||||
self subclassResponsibility
|
||||
]
|
||||
|
||||
decode: aString [
|
||||
<category: 'convenience'>
|
||||
| readStream writeStream |
|
||||
readStream := self decoderFor: aString readStream.
|
||||
writeStream := WriteStream on: (String new: aString size).
|
||||
[readStream atEnd]
|
||||
whileFalse: [writeStream nextPutAll: (readStream next: 1024)].
|
||||
^writeStream contents
|
||||
]
|
||||
|
||||
encode: aString [
|
||||
<category: 'convenience'>
|
||||
| writeStream |
|
||||
writeStream := self encoderFor:
|
||||
(WriteStream on: (String new: aString size)).
|
||||
writeStream nextPutAll: aString.
|
||||
^writeStream contents
|
||||
]
|
||||
|
||||
decoderFor: aReadStream [
|
||||
"Wrap aReadStream with an decoder for the codec of the receiver. Answer a read stream that delegates to and shares the state of aReadStream."
|
||||
|
||||
<category: 'conversion'>
|
||||
self subclassResponsibility
|
||||
]
|
||||
|
||||
encoderFor: aWriteStream [
|
||||
"Wrap aWriteStream with an encoder for the codec of the receiver. Answer a write stream that delegates to and shares the state of aWriteStream."
|
||||
|
||||
<category: 'conversion'>
|
||||
self subclassResponsibility
|
||||
]
|
||||
|
||||
printOn: aStream [
|
||||
<category: 'printing'>
|
||||
super printOn: aStream.
|
||||
aStream
|
||||
nextPutAll: ' name: ';
|
||||
print: self name
|
||||
]
|
||||
]
|
||||
|
||||
|
|
@ -0,0 +1,91 @@
|
|||
GRObject subclass: GRCodecStream [
|
||||
| stream |
|
||||
|
||||
<comment: 'A WACodecStream is a wrapper around a write stream and defines common behavior.
|
||||
|
||||
Instance Variables
|
||||
stream: <WriteStream>
|
||||
|
||||
stream - a WriteStream
|
||||
|
||||
'>
|
||||
<category: 'Grease-Core-Text'>
|
||||
|
||||
GRCodecStream class >> on: aStream [
|
||||
<category: 'instance creation'>
|
||||
^self basicNew initalizeOn: aStream
|
||||
]
|
||||
|
||||
initalizeOn: aStream [
|
||||
<category: 'initialization'>
|
||||
self initialize.
|
||||
stream := aStream
|
||||
]
|
||||
|
||||
binary [
|
||||
<category: 'accessing'>
|
||||
|
||||
]
|
||||
|
||||
contents [
|
||||
<category: 'accessing'>
|
||||
^stream contents
|
||||
]
|
||||
|
||||
flush [
|
||||
<category: 'accessing'>
|
||||
stream flush
|
||||
]
|
||||
|
||||
size [
|
||||
<category: 'accessing'>
|
||||
^stream size
|
||||
]
|
||||
|
||||
text [
|
||||
<category: 'accessing'>
|
||||
|
||||
]
|
||||
|
||||
crlf [
|
||||
<category: 'streaming'>
|
||||
self
|
||||
nextPut: Character cr;
|
||||
nextPut: Character lf
|
||||
]
|
||||
|
||||
next [
|
||||
<category: 'streaming'>
|
||||
self subclassResponsibility
|
||||
]
|
||||
|
||||
next: anInteger [
|
||||
<category: 'streaming'>
|
||||
self subclassResponsibility
|
||||
]
|
||||
|
||||
nextPut: aCharacter [
|
||||
<category: 'streaming'>
|
||||
self subclassResponsibility
|
||||
]
|
||||
|
||||
nextPutAll: aString [
|
||||
<category: 'streaming'>
|
||||
self subclassResponsibility
|
||||
]
|
||||
|
||||
space [
|
||||
<category: 'streaming'>
|
||||
self nextPut: Character space
|
||||
]
|
||||
|
||||
tab [
|
||||
<category: 'streaming'>
|
||||
self nextPut: Character tab
|
||||
]
|
||||
|
||||
atEnd [
|
||||
<category: 'testing'>
|
||||
^stream atEnd
|
||||
]
|
||||
]
|
||||
|
|
@ -0,0 +1,33 @@
|
|||
GRObject subclass: GRInflector [
|
||||
|
||||
<comment: 'The Inflector transforms words from singular to plural.'>
|
||||
<category: 'Grease-Core-Text'>
|
||||
|
||||
InflectionRules := nil.
|
||||
Uninflected := nil.
|
||||
|
||||
GRInflector class >> pluralize: aString [
|
||||
<category: 'accessing'>
|
||||
| string |
|
||||
string := aString asLowercase.
|
||||
Uninflected do: [:each | (string endsWith: each) ifTrue: [^aString]].
|
||||
InflectionRules do:
|
||||
[:rule |
|
||||
(string endsWith: rule first)
|
||||
ifTrue: [^(aString allButLast: rule third) , rule second]].
|
||||
^aString , 's'
|
||||
]
|
||||
|
||||
GRInflector class >> initialize [
|
||||
<category: 'initialization'>
|
||||
Uninflected := #('bison' 'bream' 'breeches' 'britches' 'carp' 'chassis' 'clippers' 'cod' 'contretemps' 'corps' 'debris' 'deer' 'diabetes' 'djinn' 'eland' 'elk' 'equipment' 'fish' 'flounder' 'gallows' 'graffiti' 'headquarters' 'herpes' 'high-jinks' 'homework' 'information' 'innings' 'ities' 'itis' 'jackanapes' 'mackerel' 'measles' 'mews' 'money' 'mumps' 'news' 'ois' 'pincers' 'pliers' 'pox' 'proceedings' 'rabies' 'rice' 'salmon' 'scissors' 'sea-bass' 'series' 'shears' 'sheep' 'species' 'swine' 'trout' 'tuna' 'whiting' 'wildebeest').
|
||||
InflectionRules := #(#('man' 'en' 2) #('child' 'ren' 0) #('cow' 'kine' 3) #('penis' 'es' 0) #('sex' 'es' 0) #('person' 'ople' 4) #('octopus' 'es' 0) #('quiz' 'zes' 0) #('ox' 'en' 0) #('louse' 'ice' 4) #('mouse' 'ice' 4) #('matrix' 'ices' 2) #('vertix' 'ices' 2) #('vertex' 'ices' 2) #('indix' 'ices' 2) #('index' 'ices' 2) #('x' 'es' 0) #('ch' 'es' 0) #('ss' 'es' 0) #('sh' 'es' 0) #('ay' 's' 0) #('ey' 's' 0) #('iy' 's' 0) #('oy' 's' 0) #('uy' 's' 0) #('y' 'ies' 1) #('alf' 'ves' 1) #('elf' 'ves' 1) #('olf' 'ves' 1) #('arf' 'ves' 1) #('nife' 'ves' 2) #('life' 'ves' 2) #('wife' 'ves' 2) #('sis' 'es' 2) #('tum' 'a' 2) #('ium' 'a' 2) #('buffalo' 'es' 0) #('tomato' 'es' 0) #('buffalo' 'es' 0) #('bus' 'es' 0) #('alias' 'es' 0) #('status' 'es' 0) #('octopus' 'i' 2) #('virus' 'i' 2) #('axis' 'es' 2) #('s' '' 0))
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
|
||||
Eval [
|
||||
GRInflector initialize
|
||||
]
|
||||
|
||||
|
|
@ -0,0 +1 @@
|
|||
GRError subclass: GRInvalidUtf8Error []
|
||||
|
|
@ -0,0 +1,36 @@
|
|||
GRPrinter subclass: GRMappedPrinter [
|
||||
| next block |
|
||||
|
||||
<comment: nil>
|
||||
<category: 'Grease-Core-Text'>
|
||||
|
||||
GRMappedPrinter class >> block: aBlock next: aPrinter [
|
||||
<category: 'instance creation'>
|
||||
^(self new)
|
||||
block: aBlock;
|
||||
next: aPrinter;
|
||||
yourself
|
||||
]
|
||||
|
||||
block: aBlock [
|
||||
<category: 'accessing'>
|
||||
block := aBlock
|
||||
]
|
||||
|
||||
next: aPrinter [
|
||||
<category: 'accessing'>
|
||||
next := aPrinter
|
||||
]
|
||||
|
||||
initialize [
|
||||
<category: 'initialization'>
|
||||
super initialize.
|
||||
self block: [:value | value]
|
||||
]
|
||||
|
||||
print: anObject on: aStream [
|
||||
<category: 'printing'>
|
||||
next print: (block value: anObject) on: aStream
|
||||
]
|
||||
]
|
||||
|
||||
|
|
@ -0,0 +1,61 @@
|
|||
GRCodec subclass: GRNullCodec [
|
||||
|
||||
<comment: 'The null codec always returns the original streams. It assumes that the outside world uses the same encoding as the inside world. This is highly efficient as no transformation is applied to the data, but has its drawbacks.'>
|
||||
<category: 'Grease-Core-Text'>
|
||||
|
||||
GRNullCodec class >> codecs [
|
||||
<category: 'accessing'>
|
||||
^Array with: self new
|
||||
]
|
||||
|
||||
GRNullCodec class >> supportsEncoding: aString [
|
||||
<category: 'testing'>
|
||||
^aString isNil
|
||||
]
|
||||
|
||||
GRNullCodec class >> basicForEncoding: aString [
|
||||
<category: 'private'>
|
||||
^self new
|
||||
]
|
||||
|
||||
name [
|
||||
<category: 'accessing'>
|
||||
^'(none)'
|
||||
]
|
||||
|
||||
url [
|
||||
"The selfish method. Let's do it with ourselves."
|
||||
|
||||
<category: 'accessing'>
|
||||
^self
|
||||
]
|
||||
|
||||
decode: aString [
|
||||
"Overridden for efficencey."
|
||||
|
||||
<category: 'convenience'>
|
||||
^aString
|
||||
]
|
||||
|
||||
encode: aString [
|
||||
"Overridden for efficencey."
|
||||
|
||||
<category: 'convenience'>
|
||||
^aString
|
||||
]
|
||||
|
||||
decoderFor: aReadStream [
|
||||
"wrap to avoid String vs ByteArray issues"
|
||||
|
||||
<category: 'conversion'>
|
||||
^GRNullCodecStream on: aReadStream
|
||||
]
|
||||
|
||||
encoderFor: aWriteStream [
|
||||
"wrap to avoid String vs ByteArray issues"
|
||||
|
||||
<category: 'conversion'>
|
||||
^GRNullCodecStream on: aWriteStream
|
||||
]
|
||||
]
|
||||
|
||||
|
|
@ -0,0 +1,37 @@
|
|||
GRCodecStream subclass: GRNullCodecStream [
|
||||
|
||||
<comment: 'A WANullCodecStream is a WriteStream on a String on which you can both put binary and character data without encoding happening.
|
||||
|
||||
Instance Variables
|
||||
stream: <WriteStream>
|
||||
|
||||
stream
|
||||
- a WriteStream on a String'>
|
||||
<category: 'Grease-Core-Text'>
|
||||
|
||||
next [
|
||||
<category: 'streaming'>
|
||||
^stream next
|
||||
]
|
||||
|
||||
next: anInteger [
|
||||
<category: 'streaming'>
|
||||
^stream next: anInteger
|
||||
]
|
||||
|
||||
nextPut: aCharacterOrByte [
|
||||
<category: 'streaming'>
|
||||
aCharacterOrByte isCharacter
|
||||
ifTrue: [stream nextPut: aCharacterOrByte]
|
||||
ifFalse: [stream nextPut: (Character codePoint: aCharacterOrByte)]
|
||||
]
|
||||
|
||||
nextPutAll: aStringOrByteArray [
|
||||
<category: 'streaming'>
|
||||
aStringOrByteArray isString
|
||||
ifTrue: [stream nextPutAll: aStringOrByteArray]
|
||||
ifFalse: [1
|
||||
to: aStringOrByteArray size
|
||||
do: [:index | stream nextPut: (Character codePoint: (aStringOrByteArray at: index))]]
|
||||
]
|
||||
]
|
||||
|
|
@ -0,0 +1,228 @@
|
|||
GRPrinter subclass: GRNumberPrinter [
|
||||
| characters base delimiter digits infinite nan padding accuracy precision separator |
|
||||
|
||||
<comment: 'A GRNumberPrinter is prints numbers (integers and floats) in various formats in a platform independent way.
|
||||
|
||||
Instance Variables
|
||||
accuracy: <UndefinedObject|Float>
|
||||
base: <Integer>
|
||||
delimiter: <UndefinedObject|Charater>
|
||||
digits: <UndefinedObject|Integer>
|
||||
infinite: <UndefinedObject|String>
|
||||
nan: <UndefinedObject|String>
|
||||
padding: <UndefinedObject|Charater>
|
||||
precision: <Integer>
|
||||
separator: <UndefinedObject|Charater>'>
|
||||
<category: 'Grease-Core-Text'>
|
||||
|
||||
NumbersToCharactersLowercase := nil.
|
||||
NumbersToCharactersUppercase := nil.
|
||||
|
||||
GRNumberPrinter class >> initialize [
|
||||
<category: 'initialization'>
|
||||
NumbersToCharactersLowercase := '0123456789abcdefghijklmnopqrstuvwxyz'.
|
||||
NumbersToCharactersUppercase := '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'
|
||||
]
|
||||
|
||||
accuracy: aFloat [
|
||||
"Round towards the nearest number that is a multiple of aFloat."
|
||||
|
||||
<category: 'accessing'>
|
||||
accuracy := aFloat
|
||||
]
|
||||
|
||||
base: anInteger [
|
||||
"The numeric base to which the number should be printed."
|
||||
|
||||
<category: 'accessing'>
|
||||
base := anInteger
|
||||
]
|
||||
|
||||
characters: aString [
|
||||
"The characters to be used to convert a number to a string."
|
||||
|
||||
<category: 'accessing'>
|
||||
characters := aString
|
||||
]
|
||||
|
||||
delimiter: aCharacter [
|
||||
"The delimiter to separate the integer and fraction part of the number."
|
||||
|
||||
<category: 'accessing'>
|
||||
delimiter := aCharacter
|
||||
]
|
||||
|
||||
digits: anInteger [
|
||||
"The number of digits to be printed in the integer part."
|
||||
|
||||
<category: 'accessing'>
|
||||
digits := anInteger
|
||||
]
|
||||
|
||||
infinite: aString [
|
||||
"The string that should be displayed if the number is positive or negative infinity."
|
||||
|
||||
<category: 'accessing'>
|
||||
infinite := aString
|
||||
]
|
||||
|
||||
nan: aString [
|
||||
"The string that should be displayed if the number is not a number."
|
||||
|
||||
<category: 'accessing'>
|
||||
nan := aString
|
||||
]
|
||||
|
||||
padding: aCharacter [
|
||||
"The padding for the integer part."
|
||||
|
||||
<category: 'accessing'>
|
||||
padding := aCharacter
|
||||
]
|
||||
|
||||
precision: anInteger [
|
||||
"The number of digits to be printed in the fraction part."
|
||||
|
||||
<category: 'accessing'>
|
||||
precision := anInteger
|
||||
]
|
||||
|
||||
separator: aCharacter [
|
||||
"Separator character to be used to group digits."
|
||||
|
||||
<category: 'accessing'>
|
||||
separator := aCharacter
|
||||
]
|
||||
|
||||
lowercase [
|
||||
"Use lowercase characters for numbers of base 10 and higher."
|
||||
|
||||
<category: 'actions'>
|
||||
self characters: NumbersToCharactersLowercase
|
||||
]
|
||||
|
||||
uppercase [
|
||||
"Use uppercase characters for numbers of base 10 and higher."
|
||||
|
||||
<category: 'actions'>
|
||||
self characters: NumbersToCharactersUppercase
|
||||
]
|
||||
|
||||
initialize [
|
||||
<category: 'initialization'>
|
||||
super initialize.
|
||||
self lowercase.
|
||||
self base: 10.
|
||||
self delimiter: $..
|
||||
self infinite: 'Infinite'.
|
||||
self nan: 'NaN'.
|
||||
self padding: $ .
|
||||
self precision: 0
|
||||
]
|
||||
|
||||
print: aNumber on: aStream [
|
||||
<category: 'printing'>
|
||||
aNumber isNaN ifTrue: [^self printNaN: aNumber on: aStream].
|
||||
aNumber isInfinite ifTrue: [^self printInfinite: aNumber on: aStream].
|
||||
precision = 0
|
||||
ifTrue: [self printInteger: aNumber on: aStream]
|
||||
ifFalse: [self printFloat: aNumber on: aStream]
|
||||
]
|
||||
|
||||
printFloat: aNumber on: aStream [
|
||||
<category: 'printing'>
|
||||
| multiplier rounded |
|
||||
multiplier := base asFloat raisedTo: precision.
|
||||
rounded := aNumber roundTo: (accuracy ifNil: [1.0 / multiplier]).
|
||||
self printInteger: rounded on: aStream.
|
||||
delimiter isNil ifFalse: [aStream nextPut: delimiter].
|
||||
self printFraction: rounded fractionPart abs * multiplier on: aStream
|
||||
]
|
||||
|
||||
printFraction: aNumber on: aStream [
|
||||
<category: 'printing'>
|
||||
| result |
|
||||
result := self
|
||||
pad: (self digitsOf: aNumber rounded base: base)
|
||||
left: $0
|
||||
to: precision.
|
||||
separator isNil ifFalse: [result := self separate: result left: separator].
|
||||
aStream nextPutAll: result
|
||||
]
|
||||
|
||||
printInfinite: aNumber on: aStream [
|
||||
<category: 'printing'>
|
||||
infinite isNil ifFalse: [aStream nextPutAll: infinite]
|
||||
]
|
||||
|
||||
printInteger: aNumber on: aStream [
|
||||
<category: 'printing'>
|
||||
| result |
|
||||
result := self digitsOf: aNumber integerPart base: base.
|
||||
separator isNil
|
||||
ifFalse: [result := self separate: result right: separator].
|
||||
(digits isNil or: [padding isNil])
|
||||
ifFalse: [result := self
|
||||
pad: result
|
||||
left: padding
|
||||
to: digits].
|
||||
aStream nextPutAll: result
|
||||
]
|
||||
|
||||
printNaN: anInteger on: aStream [
|
||||
<category: 'printing'>
|
||||
nan isNil ifFalse: [aStream nextPutAll: nan]
|
||||
]
|
||||
|
||||
digitsOf: aNumber base: aBaseInteger [
|
||||
"Answer the absolute digits of aNumber in the base aBaseInteger."
|
||||
|
||||
<category: 'utilities'>
|
||||
| integer stream next |
|
||||
integer := aNumber truncated abs.
|
||||
integer = 0 ifTrue: [^'0'].
|
||||
stream := WriteStream on: (String new: 10).
|
||||
[integer > 0] whileTrue:
|
||||
[next := integer quo: aBaseInteger.
|
||||
stream nextPut: (characters at: 1 + integer - (next * aBaseInteger)).
|
||||
integer := next].
|
||||
^stream contents reversed
|
||||
]
|
||||
|
||||
separate: aString left: aCharacter [
|
||||
"Separate from the left side every 3 characters with aCharacter."
|
||||
|
||||
<category: 'utilities'>
|
||||
| size stream |
|
||||
size := aString size.
|
||||
stream := WriteStream on: (String new: 2 * size).
|
||||
1
|
||||
to: size
|
||||
do: [:index |
|
||||
(index ~= 1 and: [index \\ 3 = 1]) ifTrue: [stream nextPut: aCharacter].
|
||||
stream nextPut: (aString at: index)].
|
||||
^stream contents
|
||||
]
|
||||
|
||||
separate: aString right: aCharacter [
|
||||
"Separate from the right side every 3 characters with aCharacter."
|
||||
|
||||
<category: 'utilities'>
|
||||
| size stream |
|
||||
size := aString size.
|
||||
stream := WriteStream on: (String new: 2 * size).
|
||||
1
|
||||
to: size
|
||||
do: [:index |
|
||||
(index ~= 1 and: [(size - index) \\ 3 = 2])
|
||||
ifTrue: [stream nextPut: aCharacter].
|
||||
stream nextPut: (aString at: index)].
|
||||
^stream contents
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
|
||||
Eval [
|
||||
GRNumberPrinter initialize
|
||||
]
|
||||
|
|
@ -0,0 +1,24 @@
|
|||
Eval [
|
||||
'From PharoCore1.0rc1 of 19 October 2009 [Latest update: #10505] on 9 March 2010 at 6:38:04 pm'
|
||||
]
|
||||
|
||||
|
||||
|
||||
GRPrinter subclass: GROrdinalizePrinter [
|
||||
|
||||
<comment: nil>
|
||||
<category: 'Grease-Core-Text'>
|
||||
|
||||
print: anObject on: aStream [
|
||||
<category: 'printing'>
|
||||
aStream nextPutAll: (self ordinalize: anObject integerPart)
|
||||
]
|
||||
|
||||
ordinalize: anInteger [
|
||||
<category: 'private'>
|
||||
^(anInteger \\ 100 between: 11 and: 13)
|
||||
ifTrue: ['th']
|
||||
ifFalse: [#('st' 'nd' 'rd') at: anInteger \\ 10 ifAbsent: ['th']]
|
||||
]
|
||||
]
|
||||
|
||||
|
|
@ -0,0 +1,28 @@
|
|||
GRPrinter subclass: GRPluggablePrinter [
|
||||
| block |
|
||||
|
||||
<comment: nil>
|
||||
<category: 'Grease-Core-Text'>
|
||||
|
||||
GRPluggablePrinter class >> on: aBlock [
|
||||
<category: 'instance creation'>
|
||||
^self new block: aBlock
|
||||
]
|
||||
|
||||
block: aBlock [
|
||||
<category: 'accessing'>
|
||||
block := aBlock
|
||||
]
|
||||
|
||||
initialize [
|
||||
<category: 'initialization'>
|
||||
super initialize.
|
||||
self block: [:value | String new]
|
||||
]
|
||||
|
||||
print: anObject on: aStream [
|
||||
<category: 'printing'>
|
||||
aStream nextPutAll: (block value: anObject)
|
||||
]
|
||||
]
|
||||
|
||||
|
|
@ -0,0 +1,328 @@
|
|||
GRObject subclass: GRPrinter [
|
||||
|
||||
<comment: nil>
|
||||
<category: 'Grease-Core-Text'>
|
||||
|
||||
GRPrinter class >> cookieTimestamp [
|
||||
"Netscape's original proposal defined an Expires header that took a date value in a fixed-length variant format in place of Max-Age: Wdy, DD-Mon-YY HH:MM:SS GMT"
|
||||
|
||||
<category: 'factory'>
|
||||
^GRMappedPrinter block: [:timestamp | timestamp asUTC]
|
||||
next: self abbreviatedWeekName , ', ' , self paddedDay , '-'
|
||||
, self abbreviatedMonthName , '-'
|
||||
, self paddedYear , ' '
|
||||
, self isoTime , ' GMT'
|
||||
]
|
||||
|
||||
GRPrinter class >> httpDate [
|
||||
"Answers a printer that formats dates for HTTP1.1 (RFC 2616)"
|
||||
|
||||
<category: 'factory'>
|
||||
^self rfc1123
|
||||
]
|
||||
|
||||
GRPrinter class >> isoDate [
|
||||
"Ansers a printer that formats dates accoring to ISO(YYYY-MM-DD) E.g.
|
||||
2003-12-24"
|
||||
|
||||
<category: 'factory'>
|
||||
^self paddedYear , $- , self paddedMonth , $- , self paddedDay
|
||||
]
|
||||
|
||||
GRPrinter class >> isoTime [
|
||||
"Ansers a printer that formats time accoring to ISO(HH:MM:SS) E.g.
|
||||
12:23:34"
|
||||
|
||||
<category: 'factory'>
|
||||
^self paddedHour24 , $: , self paddedMinute , $: , self paddedSecond
|
||||
]
|
||||
|
||||
GRPrinter class >> rfc1123 [
|
||||
"Answers a printer that formats dates for HTTP1.1 (RFC 1123). Eg.
|
||||
Sun, 06 Nov 1994 08:49:37 GMT"
|
||||
|
||||
<category: 'factory'>
|
||||
^GRMappedPrinter block:
|
||||
[:date |
|
||||
"For the purposes of HTTP, GMT is exactly equal to UTC (Coordinated Universal Time)"
|
||||
|
||||
date asUTC]
|
||||
next: GRSequentialPrinter new , self abbreviatedWeekName , ', '
|
||||
, self paddedDay , Character space
|
||||
, self abbreviatedMonthName , Character space
|
||||
, self paddedYear , Character space
|
||||
, self isoTime , ' GMT'
|
||||
]
|
||||
|
||||
GRPrinter class >> rfc822 [
|
||||
"Answers a privter that formats dates according to RFC 822 (email). Eg.
|
||||
Sun, 31 Aug 2008 19:41:46 +0200"
|
||||
|
||||
<category: 'factory'>
|
||||
^self abbreviatedWeekName , ', ' , self paddedDay , Character space
|
||||
, self abbreviatedMonthName , Character space
|
||||
, self paddedYear , Character space
|
||||
, self isoTime , Character space
|
||||
, self offsetSign , self absOffsetHoursPadded
|
||||
, self absOffsetMinutesPadded
|
||||
]
|
||||
|
||||
GRPrinter class >> rfc822WithTimeZone: aString [
|
||||
"Answers a privter that formats dates according to RFC 822 (email) with the given time zone String. Eg.
|
||||
Sun, 31 Aug 2008 19:41:46 <aString>"
|
||||
|
||||
<category: 'factory'>
|
||||
^self abbreviatedWeekName , ', ' , self paddedDay , Character space
|
||||
, self abbreviatedMonthName , Character space
|
||||
, self paddedYear , Character space
|
||||
, self isoTime , Character space
|
||||
, aString
|
||||
]
|
||||
|
||||
GRPrinter class >> swissCurrency [
|
||||
<category: 'factory'>
|
||||
^GRSequentialPrinter new , 'CHF ' , GRSignPrinter new
|
||||
, ((GRNumberPrinter new)
|
||||
separator: $';
|
||||
precision: 2;
|
||||
accuracy: 0.05;
|
||||
yourself)
|
||||
]
|
||||
|
||||
GRPrinter class >> usCurrency [
|
||||
<category: 'factory'>
|
||||
^GRSignPrinter new , $$ , ((GRNumberPrinter new)
|
||||
separator: $,;
|
||||
precision: 2;
|
||||
yourself)
|
||||
]
|
||||
|
||||
GRPrinter class >> abbreviatedMonthName [
|
||||
<category: 'parts-date'>
|
||||
^self
|
||||
monthName: #('Jan' 'Feb' 'Mar' 'Apr' 'May' 'Jun' 'Jul' 'Aug' 'Sep' 'Oct' 'Nov' 'Dec')
|
||||
]
|
||||
|
||||
GRPrinter class >> abbreviatedWeekName [
|
||||
<category: 'parts-date'>
|
||||
^self weekName: #('Sun' 'Mon' 'Tue' 'Wed' 'Thu' 'Fri' 'Sat')
|
||||
]
|
||||
|
||||
GRPrinter class >> absOffsetHoursPadded [
|
||||
<category: 'parts-date'>
|
||||
^GRMappedPrinter block: [:date | date offset hours abs]
|
||||
next: (self numberWithAtLeastDigits: 2)
|
||||
]
|
||||
|
||||
GRPrinter class >> absOffsetMinutesPadded [
|
||||
<category: 'parts-date'>
|
||||
^GRMappedPrinter block: [:date | date offset minutes abs]
|
||||
next: (self numberWithAtLeastDigits: 2)
|
||||
]
|
||||
|
||||
GRPrinter class >> fullMonthName [
|
||||
<category: 'parts-date'>
|
||||
^self
|
||||
monthName: #('January' 'February' 'March' 'April' 'May' 'June' 'July' 'August' 'September' 'October' 'November' 'December')
|
||||
]
|
||||
|
||||
GRPrinter class >> fullWeekName [
|
||||
<category: 'parts-date'>
|
||||
^self
|
||||
weekName: #('Sunday' 'Monday' 'Tuesday' 'Wednesday' 'Thursday' 'Friday' 'Saturday')
|
||||
]
|
||||
|
||||
GRPrinter class >> monthName: anArray [
|
||||
<category: 'parts-date'>
|
||||
^GRPluggablePrinter on: [:date | anArray at: date monthIndex]
|
||||
]
|
||||
|
||||
GRPrinter class >> offsetSign [
|
||||
<category: 'parts-date'>
|
||||
^GRMappedPrinter block: [:date | date offset]
|
||||
next: ((GRSignPrinter new)
|
||||
positivePrinter: $+;
|
||||
negativePrinter: $-;
|
||||
yourself)
|
||||
]
|
||||
|
||||
GRPrinter class >> paddedCentury [
|
||||
<category: 'parts-date'>
|
||||
^GRMappedPrinter block: [:date | date year \\ 100]
|
||||
next: (self numberWithAtLeastDigits: 2)
|
||||
]
|
||||
|
||||
GRPrinter class >> paddedDay [
|
||||
<category: 'parts-date'>
|
||||
^GRMappedPrinter block: [:date | date dayOfMonth]
|
||||
next: (self numberWithAtLeastDigits: 2)
|
||||
]
|
||||
|
||||
GRPrinter class >> paddedMonth [
|
||||
<category: 'parts-date'>
|
||||
^GRMappedPrinter block: [:date | date monthIndex]
|
||||
next: (self numberWithAtLeastDigits: 2)
|
||||
]
|
||||
|
||||
GRPrinter class >> paddedYear [
|
||||
<category: 'parts-date'>
|
||||
^GRMappedPrinter block: [:date | date year]
|
||||
next: (self numberWithAtLeastDigits: 4)
|
||||
]
|
||||
|
||||
GRPrinter class >> unpaddedCentury [
|
||||
<category: 'parts-date'>
|
||||
^GRMappedPrinter block: [:date | date year \\ 100]
|
||||
next: GRNumberPrinter new
|
||||
]
|
||||
|
||||
GRPrinter class >> unpaddedDay [
|
||||
<category: 'parts-date'>
|
||||
^GRMappedPrinter block: [:date | date dayOfMonth] next: GRNumberPrinter new
|
||||
]
|
||||
|
||||
GRPrinter class >> unpaddedMonth [
|
||||
<category: 'parts-date'>
|
||||
^GRMappedPrinter block: [:date | date monthIndex] next: GRNumberPrinter new
|
||||
]
|
||||
|
||||
GRPrinter class >> unpaddedYear [
|
||||
<category: 'parts-date'>
|
||||
^GRMappedPrinter block: [:date | date year] next: GRNumberPrinter new
|
||||
]
|
||||
|
||||
GRPrinter class >> weekName: anArray [
|
||||
<category: 'parts-date'>
|
||||
^GRPluggablePrinter on: [:date | anArray at: date dayOfWeek]
|
||||
]
|
||||
|
||||
GRPrinter class >> paddedHour12 [
|
||||
<category: 'parts-time'>
|
||||
^GRMappedPrinter block: [:time | (time hour - 1) \\ 12 + 1]
|
||||
next: (self numberWithAtLeastDigits: 2)
|
||||
]
|
||||
|
||||
GRPrinter class >> paddedHour24 [
|
||||
<category: 'parts-time'>
|
||||
^GRMappedPrinter block: [:time | time hour]
|
||||
next: (self numberWithAtLeastDigits: 2)
|
||||
]
|
||||
|
||||
GRPrinter class >> paddedMinute [
|
||||
<category: 'parts-time'>
|
||||
^GRMappedPrinter block: [:time | time minute]
|
||||
next: (self numberWithAtLeastDigits: 2)
|
||||
]
|
||||
|
||||
GRPrinter class >> paddedSecond [
|
||||
<category: 'parts-time'>
|
||||
^GRMappedPrinter block: [:time | time second]
|
||||
next: ((GRNumberPrinter new)
|
||||
padding: $0;
|
||||
digits: 2)
|
||||
]
|
||||
|
||||
GRPrinter class >> unpaddedHour12 [
|
||||
<category: 'parts-time'>
|
||||
^GRMappedPrinter block: [:time | (time hour - 1) \\ 12 + 1]
|
||||
next: GRNumberPrinter new
|
||||
]
|
||||
|
||||
GRPrinter class >> unpaddedHour24 [
|
||||
<category: 'parts-time'>
|
||||
^GRMappedPrinter block: [:time | time hour] next: GRNumberPrinter new
|
||||
]
|
||||
|
||||
GRPrinter class >> unpaddedMinute [
|
||||
<category: 'parts-time'>
|
||||
^GRMappedPrinter block: [:time | time minute] next: GRNumberPrinter new
|
||||
]
|
||||
|
||||
GRPrinter class >> unpaddedSecond [
|
||||
<category: 'parts-time'>
|
||||
^GRMappedPrinter block: [:time | time second] next: GRNumberPrinter new
|
||||
]
|
||||
|
||||
GRPrinter class >> binaryFileSize [
|
||||
<category: 'parts-units'>
|
||||
^GRUnitPrinter base: 1024
|
||||
units: #('byte' 'bytes' 'KiB' 'MiB' 'GiB' 'TiB' 'PiB' 'EiB' 'ZiB' 'YiB')
|
||||
]
|
||||
|
||||
GRPrinter class >> decimalFileSize [
|
||||
<category: 'parts-units'>
|
||||
^GRUnitPrinter base: 1000
|
||||
units: #('byte' 'bytes' 'kB' 'MB' 'GB' 'TB' 'PB' 'EB' 'ZB' 'YB')
|
||||
]
|
||||
|
||||
GRPrinter class >> numberWithAtLeastDigits: anInteger [
|
||||
<category: 'parts-units'>
|
||||
^(GRNumberPrinter new)
|
||||
padding: $0;
|
||||
digits: anInteger;
|
||||
yourself
|
||||
]
|
||||
|
||||
, aPrinter [
|
||||
<category: 'operators'>
|
||||
^GRSequentialPrinter new , self , aPrinter
|
||||
]
|
||||
|
||||
print: anObject [
|
||||
<category: 'printing'>
|
||||
^String streamContents: [:stream | self print: anObject on: stream]
|
||||
]
|
||||
|
||||
print: anObject on: aStream [
|
||||
"Subclasses override this method to produce some output."
|
||||
|
||||
<category: 'printing'>
|
||||
|
||||
]
|
||||
|
||||
pad: aString center: aCharacter to: anInteger [
|
||||
"Pad to the center of aString with aCharacter to at least anInteger characters."
|
||||
|
||||
<category: 'utilities'>
|
||||
| result index |
|
||||
anInteger <= aString size ifTrue: [^aString].
|
||||
index := (anInteger - aString size) // 2.
|
||||
result := (String new: anInteger) atAllPut: aCharacter.
|
||||
result
|
||||
replaceFrom: index + 1
|
||||
to: index + aString size
|
||||
with: aString
|
||||
startingAt: 1.
|
||||
^result
|
||||
]
|
||||
|
||||
pad: aString left: aCharacter to: anInteger [
|
||||
"Pad to the left side of aString with aCharacter to at least anInteger characters."
|
||||
|
||||
<category: 'utilities'>
|
||||
| result |
|
||||
anInteger <= aString size ifTrue: [^aString].
|
||||
result := (String new: anInteger) atAllPut: aCharacter.
|
||||
result
|
||||
replaceFrom: anInteger - aString size + 1
|
||||
to: anInteger
|
||||
with: aString
|
||||
startingAt: 1.
|
||||
^result
|
||||
]
|
||||
|
||||
pad: aString right: aCharacter to: anInteger [
|
||||
"Pad to the right side of aString with aCharacter to at least anInteger characters."
|
||||
|
||||
<category: 'utilities'>
|
||||
| result |
|
||||
anInteger <= aString size ifTrue: [^aString].
|
||||
result := (String new: anInteger) atAllPut: aCharacter.
|
||||
result
|
||||
replaceFrom: 1
|
||||
to: aString size
|
||||
with: aString
|
||||
startingAt: 1.
|
||||
^result
|
||||
]
|
||||
]
|
||||
|
|
@ -0,0 +1,22 @@
|
|||
GRPrinter subclass: GRSequentialPrinter [
|
||||
| parts |
|
||||
|
||||
<comment: nil>
|
||||
<category: 'Grease-Core-Text'>
|
||||
|
||||
initialize [
|
||||
<category: 'initialization'>
|
||||
super initialize.
|
||||
parts := OrderedCollection new
|
||||
]
|
||||
|
||||
, aConverter [
|
||||
<category: 'operators'>
|
||||
parts add: aConverter
|
||||
]
|
||||
|
||||
print: anObject on: aStream [
|
||||
<category: 'printing'>
|
||||
parts do: [:each | each print: anObject on: aStream]
|
||||
]
|
||||
]
|
||||
|
|
@ -0,0 +1,35 @@
|
|||
GRPrinter subclass: GRSignPrinter [
|
||||
| negativePrinter positivePrinter |
|
||||
|
||||
<comment: nil>
|
||||
<category: 'Grease-Core-Text'>
|
||||
|
||||
negativePrinter: aPrinter [
|
||||
"The printer to be used when the number is negative."
|
||||
|
||||
<category: 'accessing'>
|
||||
negativePrinter := aPrinter
|
||||
]
|
||||
|
||||
positivePrinter: aPrinter [
|
||||
"The printer to be used when the number is zero or positive."
|
||||
|
||||
<category: 'accessing'>
|
||||
positivePrinter := aPrinter
|
||||
]
|
||||
|
||||
initialize [
|
||||
<category: 'initialization'>
|
||||
super initialize.
|
||||
self negativePrinter: $-.
|
||||
self positivePrinter: nil
|
||||
]
|
||||
|
||||
print: anObject on: aStream [
|
||||
<category: 'printing'>
|
||||
anObject negative
|
||||
ifTrue: [negativePrinter print: anObject on: aStream]
|
||||
ifFalse: [positivePrinter print: anObject on: aStream]
|
||||
]
|
||||
]
|
||||
|
||||
|
|
@ -0,0 +1,106 @@
|
|||
GRPrinter subclass: GRStringPrinter [
|
||||
| trim length pad character |
|
||||
|
||||
<comment: nil>
|
||||
<category: 'Grease-Core-Text'>
|
||||
|
||||
character: aCharacter [
|
||||
"The character to pad the string with."
|
||||
|
||||
<category: 'accessing'>
|
||||
character := aCharacter
|
||||
]
|
||||
|
||||
length: anInteger [
|
||||
"The maximal size of the string, or the size to pad to."
|
||||
|
||||
<category: 'accessing'>
|
||||
length := anInteger
|
||||
]
|
||||
|
||||
initialize [
|
||||
<category: 'initialization'>
|
||||
super initialize.
|
||||
self
|
||||
character: $ ;
|
||||
length: nil.
|
||||
self
|
||||
trimNone;
|
||||
padNone
|
||||
]
|
||||
|
||||
padCenter [
|
||||
"Pad to the center."
|
||||
|
||||
<category: 'padding'>
|
||||
pad := #pad:center:to:
|
||||
]
|
||||
|
||||
padLeft [
|
||||
"Pad to the left."
|
||||
|
||||
<category: 'padding'>
|
||||
pad := #pad:left:to:
|
||||
]
|
||||
|
||||
padNone [
|
||||
"Do not pad the input."
|
||||
|
||||
<category: 'padding'>
|
||||
pad := nil
|
||||
]
|
||||
|
||||
padRight [
|
||||
"Pad to the right."
|
||||
|
||||
<category: 'padding'>
|
||||
pad := #pad:right:to:
|
||||
]
|
||||
|
||||
print: anObject on: aStream [
|
||||
<category: 'printing'>
|
||||
| string |
|
||||
string := anObject greaseString.
|
||||
trim isNil ifFalse: [string := string perform: trim].
|
||||
length isNil
|
||||
ifFalse: [
|
||||
length < string size ifTrue: [string := string copyFrom: 1 to: length].
|
||||
(pad isNil or: [character isNil])
|
||||
ifFalse: [
|
||||
string := self
|
||||
perform: pad
|
||||
with: string
|
||||
with: character
|
||||
with: length]].
|
||||
aStream nextPutAll: string
|
||||
]
|
||||
|
||||
trimBoth [
|
||||
"Trim to the left and to the right."
|
||||
|
||||
<category: 'trimming'>
|
||||
trim := #trimBoth
|
||||
]
|
||||
|
||||
trimLeft [
|
||||
"Trim to the left and to the right."
|
||||
|
||||
<category: 'trimming'>
|
||||
trim := #trimLeft
|
||||
]
|
||||
|
||||
trimNone [
|
||||
"Do not trim the input."
|
||||
|
||||
<category: 'trimming'>
|
||||
trim := nil
|
||||
]
|
||||
|
||||
trimRight [
|
||||
"Trim to the left and to the right."
|
||||
|
||||
<category: 'trimming'>
|
||||
trim := #trimRight
|
||||
]
|
||||
]
|
||||
|
||||
|
|
@ -0,0 +1,82 @@
|
|||
Eval [
|
||||
'From PharoCore1.0rc1 of 19 October 2009 [Latest update: #10505] on 9 March 2010 at 6:45:25 pm'
|
||||
]
|
||||
|
||||
|
||||
|
||||
GRPrinter subclass: GRUnitPrinter [
|
||||
| integerPrinter fractionPrinter units base |
|
||||
|
||||
<comment: nil>
|
||||
<category: 'Grease-Core-Text'>
|
||||
|
||||
GRUnitPrinter class >> base: anInteger units: anArray [
|
||||
<category: 'instance creation'>
|
||||
^(self new)
|
||||
base: anInteger;
|
||||
units: anArray;
|
||||
yourself
|
||||
]
|
||||
|
||||
base: anInteger [
|
||||
<category: 'accessing'>
|
||||
base := anInteger
|
||||
]
|
||||
|
||||
fractionPrinter: aPrinter [
|
||||
<category: 'accessing'>
|
||||
fractionPrinter := aPrinter
|
||||
]
|
||||
|
||||
integerPrinter: aPrinter [
|
||||
<category: 'accessing'>
|
||||
integerPrinter := aPrinter
|
||||
]
|
||||
|
||||
units: anArray [
|
||||
<category: 'accessing'>
|
||||
units := anArray
|
||||
]
|
||||
|
||||
initialize [
|
||||
<category: 'initialization'>
|
||||
super initialize.
|
||||
self integerPrinter: ((GRNumberPrinter new)
|
||||
precision: 0;
|
||||
yourself).
|
||||
self fractionPrinter: ((GRNumberPrinter new)
|
||||
precision: 1;
|
||||
yourself)
|
||||
]
|
||||
|
||||
print: anObject on: aStream [
|
||||
<category: 'printing'>
|
||||
anObject = 1
|
||||
ifTrue:
|
||||
[^self
|
||||
print: anObject
|
||||
unit: units first
|
||||
on: aStream].
|
||||
units allButFirst inject: anObject asFloat
|
||||
into:
|
||||
[:value :each |
|
||||
value < base
|
||||
ifFalse: [value / base]
|
||||
ifTrue:
|
||||
[^self
|
||||
print: value
|
||||
unit: each
|
||||
on: aStream]]
|
||||
]
|
||||
|
||||
print: aNumber unit: aString on: aStream [
|
||||
<category: 'printing'>
|
||||
(units first = aString or: [units second = aString])
|
||||
ifTrue: [integerPrinter print: aNumber on: aStream]
|
||||
ifFalse: [fractionPrinter print: aNumber on: aStream].
|
||||
aStream
|
||||
nextPut: $ ;
|
||||
nextPutAll: aString
|
||||
]
|
||||
]
|
||||
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
GRError subclass: GRUnsupportedEncodingError [
|
||||
|
||||
<comment: nil>
|
||||
<category: 'Grease-Core-Text'>
|
||||
]
|
||||
|
||||
Reference in New Issue