generally expand into additional text to be output, usually consuming one
or more of the FORMAT-ARGUMENTS in the process. A few useful directives
are:
- ~A or ~nA Prints one argument as if by PRINC
- ~S or ~nS Prints one argument as if by PRIN1
- ~D or ~nD Prints one argument as a decimal integer
- ~% Does a TERPRI
- ~& Does a FRESH-LINE
-
- where n is the width of the field in which the object is printed.
+ ~A or ~nA Prints one argument as if by PRINC
+ ~S or ~nS Prints one argument as if by PRIN1
+ ~D or ~nD Prints one argument as a decimal integer
+ ~% Does a TERPRI
+ ~& Does a FRESH-LINE
+ where n is the width of the field in which the object is printed.
DESTINATION controls where the result will go. If DESTINATION is T, then
the output is sent to the standard output stream. If it is NIL, then the
(defun ,defun-name (stream ,directive ,directives orig-args args)
(declare (ignorable stream orig-args args))
,@(if lambda-list
- `((let ,(mapcar #'(lambda (var)
- `(,var
- (,(intern (concatenate
- 'string
- "FORMAT-DIRECTIVE-"
- (symbol-name var))
- (symbol-package 'foo))
- ,directive)))
+ `((let ,(mapcar (lambda (var)
+ `(,var
+ (,(symbolicate "FORMAT-DIRECTIVE-" var)
+ ,directive)))
(butlast lambda-list))
(values (progn ,@body) args)))
`((declare (ignore ,directive ,directives))
(when ,params
(error 'format-error
:complaint
- "too many parameters, expected no more than ~D"
+ "too many parameters, expected no more than ~W"
:arguments (list ,(length specs))
:offset (caar ,params)))
,@body))))
(write-string string stream))
(dotimes (i minpad)
(write-char padchar stream))
- (do ((chars (+ (length string) minpad) (+ chars colinc)))
- ((>= chars mincol))
- (dotimes (i colinc)
- (write-char padchar stream)))
+ ;; As of sbcl-0.6.12.34, we could end up here when someone tries to
+ ;; print e.g. (FORMAT T "~F" "NOTFLOAT"), in which case ANSI says
+ ;; we're supposed to soldier on bravely, and so we have to deal with
+ ;; the unsupplied-MINCOL-and-COLINC case without blowing up.
+ (when (and mincol colinc)
+ (do ((chars (+ (length string) minpad) (+ chars colinc)))
+ ((>= chars mincol))
+ (dotimes (i colinc)
+ (write-char padchar stream))))
(when padleft
(write-string string stream)))
(cond (name
(write-string (string-capitalize name) stream))
((<= 0 (char-code char) 31)
- ;; Print control characters as "^"<char>
+ ;; Print control characters as "^"<char>. (This seems to be
+ ;; old pre-ANSI behavior, but ANSI just says that the "#^"
+ ;; sequence is undefined and not reserved for the user, so
+ ;; this behavior should be ANSI-compliant.)
(write-char #\^ stream)
(write-char (code-char (+ 64 (char-code char))) stream))
(t
(if (<= 0 posn (length orig-args))
(setf args (nthcdr posn orig-args))
(error 'format-error
- :complaint "Index ~D is out of bounds. (It should ~
- have been between 0 and ~D.)"
+ :complaint "Index ~W is out of bounds. (It should ~
+ have been between 0 and ~W.)"
:arguments (list posn (length orig-args))))))
(if colonp
(interpret-bind-defaults ((n 1)) params
(setf args (nthcdr new-posn orig-args))
(error 'format-error
:complaint
- "Index ~D is out of bounds. (It should
- have been between 0 and ~D.)"
+ "Index ~W is out of bounds. (It should
+ have been between 0 and ~W.)"
:arguments
(list new-posn (length orig-args))))))))
(interpret-bind-defaults ((n 1)) params
(interpret-bind-defaults () params
(handler-bind
((format-error
- #'(lambda (condition)
- (error 'format-error
- :complaint
- "~A~%while processing indirect format string:"
- :arguments (list condition)
- :print-banner nil
- :control-string string
- :offset (1- end)))))
+ (lambda (condition)
+ (error 'format-error
+ :complaint
+ "~A~%while processing indirect format string:"
+ :arguments (list condition)
+ :print-banner nil
+ :control-string string
+ :offset (1- end)))))
(if atsignp
(setf args (%format stream (next-arg) orig-args args))
(%format stream (next-arg) (next-arg))))))
(if (zerop posn)
(handler-bind
((format-error
- #'(lambda (condition)
- (error 'format-error
- :complaint
+ (lambda (condition)
+ (error
+ 'format-error
+ :complaint
"~A~%while processing indirect format string:"
- :arguments (list condition)
- :print-banner nil
- :control-string string
- :offset (1- end)))))
+ :arguments (list condition)
+ :print-banner nil
+ :control-string string
+ :offset (1- end)))))
(%format stream insides orig-args args))
(interpret-directive-list stream insides
orig-args args)))
(if per-line-p
(pprint-logical-block
(stream arg :per-line-prefix prefix :suffix suffix)
- (let ((*logical-block-popper* #'(lambda () (pprint-pop))))
+ (let ((*logical-block-popper* (lambda () (pprint-pop))))
(catch 'up-and-out
(interpret-directive-list stream insides
(if atsignp orig-args arg)
arg))))
(pprint-logical-block (stream arg :prefix prefix :suffix suffix)
- (let ((*logical-block-popper* #'(lambda () (pprint-pop))))
+ (let ((*logical-block-popper* (lambda () (pprint-pop))))
(catch 'up-and-out
(interpret-directive-list stream insides
(if atsignp orig-args arg)
;;;; format interpreter and support functions for user-defined method
(def-format-interpreter #\/ (string start end colonp atsignp params)
- (let ((symbol (extract-user-function-name string start end)))
+ (let ((symbol (extract-user-fun-name string start end)))
(collect ((args))
(dolist (param-and-offset params)
(let ((param (cdr param-and-offset)))
projects / sbcl.git / blobdiff