extensions.st
changeset 3006 1847bcaf8018
parent 3005 36ada1348967
child 3094 4b7e65efd84f
--- a/extensions.st	Sun Jun 16 10:40:06 2013 +0200
+++ b/extensions.st	Thu Jun 20 15:52:11 2013 +0200
@@ -254,6 +254,195 @@
     ^ count
 ! !
 
+!CharacterArray methodsFor:'private'!
+
+printf_printArgFrom:inStream to:outStream withData:argStream
+    "Interpret the required number of arguments from <argStream>
+     according to the formatting information in <inStream>.
+     Place the interpretation on <outStream>.
+     The interpretation is C printf(3) style, as
+     specified in the Unix C-language manual page for printf(3).
+     <inStream> is assumed to be positioned just past
+     $%, and a complete control string is assumed available.
+
+     Return when the conversion control string is consumed.
+     Leave <inStream> pointing past the last character in the conversion control string.
+
+     This code assumes that <inStream> is formatted according to
+     specification, and error checking is minimal.  Unexpected
+     results will be obtained by illegal control strings, or when
+     argument types do not match conversion codes, but it probably
+     won't dump core, like C does in such cases!!
+
+     For copyright information, see goodies/String-printf_scanf.chg"
+
+    |nextArg ljust plus pound width precision pad char arg argString|
+
+    nextArg := [
+                    argStream atEnd ifTrue:[
+                        self error:'not enough arguments for format string'
+                    ].
+                    argStream next
+               ].
+
+    ljust := plus := pound := false.
+    width := 0.
+    precision := SmallInteger maxVal.
+    pad := $ .
+    char := inStream peek.
+    char == $% ifTrue:[
+        ^ outStream nextPut:inStream next
+    ].
+    char == $- ifTrue:[
+        ljust := true.
+        inStream next.
+        char := inStream peek
+    ].
+    char == $  ifTrue:[
+        outStream space.
+        inStream next.
+        char := inStream peek
+    ].
+    char == $+ ifTrue:[
+        plus := true.
+        inStream next.
+        char := inStream peek
+    ].
+    char == $# ifTrue:[
+        pound := true.
+        inStream next.
+        char := inStream peek
+    ].
+    char == $* ifTrue:[
+        width := nextArg value.
+        inStream next.
+        char := inStream peek
+    ].
+    char isDigit ifTrue:[
+        char == $0 ifTrue:[
+            pad := $0
+        ].
+        width := Integer readFrom:inStream.
+        char := inStream peek
+    ].
+    char == $. ifTrue:[
+        inStream next.
+        char := inStream peek.
+        char == $* ifTrue:[
+            precision := nextArg value.
+            inStream next.
+        ] ifFalse:[
+            precision := Integer readFrom:inStream.
+        ].
+        char := inStream peek
+    ].
+    char == $l "Ignore long specifier." ifTrue:[
+        inStream next.
+        char := inStream peek
+    ].
+    ('feg' includes:char) ifTrue:[
+        arg := nextArg value asFloat.
+        precision := precision min:6.
+        argString := WriteStream on:String new.
+        char == $g ifTrue:[
+            arg absPrintOn:argString digits:precision + 1
+        ].
+        char == $f ifTrue:[
+            arg absDecimalPrintOn:argString digits:precision + arg abs log + 1
+        ].
+        char == $e ifTrue:[
+            arg absScientificPrintOn:argString digits:precision + 1
+        ].
+        argString := argString contents.
+        arg < 0 ifTrue:[
+            argString := '-' , argString
+        ] ifFalse:[
+            plus ifTrue:[
+                argString := '+' , argString
+            ]
+        ].
+        (precision = 0 and:[ pound not ]) ifTrue:[
+            (argString includes:$e) ifTrue:[
+                "self halt"
+            ] ifFalse:[
+                argString := arg truncated printString
+            ]
+        ].
+        pound ifTrue:[
+            (argString includes:$e) ifTrue:[
+                "self halt"
+            ] ifFalse:[
+                precision - (argString size - (argString indexOf:$.)) timesRepeat:[
+                    argString := argString , '0'
+                ]
+            ]
+        ].
+        ljust ifTrue:[
+            outStream nextPutAll:argString
+        ].
+        width - argString size timesRepeat:[
+            outStream space
+        ].
+        ljust ifFalse:[
+            outStream nextPutAll:argString
+        ].
+        ^ inStream next
+    ].
+    char == $c ifTrue:[
+        arg := String with:nextArg value asCharacter
+    ].
+    char == $s "Assume the arg is a String or Symbol." ifTrue:[
+        arg := nextArg value asString
+    ].
+    char == $d ifTrue:[
+        arg := nextArg value asInteger printString.
+        plus ifTrue:[
+            arg := '+' , arg
+        ]
+    ].
+    char == $u ifTrue:[
+        arg := nextArg value asInteger abs printString
+    ].
+    char == $o ifTrue:[
+        arg := nextArg value asInteger abs printStringRadix:8.
+        pound ifTrue:[
+            arg := '0' , arg
+        ]
+    ].
+    char == $b ifTrue:[
+        arg := nextArg value asInteger abs printStringRadix:2.
+        pound ifTrue:[
+            arg := '0' , arg
+        ]
+    ].
+    ('xX' includes:char) ifTrue:[
+        arg := nextArg value asInteger abs printStringRadix:16.
+        pound ifTrue:[
+            arg := '0x' , arg
+        ]
+    ].
+    char == $x ifTrue:[
+        1 to:arg size do:[:i |
+            ('ABCDEF' includes:(arg at:i)) ifTrue:[
+                arg at:i put:((arg at:i) asciiValue + 16r20) asCharacter
+            ]
+        ]
+    ].
+    precision := precision min:arg size.
+    ljust ifTrue:[
+        outStream nextPutAll:(arg copyFrom:1 to:precision)
+    ].
+    width - precision timesRepeat:[
+        outStream nextPut:pad
+    ].
+    ljust ifFalse:[
+        outStream nextPutAll:(arg copyFrom:1 to:precision)
+    ].
+    ^ inStream next
+
+    "Modified: / 24-07-2011 / 07:16:42 / cg"
+! !
+
 !CharacterArray methodsFor:'printing & storing'!
 
 printf_printOn:outStream withData:args
@@ -1071,5 +1260,6 @@
 !stx_libbasic2 class methodsFor:'documentation'!
 
 extensionsVersion_CVS
-    ^ '$Header: /cvs/stx/stx/libbasic2/extensions.st,v 1.24 2013-06-16 08:40:06 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic2/extensions.st,v 1.25 2013-06-20 13:52:11 vrany Exp $'
 ! !
+