chiark / gitweb /
Work around for broken def-type-method
[clg] / cairo / cairo.lisp
index ea493f4d1ae0de9e0fbd176aec58f1430578530e..9baed3ac7aef76c3b518075ee9a55a15b590396e 100644 (file)
@@ -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.1 2005-11-10 08:50:45 espen Exp $
+;; $Id: cairo.lisp,v 1.5 2006-02-09 22:30:39 espen Exp $
 
 (in-package "CAIRO")
 
@@ -52,7 +52,7 @@   (define-enum-type subpixel-order :default :rgb :bgr :vrgb :vbgr)
   (define-enum-type hint-style :default :none :slight :medium :full)
   (define-enum-type hint-metrics :default :off :on)
 
-  (defclass glyph (proxy)
+  (defclass glyph (struct)
     ((index 
       :allocation :alien 
       :initarg :index 
@@ -339,7 +339,7 @@        (defun ,name (cr &optional preserve)
             (,pname cr)
           (,iname cr)))
        ,(unless clip-p
-         (let ((tname (intern (format nil "IN~A-P" name)))
+         (let ((tname (intern (format nil "IN-~A-P" name)))
                (ename (intern (format nil "~A-EXTENTS" name))))
            `(progn
               (defbinding ,tname () boolean
@@ -631,11 +631,8 @@ (defbinding %scaled-font-create () pointer
   (ctm matrix)
   (options font-options))
 
-(defmethod initialize-instance ((scaled-font scaled-font) &key font-face font-matrix cmt options)
-  (setf
-   (slot-value scaled-font 'location)
-   (%scaled-font-create font-face font-matrix cmt options))
-  (call-next-method))
+(defmethod allocate-foreign ((scaled-font scaled-font) &key font-face font-matrix cmt options)
+  (%scaled-font-create font-face font-matrix cmt options))
 
 
 
@@ -649,7 +646,7 @@ (defbinding %font-options-destroy () nil
   (location pointer))
 
 (defmethod reference-foreign ((class (eql (find-class 'font-options))) location)
-  (%font-options-reference location))
+  (%font-options-copy location))
 
 (defmethod unreference-foreign ((class (eql (find-class 'font-options))) location)
   (%font-options-destroy location))
@@ -659,10 +656,9 @@ (defbinding font-options-status () status
 
 (defbinding %font-options-create () pointer)
 
-(defmethod initialize-instance ((font-options font-options) &rest initargs)
+(defmethod allocate-foreign ((font-options font-options) &rest initargs)
   (declare (ignore initargs))
-  (setf (slot-value font-options 'location) (%font-options-create))
-  (call-next-method))
+  (%font-options-create))
 
 (defbinding font-options-merge () nil
   (options1 font-options :return)
@@ -735,18 +731,15 @@ (defun surface-mark-dirty (surface &optional x y width height)
 ;; Image Surface
 
 ;; Should data be automatically freed when the surface is GCed?
-(defmethod initialize-instance ((surface image-surface) 
-                               &key width height stride format data)
-  (setf 
-   (slot-value surface 'location)
-   (if (not data)
-       (%image-surface-create format width height)
-     (%image-surface-create-for-data data format width height 
-      (or 
-       stride
-       (let ((element-size (cdr (assoc format '((:argb32 . 4) (:rgb24 . 4) (:a8 . 1) (:a1 1/8))))))
-        (ceiling (* width element-size)))))))
-  (call-next-method))
+(defmethod allocate-foreign ((surface image-surface) 
+                            &key width height stride format data)
+  (if (not data)
+      (%image-surface-create format width height)
+    (%image-surface-create-for-data data format width height 
+     (or 
+      stride
+      (let ((element-size (cdr (assoc format '((:argb32 . 4) (:rgb24 . 4) (:a8 . 1) (:a1 1/8))))))
+       (ceiling (* width element-size)))))))
 
 
 (defbinding %image-surface-create () image-surface