[climacs-cvs] CVS climacs

[thenriksen]

Update of /project/climacs/cvsroot/climacs
In directory clnet:/tmp/cvs-serv8457

Modified Files:
	io.lisp 
Log Message:
Signal an error when trying to save a buffer that contains a
non-character.


--- /project/climacs/cvsroot/climacs/io.lisp	2006/09/09 18:21:02	1.8
+++ /project/climacs/cvsroot/climacs/io.lisp	2008/01/13 22:23:00	1.9
@@ -24,9 +24,31 @@
 
 (in-package :climacs-core)
 
+(define-condition buffer-contains-noncharacter (buffer-writing-error)
+  ()
+  (:report (lambda (condition stream)
+             (format stream "Buffer ~A contains non-character object"
+                     (name (buffer condition)))))
+  (:documentation "This error is signalled whenever an attempt is
+made to save a buffer that contains a non-character object."))
+
+(defun buffer-contains-noncharacter (buffer filepath)
+  "Signal an error of type `buffer-contains-noncharacter' with
+the buffer `buffer' and the filepath `filepath'."
+  (error 'buffer-contains-noncharacter :buffer buffer :filepath filepath))
+
+(defmethod check-buffer-writability ((application-frame climacs) (filepath pathname)
+                                     (buffer drei-buffer))
+  (do-buffer-region (object offset buffer 0 (size buffer))
+    (unless (characterp object)
+      (buffer-contains-noncharacter buffer filepath)))
+  (call-next-method))
+
 (defmethod frame-save-buffer-to-stream ((application-frame climacs) (buffer climacs-buffer) stream)
   (let ((seq (buffer-sequence buffer 0 (size buffer))))
-    (write-sequence seq stream)))
+    (if (every #'characterp seq)
+        (write-sequence seq stream)
+        (display-message "Cannot save to file, buffer contains non-character object"))))
 
 (defun input-from-stream (stream buffer offset)
   (let* ((seq (make-string (file-length stream)))