[mcclim-cvs] CVS mcclim

[thenriksen]

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)))
 	  , at body))
       , at args)))