Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv7688
Modified Files: text-formatting.lisp Log Message: FILLING-OUTPUT fixes:
* Very naive and inefficient implementation of STREAM-WRITE-STRING.
* Silenced compiler warning.
--- /project/mcclim/cvsroot/mcclim/text-formatting.lisp 2006/03/29 10:43:37 1.9 +++ /project/mcclim/cvsroot/mcclim/text-formatting.lisp 2008/05/15 16:07:59 1.10 @@ -80,13 +80,17 @@ (encapsulating-stream-stream stream)))) (call-next-method))))
+(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) @@ -94,7 +98,7 @@ ((: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 'filling-stream :stream ,stream @@ -103,8 +107,9 @@ `(: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))) ,@body)) ,@args)))