X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/blobdiff_plain/57bd0aa52bf40d9d0a002d874ba7eb8efa1fef5a..203681e230fc5783f54dabe79d765f4c4cec0351:/cairo/cairo.lisp

diff --git a/cairo/cairo.lisp b/cairo/cairo.lisp
index 8c73924..8e72a06 100644
--- a/cairo/cairo.lisp
+++ b/cairo/cairo.lisp
@@ -20,7 +20,7 @@
 ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
 ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 
-;; $Id: cairo.lisp,v 1.24 2008-11-28 19:26:04 espen Exp $
+;; $Id: cairo.lisp,v 1.25 2009-02-09 11:45:03 espen Exp $
 
 (in-package "CAIRO")
 
@@ -828,7 +828,7 @@ (defbinding %surface-destroy () nil
 (defbinding %surface-status () status
   pointer)
 
-(defmethod allocate-foreign :around ((surface image-surface) &key)
+(defmethod allocate-foreign :around ((surface surface) &key)
   (let ((location (call-next-method)))
     (cond
       ((not (eq (%surface-status location) :success))
@@ -926,20 +926,21 @@ (define-callback stream-write-func status
     :write-error))
 
 (defun %stream-read-func (stream-id data length)
-  (let* ((stream (find-user-data stream-id))
-	 (sequence (make-array length :element-type '(unsigned-byte 8)))
-	 (bytes-read 
-	  (handler-case (etypecase stream
-			  (stream 
-			   (read-sequence sequence stream))
-			  ((or symbol function) 
-			   (funcall stream sequence)))
-	    (serious-condition (condition)
-	      (declare (ignore condition))
-	      0))))
-    (make-c-vector '(unsigned-byte 8) bytes-read 
-     :content sequence :location data)
-    bytes-read))
+  (let* ((stream (find-user-data stream-id)))
+    (handler-case                              
+        (multiple-value-bind (sequence bytes-read)
+            (etypecase stream
+              (stream
+               (let ((sequence (make-array length
+                                :element-type '(unsigned-byte 8))))
+                 (values sequence (read-sequence sequence stream))))
+              ((or symbol function) (funcall stream length)))
+          (make-c-vector '(unsigned-byte 8) (or bytes-read (length sequence))
+           :content sequence :location data)
+          (or bytes-read (length sequence)))
+      (serious-condition (condition)
+        (declare (ignore condition))
+        0))))
 
 (define-callback stream-read-func status 
     ((stream-id pointer-data) (data pointer) (length unsigned-int))
@@ -957,7 +958,8 @@ (defmacro with-surface ((surface cr) &body body)
 (defmethod allocate-foreign ((surface image-surface) &key source type
 			     width height stride format)
   (etypecase source
-   (stream
+   (null (%image-surface-create format width height))
+   ((or stream function symbol)
     (let ((stream-id (register-user-data source)))
       (unwind-protect
 	   (cond
@@ -978,8 +980,7 @@ (defmethod allocate-foreign ((surface image-surface) &key source type
       ((error "Can't handle image type ~A" type))))
    (pointer
     (%image-surface-create-for-data source format width height 
-     (or stride (format-stride-for-width format width))))
-   (null (%image-surface-create format width height))))
+     (or stride (format-stride-for-width format width))))))
 
 #?(pkg-exists-p "cairo" :atleast-version "1.6")
 (defbinding format-stride-for-width () int