[squeak-dev] Newbie Question: How does this work?

Joseph J Alotta joseph.alotta at gmail.com
Mon Oct 8 22:13:04 UTC 2012


Greetings:

I filed in the below code.  When I ask '%6.2e' what class it is, it replies ByteString.

'%6.2e' class => ByteString

When I send a ByteString the #printf, it somehow knows to look in the FormatString class for this
method.

'%6.2e' printf: 412.343434 => '412.34'

My question is, where is the place in the below code where this gets redirected?  i.e., Where the
printf method gets added to the ByteString path of available methods.


Thanks for your help,

Joe.






Object subclass: #FormatDescriptor
	instanceVariableNames: 'flush width precision'
	classVariableNames: 'Flags Operators'
	poolDictionaries: ''
	category: 'Printf'!

!FormatDescriptor methodsFor: 'rendering'!
applyOperator: object
	self subclassResponsibility! !

!FormatDescriptor methodsFor: 'rendering' stamp: 'hjo 9/18/2011 00:31'!
render: object
	| string |
	string := self applyOperator: object.
	self stringLength ~= 0
		ifTrue: [ string := string copyFrom: 1 to: (self stringLength min: string size) ].
	width == 0
		ifTrue: [ ^ string ].
	^ (String new: width withAll: self padding)
		copyReplaceFrom: (self startIndexOfCopyReplaceWithStringSize: string size)
		to: (self stopIndexOfCopyReplaceWithStringSize: string size)
		with: string! !

!FormatDescriptor methodsFor: 'rendering' stamp: 'hjo 9/18/2011 00:31'!
startIndexOfCopyReplaceWithStringSize: anInteger

	|start|
	flush == #leftFlush ifTrue: [start := 1].
	flush == #rightFlush ifTrue: [start := width - anInteger + 1]. 
	^(start max: 1)
! !

!FormatDescriptor methodsFor: 'rendering' stamp: 'hjo 9/18/2011 00:31'!
stopIndexOfCopyReplaceWithStringSize: anInteger

	| stop |
	flush == #leftFlush ifTrue: [stop := anInteger].
	flush == #rightFlush ifTrue: [stop := width]. 
	^stop min: width! !


!FormatDescriptor methodsFor: 'private'!
flush
	^ flush! !

!FormatDescriptor methodsFor: 'private' stamp: 'mir 6/6/2000 23:58'!
operator: char
	| myself |
	myself := (Smalltalk at: (Operators at: char)) newFrom: self.
	myself setOperator: char.
	^ myself! !

!FormatDescriptor methodsFor: 'private'!
padding
	^ Character space! !

!FormatDescriptor methodsFor: 'private'!
precision
	^ precision! !

!FormatDescriptor methodsFor: 'private'!
precision: anInteger
	precision := anInteger! !

!FormatDescriptor methodsFor: 'private'!
setOperator: char! !

!FormatDescriptor methodsFor: 'private'!
stringLength
	^ precision isNil ifTrue: [0] ifFalse: [precision]! !

!FormatDescriptor methodsFor: 'private'!
width
	^ width! !

!FormatDescriptor methodsFor: 'private'!
width: anInteger
	width := anInteger! !


!FormatDescriptor methodsFor: 'initialize-release'!
initialize
	flush := #rightFlush.
	width := 0! !


!FormatDescriptor methodsFor: 'scanning'!
leftFlush
	flush := #leftFlush! !

!FormatDescriptor methodsFor: 'scanning'!
radix
	^ (NumberFormatDescriptor newFrom: self) radix! !

!FormatDescriptor methodsFor: 'scanning'!
rightFlush
	flush := #rightFlush! !

!FormatDescriptor methodsFor: 'scanning'!
space
	^ (NumberFormatDescriptor newFrom: self) space! !

!FormatDescriptor methodsFor: 'scanning'!
zero
	^ (NumberFormatDescriptor newFrom: self) zero! !


!FormatDescriptor methodsFor: 'printing'!
printOn: aStream
	aStream nextPut: $%.
	flush == #leftFlush ifTrue: [aStream nextPut: $-]! !

!FormatDescriptor methodsFor: 'printing'!
printWidthOn: aStream
	width ~= 0 ifTrue: [width printOn: aStream].
	precision isNil ifFalse: [aStream nextPut: $.. precision printOn: aStream]! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

FormatDescriptor class
	instanceVariableNames: ''!

!FormatDescriptor class methodsFor: 'class initialization' stamp: 'mir 6/7/2000 00:21'!
initialize
	"FormatDescriptor initialize"
	Operators := Dictionary new.
	Operators at: $p put: #PrintStringFormatDescriptor.
	Operators at: $c put: #CharacterFormatDescriptor.
	Operators at: $s put: #StringFormatDescriptor.
	#($d $o $u $x $X)
		do: [:operator | Operators at: operator put: #NumberFormatDescriptor].
	#($e $E $f $g $G)
		do: [:operator | Operators at: operator put: #FloatFormatDescriptor].

	Flags := Dictionary new.
	Flags at: $- put: #leftFlush.
	Flags at: $+ put: #rightFlush.
	Flags at: $  put: #space.
	Flags at: $# put: #radix.
	Flags at: $0 put: #zero.
! !


!FormatDescriptor class methodsFor: 'instance creation'!
new
	^ super new initialize! !

!FormatDescriptor class methodsFor: 'instance creation'!
newFrom: desc
	| myself |
	myself := self new.
	myself perform: desc flush.
	myself width: desc width.
	myself precision: desc precision.
	^ myself! !

!FormatDescriptor class methodsFor: 'instance creation'!
scanFrom: stream
	| desc |
	desc := self new.
	[Flags includesKey: stream peek]
		whileTrue: [desc := desc perform: (Flags at: stream next)].
	stream peek isDigit ifTrue: [desc width: (Integer readFrom: stream)].
	stream peek == $. ifTrue: [stream next. desc precision: (Integer readFrom: stream)].
	stream peek == $l ifTrue: [stream next].
	desc := desc operator: stream next.
	^ desc! !

FormatDescriptor subclass: #CharacterFormatDescriptor
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Printf'!

!CharacterFormatDescriptor methodsFor: 'rendering'!
applyOperator: object
	^ String with: object asCharacter! !


!CharacterFormatDescriptor methodsFor: 'printing'!
printOn: aStream
	super printOn: aStream.
	self printWidthOn: aStream.
	aStream nextPut: $c! !

Object subclass: #FormatString
	instanceVariableNames: 'format string composedString'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Printf'!
!FormatString commentStamp: 'mir 6/7/2000 00:14' prior: 0!
Format description 
	syntax: %{flags}{width}{precision}{long}<operator> 
	
	flags 
		-		left flush 
		+		right flush 
		space	non-negative number are preceeded by a blank 
		#		display integer with a radix indicator (0=octal, 0x=hex, float have .) 
		0		0 is used as left padding character for numbers 
	width		minimum field width (rest is padded) 
	.precision	maximum field width or trailing digits 
	long		ignored 
	operator 
		c		display object as character 
		d		display as integer 
		e,E		float in scientific notation 
		f		display as float 
		g,G		display as f or e,E using least amount of space 
		o		display as octal value 
		s		display as string 
		u		display as unsigned 
		x,X		display as hex value 
	!


!FormatString methodsFor: 'printf'!
<< object 
	"Render object according to next format descriptor in format. 
	Append it to string"
	"Format description 
	syntax: %{flags}{width}{precision}{long}<operator> 
	
	flags 
		-		left flush 
		+		right flush 
		space	non-negative number are preceeded by a blank 
		#		display integer with a radix indicator (0=octal, 0x=hex, float have .) 
		0		0 is used as left padding character for numbers 
	width		minimum field width (rest is padded) 
	.precision	maximum field width or trailing digits 
	long		ignored 
	operator 
		c		display object as character 
		d		display as integer 
		e,E		float in scientific notation 
		f		display as float 
		g,G		display as f or e,E using least amount of space 
		o		display as octal value 
		s		display as string 
		u		display as unsigned 
		x,X		display as hex value 
	"

	composedString nextPutAll: string next.
	composedString nextPutAll: (format next render: object).
	format atEnd
		ifTrue: 
			[format reset.
			composedString nextPutAll: string next.
			string reset].
	^composedString contents! !

!FormatString methodsFor: 'printf' stamp: 'hjo 9/17/2011 23:59'!
printf: arguments 

	"inst var string holds all text contained in the formatstring. %f blabla %d"
	"inst var format is a stream of FormatDescriptors"

	self reset.
 	arguments asArgumentArrayForFormatString do: 
		[:object | 
		"put any text from the formatstring into composedstring"
		composedString nextPutAll: string next. 
		 "get next FormatDescriptor from format and render object as specified"
		format atEnd ifFalse: [composedString nextPutAll: (format next render: object)]].
        "any remainder is string, if so append to composedString"
        string atEnd ifFalse: [composedString nextPutAll: string next].
	 ^self stringWithReset.! !

!FormatString methodsFor: 'printf'!
string
	^composedString contents! !

!FormatString methodsFor: 'printf' stamp: 'hjo 9/17/2011 23:59'!
stringWithReset

	| result |
	result := self string.
	self reset.
	^result! !


!FormatString methodsFor: 'initialize-release' stamp: 'hjo 9/18/2011 00:05'!
collectFormatDescriptorsAndStrings: formatStream

	| done |
	format := ReadWriteStream on: (Array new: 10).
	string := ReadWriteStream on: (Array new: 10).
	done := false.
	[ done ]
		whileFalse: [ 
			"copy actual formatstrings to format"
			string nextPut: (self scanStringFrom: formatStream).
			(done := formatStream atEnd)
				ifFalse: [ 
					"copy any nonformating text to string"
					format nextPut: (FormatDescriptor scanFrom: formatStream) ] ].
	self reset! !

!FormatString methodsFor: 'initialize-release' stamp: 'hjo 9/18/2011 00:05'!
setFormat: aString
	| formatStream |
	"copy actual formatstrings to format"
	"copy any nonformating text to string"
	composedString := (String new: 20) writeStream.
	formatStream := ((aString copyReplaceAll: '\n' with: (String with: Character cr))
		copyReplaceAll: '\t'
		with: (String with: Character tab)) readStream.
	self collectFormatDescriptorsAndStrings: formatStream! !


!FormatString methodsFor: 'private'!
reset
        format reset.
        string reset.
        composedString reset! !

!FormatString methodsFor: 'private' stamp: 'hjo 9/18/2011 00:00'!
scanStringFrom: aStream 
	| newString |
	newString := (String new: 40) writeStream.
	[aStream atEnd]
		whileFalse: 
			[| next | 
			next := aStream next.
			next == $% ifTrue: [^newString contents].
			next == $\
				ifTrue: 
					[next := aStream next.
					next == $n ifTrue: [next := Character cr].
					next == $t ifTrue: [next := Character tab]].
			newString nextPut: next].
	^newString contents! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

FormatString class
	instanceVariableNames: ''!

!FormatString class methodsFor: 'examples' stamp: 'mir 6/7/2000 00:12'!
examples
	self inform: ('Here is a string "%s".' printf: 'hello world').
	self inform: ('Here is a string "%s" and another shortened "%-14.7s".'
		printf: #('hello world' 'hello world')).

	self inform: ('Here is a number "%d".' printf: 42).
	self inform: ('Here is a string "%07.7d".' printf: 42).

	self inform: ('Here is a number "%e".' printf: 42.0).
	self inform: ('Here is a float "%e" and an integer "%d".' printf: #(42.0 42)).
	self inform: ('Here is a string "%013.5e".' printf: 42.1234567).

	self inform: ('Here is a %s string "%s" and the same shortened "%-14.7s" with left flush.\nThe new line has a number "%e" and a 0-padded limited precision one "%013.5e".'
		printf: ((Array with: 'long' with: 'hello world' with: 'hello world' with: 42.0) copyWith: 42.1234567)).! !

TestCase subclass: #FormatStringTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Printf'!

!FormatStringTest methodsFor: 'as yet unclassified' stamp: 'hjo 9/17/2011 23:41'!
testManyArguments

	self assert: 'Here is a long string "hello world" and the same shortened "hello w       " with left flush.
The new line has a number "42.0" and a 0-padded limited precision one "0000042.12345".' equals: ('Here is a %s string "%s" and the same shortened "%-14.7s" with left flush.\nThe new line has a number "%e" and a 0-padded limited precision one "%013.5e".'
		printf: ((Array with: 'long' with: 'hello world' with: 'hello world' with: 42.0) copyWith: 42.1234567)).! !

!FormatStringTest methodsFor: 'as yet unclassified' stamp: 'hjo 9/17/2011 23:41'!
testOneExponent

	self assert: 'Here is a number "42.0".' equals: ('Here is a number "%e".' printf: 42.0).! !

!FormatStringTest methodsFor: 'as yet unclassified' stamp: 'hjo 9/17/2011 23:41'!
testOneExponentAndOneInteger

	self assert: 'Here is a float "42.0" and an integer "42".' equals: ('Here is a float "%e" and an integer "%d".' printf: #(42.0 42)).! !

!FormatStringTest methodsFor: 'as yet unclassified' stamp: 'hjo 9/17/2011 23:41'!
testOneExponentWithLength

	self assert: 'Here is a string "0000042.12345".' equals: ('Here is a string "%013.5e".' printf: 42.1234567).! !

!FormatStringTest methodsFor: 'as yet unclassified' stamp: 'hjo 9/17/2011 23:40'!
testOneInteger

	self assert: 'Here is a number "42".' equals: ('Here is a number "%d".' printf: 42).! !

!FormatStringTest methodsFor: 'as yet unclassified' stamp: 'hjo 9/17/2011 23:40'!
testOneIntegerWithLength

	self assert: 'Here is a string "0000042".' equals: ('Here is a string "%07.7d".' printf: 42).! !

!FormatStringTest methodsFor: 'as yet unclassified' stamp: 'hjo 9/17/2011 23:40'!
testOneString

	self assert: 'Here is a string "hello world".' equals: ('Here is a string "%s".' printf: 'hello world')! !

!FormatStringTest methodsFor: 'as yet unclassified' stamp: 'hjo 9/17/2011 23:40'!
testOneStringWithLength

	self assert:  'Here is a string "hello world" and another shortened "hello w       ".' equals: ('Here is a string "%s" and another shortened "%-14.7s".' printf: #('hello world' 'hello world'))! !

FormatDescriptor subclass: #NumberFormatDescriptor
	instanceVariableNames: 'operator padding radix space'
	classVariableNames: 'Base Radix'
	poolDictionaries: ''
	category: 'Printf'!

!NumberFormatDescriptor methodsFor: 'rendering' stamp: 'mir 6/6/2000 23:56'!
applyOperator: object 
	"Character and Number are the only valid classes"

	| number string |
	object isNil ifTrue: [^'-'].
"object isInteger ifFalse: [self halt].
"	number := object asInteger.
	string := number printStringBase: self base.
	radix ifTrue: [string := self radixString , string].
	(space and: [operator == $d and: [number < 0]])
		ifTrue: [string := ' ' , string].
	^ (width ~= 0 and: [string size > self stringLength])
		ifTrue: [String new: width withAll: $*]
		ifFalse: [string]! !


!NumberFormatDescriptor methodsFor: 'private'!
base
	^ Base at: operator! !

!NumberFormatDescriptor methodsFor: 'private'!
padding
	^ padding! !

!NumberFormatDescriptor methodsFor: 'private'!
radixString
	^ Radix at: operator! !

!NumberFormatDescriptor methodsFor: 'private'!
setOperator: char
	operator := char! !

!NumberFormatDescriptor methodsFor: 'private'!
setPadding: paddingChar
	padding := paddingChar! !

!NumberFormatDescriptor methodsFor: 'private'!
stringLength
	^precision isNil
		ifTrue: [SmallInteger maxVal]
		ifFalse: [precision]! !


!NumberFormatDescriptor methodsFor: 'initialize-release'!
initialize
	super initialize.
	padding := $ .
	radix := false.
	space := false! !


!NumberFormatDescriptor methodsFor: 'printing'!
printOn: aStream
	super printOn: aStream.
	padding == $0 ifTrue: [aStream nextPut: $0].
	radix ifTrue: [aStream nextPut: $#].
	space ifTrue: [aStream nextPut: $ ].
	self printWidthOn: aStream.
	aStream nextPut: operator! !


!NumberFormatDescriptor methodsFor: 'scanning'!
radix
	radix := true! !

!NumberFormatDescriptor methodsFor: 'scanning'!
space
	space := true! !

!NumberFormatDescriptor methodsFor: 'scanning'!
zero
	padding := $0! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

NumberFormatDescriptor class
	instanceVariableNames: ''!

!NumberFormatDescriptor class methodsFor: 'class initialization'!
initialize
	"NumberFormatDescriptor initialize"
	Base := Dictionary new.
	Base at: $d put: 10.
	Base at: $o put: 8.
	Base at: $u put: 10.
	Base at: $x put: 16.
	Base at: $X put: 16.

	Radix := Dictionary new.
	Radix at: $d put: ''.
	Radix at: $o put: '0'.
	Radix at: $u put: ''.
	Radix at: $x put: '0x'.
	Radix at: $X put: '0X'.! !


!NumberFormatDescriptor class methodsFor: 'instance creation'!
newFrom: desc
	desc class == self ifTrue: [^ desc].
	^ (super newFrom: desc) setPadding: desc padding! !

NumberFormatDescriptor subclass: #FloatFormatDescriptor
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Printf'!

!FloatFormatDescriptor methodsFor: 'rendering' stamp: 'hjo 9/18/2011 00:47'!
applyOperator: object 
	"Number is the only valid class"

	| string |
	string := self zeroPaddedStringOfBase10ForFloat: object asFloat.
	string := string copyFrom: 1 to: ((string indexOf: $.) + (precision == 0
						ifTrue: [-1]
						ifFalse: [self precision]) min: string size).
	(space and: [object asFloat >= 0])
		ifTrue: [string := ' ' , string].
	^(width ~= 0 and: [string size > width])
		ifTrue: [String new: width withAll: $*]
		ifFalse: [string]! !

!FloatFormatDescriptor methodsFor: 'rendering' stamp: 'hjo 9/18/2011 00:45'!
zeroPaddedStringOfBase10ForFloat: aFloat 

	| stream |
	stream := String new writeStream.
	aFloat printOn: stream base: 10.
	stream next: self precision-1 put: $0.
	^stream contents.
! !


!FloatFormatDescriptor methodsFor: 'private' stamp: 'mir 6/7/2000 00:01'!
digits
	^ width == 0 ifTrue: [7] ifFalse: [width]! !

!FloatFormatDescriptor methodsFor: 'private'!
precision
	^ precision isNil ifTrue: [1] ifFalse: [precision]! !

!FloatFormatDescriptor methodsFor: 'private'!
stringLength
	^ width! !

FormatDescriptor subclass: #StringFormatDescriptor
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Printf'!

!StringFormatDescriptor methodsFor: 'rendering'!
applyOperator: object
	^ object! !


!StringFormatDescriptor methodsFor: 'printing'!
printOn: aStream
	super printOn: aStream.
	self printWidthOn: aStream.
	aStream nextPut: $s! !

StringFormatDescriptor subclass: #PrintStringFormatDescriptor
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Printf'!

!PrintStringFormatDescriptor methodsFor: 'rendering'!
applyOperator: object
	^ object printLeanString! !


!PrintStringFormatDescriptor methodsFor: 'printing'!
printOn: aStream
	aStream nextPut: $%.
	flush == #leftFlush ifTrue: [aStream nextPut: $-].
	self printWidthOn: aStream.
	aStream nextPut: $p! !

FormatDescriptor initialize!
NumberFormatDescriptor initialize!


More information about the Squeak-dev mailing list