Browse files


* Very naive and inefficient implementation of STREAM-WRITE-STRING.

* Silenced compiler warning.
  • Loading branch information...
1 parent 091be68 commit e1f72b546be9fe7a46810240c362866cb15c1e43 Troels Henriksen committed May 15, 2008
Showing with 9 additions and 4 deletions.
  1. +9 −4 text-formatting.lisp
@@ -80,21 +80,25 @@ SUPPRESS-SPACE-AFTER-CONJUNCTION are non-standard."
(encapsulating-stream-stream stream))))
+(defmethod stream-write-string :around ((stream filling-stream) string
+ &optional (start 0) (end (length string)))
+ (dotimes (i (- end start))
+ (stream-write-char stream (aref string (+ i start)))))
;;; All the monkey business with the lambda form has to do with capturing the
;;; keyword arguments of the macro while preserving the user's evaluation order.
(defmacro filling-output ((stream &rest args &key fill-width break-characters
after-line-break after-line-break-initially)
&body body)
- (declare (ignore after-line-break-initially))
(when (eq stream t)
(setq stream '*standard-output*))
(with-gensyms (fill-var break-var after-var initially-var)
`((lambda (&key ((:fill-width ,fill-var))
((:break-characters ,break-var))
((:after-line-break ,after-var))
((:after-line-break-initially ,initially-var)))
- (declare (ignorable ,fill-var ,break-var ,after-var))
+ (declare (ignorable ,fill-var ,break-var ,after-var ,initially-var))
(let ((,stream (make-instance
:stream ,stream
@@ -103,8 +107,9 @@ SUPPRESS-SPACE-AFTER-CONJUNCTION are non-standard."
`(:break-characters ,break-var))
,@(and after-line-break
`(:after-line-break ,after-var)))))
- (when ,initially-var
- (write-string ,after-var ,stream))
+ ,(unless (null after-line-break-initially)
+ `(when ,initially-var
+ (write-string ,after-var ,stream)))

0 comments on commit e1f72b5

Please sign in to comment.