Hi.
The current uploaded draft is old one.
I submitted several revised proposals before drafting, but there was no
response. (I have heard that Solsona had some problems with his machine.)
The following is my last revised proposal.

Title

Formatting

Author

Joo ChurlSoo

Abstract

This SRFI introduces the FMT procedure that converts any object to a string.
Unlike the procedure called FORMAT, this FMT procedure takes one object as the
first argument and accepts several optional arguments.

Rationale

The FMT procedure provides a handy optional and functional interface.

Specification

(FMT <number> [[<width>] [<depth>] [<char>] [<radix>] [<plus>] [<exactness>]
	       [<space>] [<string>] ...])
(FMT <others> [[<width>] [<count>] [<char>] [<show>] [<case>] [<space>]
	       [<string>] ...])

     * <number> is any numeric expression.
     * <others> are any expressions except number.
     * <width> is an exact integer whose absolute value specifies the width of
       the resulting string.  When the resulting string has fewer characters
       than the absolute value of <width>, it is padded with <char>s, either
       on the left if <width> is positive, or on the right if <width> is
       negative.  On the other hand, when the resulting string has more
       characters than the absolute value of <width>, the <width> is ignored.
     * <depth> is a non-negative exact integer that specifies the number of
       decimal digits after decimal point.
     * <count> is a non-negative exact integer that specifies the number of
       characters of the resulting string.
     * <char> is a padding character.
     * <radix> is a symbol: b (binary), d (decimal), o (octal), x (hexadecimal)
     * <show> is a procedure: display, write
     * If <plus> is a procedure + and <number> is a positive number without a
       positive sign, the positive sign is prefixed to the <number>.
     * <case> is a symbol: u (upcase), d (downcase), t (titlecase)
     * <exactness> is a symbol: e (exact), i (inexact)
     * <space> is a list whose elements are non-negative exact integer, and
       the number of elements of the list is 1 or 2.  The resulting string is
       padded with space character on the left as much as the value of the
       first element and on the right as much as th value of the second
       element regardless of <width>.
     * <string>s are strings that are appended to the resulting string.

The order of optional arguments is ignored except that <depth> or <count> can
be defined only after <width> is defined.

Examples

(fmt 129.995)				"129.995"
(fmt 129.995 '(2))			"  129.995"
(fmt 129.995 '(1 1))			" 129.995 "
(fmt 129.995 10 2)			"    130.00"
(fmt 129.995 -10 2)			"130.00    "
(fmt 129.995  10 #\0 2)			"0000130.00"
(fmt 129.995 #\0 10 + 2)		"+000130.00"
(fmt 129.995  #\0 10 + 2 'o 'e)		error
(fmt 129.995  #\0 10 + 'o 'e)		"+000000202"
(fmt 129.995  #\0 10 + 'o 'e '(1 2))	" +000202  "
(fmt 129.995  '(1) #\0 10 + 'o 'e)	" +00000202"
(fmt (sqrt -5) 10)			"0.0+2.23606797749979i"
(fmt (sqrt -5) 10 2)			"0.00+2.24i"
(fmt 3.14159e12 10 2 +)			"  +3.14e12"
(fmt #x123 'o 10)			"       443"
(fmt #x123 -10 3 + #\*)			"+291.000**"
(fmt "string"  10)			"    string"
(fmt "string"  '(1 1))			" string "
(fmt "string" -10 '(1 2))		" string   "
(fmt "The number is 3." 't 10)		"The Number Is 3."
(fmt "The number is 3." 'u '(1))	" THE NUMBER IS 3."
(fmt "string"  -10 write)		"\"string\"  "
(fmt "string" 10 3)			"       str"
(fmt "string" -10 3)			"str       "
(fmt "string" #\- -10 3)		"str-------"
(fmt #\a write)				"#\\a"
(fmt #\a display)			"a"
(fmt #\a 10)				"         a"
(fmt 'symbol 10)			"    symbol"
(fmt '(1 #\a "str" sym '(a)) write)	"(1 #\\a \"str\" sym (quote (a)))"
(fmt '(1 #\a "str" sym '(a)))		"(1 a str sym (quote (a)))"
(fmt '(1 #\a "str" sym '(a)) 10)	"(1 a str sym (quote (a)))"
(fmt '(1 #\a "str" sym '(a)) 10 10)	"(1 a str s"
(fmt #(1 #\a "str" sym '(a)) 10)	"#(1 a str sym (quote (a)))"
(fmt #(1 #\a "str" sym '(a)) 10 write)	"#(1 #\\a \"str\" sym (quote (a)))"
(fmt 123 "is an integer." + 0 2 '(0 1))	"+123.00 is an integer."
(fmt "this" 't (fmt "is" '(1 1)) "A.")	"This is A."

Implementation

The implementation below requires SRFI-1 (List library), SRFI-6 (Basic string
ports), SRFI-8 (Receive), SRFI-13 (String library), and SRFI-23 (Error
reporting mechanism).

(define (opt-values rest-list . default-list)
  (let loop ((rest-list rest-list)
	     (default-list default-list)
	     (result '()))
    (if (null? default-list)
	(apply values (append (reverse result) rest-list))
	(let ((default (car default-list)))
	  (let lp ((rest rest-list)
		   (head '()))
	    (if (null? rest)
		(loop (reverse head)
		      (cdr default-list)
		      (cons (car default) result))
		(if (list? default)
		    (if (member (car rest) default)
			(loop (append (reverse head) (cdr rest))
			      (cdr default-list)
			      (cons (car rest) result))
			(lp (cdr rest) (cons (car rest) head)))
		    (if ((cdr default) (car rest))
			(loop (append (reverse head) (cdr rest))
			      (cdr default-list)
			      (cons (car rest) result))
			(lp (cdr rest) (cons (car rest) head))))))))))

(define-syntax arg-or
  (syntax-rules()
    ((arg-or arg (a1 a2 ...) ...)
     (or (and (not (symbol? 'arg))
	      (error "bad syntax" 'arg '(symbol? 'arg)
		     '(arg-or arg (a1 a2 ...) ...)))
	 (and (a1 a2 ...)
	      (error "incorrect argument" arg 'arg '(a1 a2 ...)))
	 ...))
    ((arg-or caller arg (a1 a2 ...) ...)
     (or (and (not (symbol? 'arg))
	      (error "bad syntax" 'arg '(symbol? 'arg)
		     '(arg-or caller arg (a1 a2 ...) ...)))
	 (and (a1 a2 ...)
	      (if (string? caller)
		  (error caller arg 'arg '(a1 a2 ...))
		  (error "incorrect argument" arg 'arg '(a1 a2 ...) caller)))
	 ...))))

;; accessory macro for arg-ors
(define-syntax caller-arg-or
  (syntax-rules()
    ((caller-arg-or caller arg (a1 a2 ...) ...)
     (or (and (not (symbol? 'arg))
	      (error "bad syntax" 'arg '(symbol? 'arg)
		     '(caller-arg-or caller arg (a1 a2 ...) ...)))
	 (and (a1 a2 ...)
	      (if (string? caller)
		  (error caller arg 'arg '(a1 a2 ...))
		  (error "incorrect argument" arg 'arg '(a1 a2 ...) caller)))
	 ...))
    ((caller-arg-or null caller arg (a1 a2 ...) ...)
     (or (and (not (symbol? 'arg))
	      (error "bad syntax" 'arg '(symbol? 'arg)
		     '(caller-arg-or caller arg (a1 a2 ...) ...)))
	 (and (a1 a2 ...)
	      (if (string? caller)
		  (error caller arg 'arg '(a1 a2 ...))
		  (error "incorrect argument" arg 'arg '(a1 a2 ...) caller)))
	 ...))))

(define-syntax arg-ors
  (syntax-rules (common)
    ((arg-ors (a1 a2 ...) ...)
     (or (arg-or a1 a2 ...) ...))
    ((arg-ors common caller (a1 a2 ...) ...)
     (or (caller-arg-or caller a1 a2 ...) ...))))

(define (fmt expr . rest)
  (if (number? expr)
      (receive (width depth char radix plus exactness space . str-list)
	  (opt-values rest
		      (cons #f (lambda (x) (and (integer? x) (exact? x))))
		      (cons #f (lambda (x)
				 (and (integer? x) (exact? x) (<= 0 x))))
		      (cons #f char?)
		      (list 'd 'b 'o 'x)
		      (cons #f (lambda (x) (eq? x +)))
		      (cons #f (lambda (x) (memq x '(e i))))
		      (cons #f (lambda (x)
				 (and (list? x)
				      (<= 1 (length x) 2)
				      (every (lambda (x)
					       (and (integer? x)
						    (exact? x)
						    (<= 0 x)))
					     x)))))
	(arg-ors ("fmt: bad argument"  str-list
		  (not (every string? str-list)))
		 ("fmt: non-decimal cannot be inexact" radix
		  (and (memq radix '(b o x))
		       (or depth
			   (and (inexact? expr) (not (eq? exactness 'e)))
			   (eq? exactness 'i))))
		 ("fmt: exact number cannot have a decimal point" depth
		  (and depth (eq? exactness 'e)))
		 ("fmt: unnecessary padding character" char
		  (and char (not width))))
	(let* ((width (or width 0))
	       (char (or char #\space))
	       (sign (if (< width 0) '- '+))
	       (str (number->string
		     (if exactness
			 (if (eq? exactness 'e)
			     (if (inexact? expr) (inexact->exact expr) expr)
			     (if (exact? expr) (exact->inexact expr) expr))
			 (if (and depth (exact? expr))
			     (exact->inexact expr)
			     expr))
		     (cdr (assq radix '((b . 2) (d . 10) (o . 8) (x . 16))))))
	       (str
		(if depth
		    (let ((e-index (or (string-index str #\e)
				       (string-index str #\E)))
			  (+-index (string-index str #\+ 1)))
		      (define (mold str dep)
			(let ((len (string-length str))
			      (index (string-index str #\.)))
			  (if index
			      (let ((d-len (- len index 1)))
				(if (<= d-len dep)
				    (string-append str
						   (make-string (- dep d-len)
								#\0))
				    (mold (number->string
					   (+ (string->number
					       (substring str 0
							  (+ (if (= dep 0) 0 1)
							     index dep)))
					      (if (< 4 (string->number
							(string
							 (string-ref
							  str
							  (+ 1 index dep)))))
						  (expt 0.1 dep) 0)))
					  dep)))
			      (string-append str "." (make-string dep #\0)))))
		      (cond
		       (e-index
			(string-append (mold (substring str 0 e-index) depth)
				       (substring str e-index
						  (string-length str))))
		       (+-index
			(string-append (mold (substring str 0 +-index) depth)
				       "+"
				       (mold (substring str (+ 1 +-index)
							(- (string-length str)
							   1)) depth)
				       (string (string-ref
						str
						(- (string-length str) 1)))))
		       (else
			(mold str depth))))
		    str))
	       (str (if (and (< 0 (real-part expr))
			     (not (eqv? #\+ (string-ref str 0)))
			     plus)
			(string-append "+" str)
			str))
	       (len (string-length str))
	       (lt (if space (car space) 0))
	       (rt (if (and space (not (null? (cdr space)))) (cadr space) 0))
	       (pad (- (abs width) len lt rt)))
	  (apply string-append
		 (make-string lt #\space)
		 (cond
		  ((<= pad 0) str)
		  ((eq? sign '+)
		   (if (and (eqv? char #\0)
			    (or (eqv? #\+ (string-ref str 0))
				(eqv? #\- (string-ref str 0))))
		       (string-append (string (string-ref str 0))
				      (make-string pad char)
				      (substring str 1 len))
		       (string-append (make-string pad char) str)))
		  (else
		   (string-append str (make-string pad char))))
		 (make-string rt #\space)
		 str-list)))
      (receive (width depth char show case space . str-list)
	  (opt-values rest
		      (cons #f (lambda (x) (and (integer? x) (exact? x))))
		      (cons #f (lambda (x)
				 (and (integer? x) (exact? x) (<= 0 x))))
		      (cons #f char?)
		      (list display write)
		      (cons #f (lambda (x) (memq x '(d u t))))
		      (cons #f (lambda (x)
				 (and (list? x)
				      (<= 1 (length x) 2)
				      (every (lambda (x)
					       (and (integer? x)
						    (exact? x)
						    (<= 0 x)))
					     x)))))
	(arg-ors ("fmt: bad argument" str-list
		  (not (every string? str-list)))
		 ("fmt: unnecessary padding character" char
		  (and char (not width))))
	(let* ((width (or width 0))
	       (char (or char #\space))
	       (sign (if (< width 0) '- '+))
	       (str (get-output-string
		     (let ((str-port (open-output-string)))
		       (show expr str-port)
		       str-port)))
	       (str (if (and depth (< depth (string-length str)))
			(substring str 0 depth)
			str))
	       (str (if case
			((cdr (assq case `((d . ,string-downcase)
					   (u . ,string-upcase)
					   (t . ,string-titlecase)))) str)
			str))
	       (lt (if space (car space) 0))
	       (rt (if (and space (not (null? (cdr space)))) (cadr space) 0))
	       (pad (- (abs width) (string-length str) lt rt)))
	  (apply string-append
		 (make-string lt #\space)
		 (cond
		  ((<= pad 0) str)
		  ((eq? sign '+) (string-append (make-string pad char) str))
		  (else (string-append str (make-string pad char))))
		 (make-string rt #\space)
		 str-list)))))

Copyright

Copyright (C) Joo ChurlSoo (2004). All Rights Reserved.

This document and translations of it may be copied and furnished to others, and
derivative works that comment on or otherwise explain it or assist in its
implementation may be prepared, copied, published and distributed, in whole or
in part, without restriction of any kind, provided that the above copyright
notice and this paragraph are included on all such copies and derivative works.
However, this document itself may not be modified in any way, such as by
removing the copyright notice or references to the Scheme Request For
Implementation process or editors, except as needed for the purpose of
developing SRFIs in which case the procedures for copyrights defined in the
SRFI process must be followed, or as required to translate it into languages
other than English.

The limited permissions granted above are perpetual and will not be revoked by
the authors or their successors or assigns.

This document and the information contained herein is provided on an "AS IS"
basis and THE AUTHOR AND THE SRFI EDITORS DISCLAIM ALL WARRANTIES, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO ANY WARRANTY THAT THE USE OF THE
INFORMATION HEREIN WILL NOT INFRINGE ANY RIGHTS OR ANY IMPLIED WARRANTIES OF
MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE.

A Note:
I am on neither "format strings are wrong" side nor "format strings are right"
side, and indeed have no knowledge to infer it.  I am only a Scheme consumer.
I've used FORMAT because of its functions such as left and right padding of
numbers or strings and expressing the precision of number.  As I thought the
function of the current SRFI's FORMAT was a little insufficient (such as right
padding), and the `former' side had not provided a real thing for Scheme
users, I submitted this proposal.
While defining the new procedure (FMT), I felt that the problem was handling
its optional arguments, and REST-VALUES (a prodecure in SRFI-51 that I had
submitted) was insufficient and inappropriate.  So I appended the third mode
of operation to the function of REST-VALUES, and submitted the revised SRFI-51
to SRFI editors.  If the revised SRFI-51 is finalized, I'll substitute
REST-VALUES for OPT-VALUES which is a temporary and accessory procedure for
handling rest list (optional arguments).

Thanks.
--
INITTERM