Author: tpapp
Date: Thu Jul 12 10:01:08 2007
New Revision: 7
Added:
tutorial/test-finalizer.lisp
Modified:
Makefile
cairo.lisp
cl-cairo2-swig.lisp
cl-cairo2.asd
cl-cairo2.i
context.lisp
package.lisp
path.lisp
surface.lisp
tables.lisp
transformations.lisp
tutorial/tutorial.tex
xlib-context.lisp
Log:
Code cleanup, also added finalizers
Modified: Makefile
==============================================================================
--- Makefile (original)
+++ Makefile Thu Jul 12 10:01:08 2007
@@ -1,4 +1,7 @@
-cl-cairo2-swig.lisp: cl-cairo2.i
+CAIRO_INCLUDE_DIR=/usr/include/cairo
+CAIRO_INCLUDE_FILES=$(wildcard $(CAIRO_INCLUDE_DIR)/*.h)
+
+cl-cairo2-swig.lisp: cl-cairo2.i $(CAIRO_INCLUDE_FILES)
swig -cffi cl-cairo2.i
test-swig.lisp: test.i
Modified: cairo.lisp
==============================================================================
--- cairo.lisp (original)
+++ cairo.lisp Thu Jul 12 10:01:08 2007
@@ -1,10 +1,12 @@
(in-package :cl-cairo2)
-(define-foreign-library libcairo
- (:unix (:or "libcairo.so.2" "libcairo.so"))
- (t (:default "libcairo")))
+;; (define-foreign-library libcairo
+;; (:unix (:or "libcairo.so.2" "libcairo.so"))
+;; (t (:default "libcairo")))
-(use-foreign-library libcairo)
+;; (use-foreign-library libcairo)
+
+(load-foreign-library '(:default "libcairo"))
(defun deg-to-rad (deg)
"Convert degrees to radians."
Modified: cl-cairo2-swig.lisp
==============================================================================
--- cl-cairo2-swig.lisp (original)
+++ cl-cairo2-swig.lisp Thu Jul 12 10:01:08 2007
@@ -2,10 +2,10 @@
(in-package :cl-cairo2)
(defctype my-double :double)
-;; (defmethod expand-to-foreign (value (type (eql 'my-double)))
-;; `(coerce ,value 'double-float))
-(defmethod translate-to-foreign (value (type (eql 'my-double)))
- (coerce value 'double-float))
+(defmethod cffi:expand-to-foreign (value (type (eql 'my-double)))
+ `(coerce ,value 'double-float))
+;; (defmethod translate-to-foreign (value (type my-double))
+;; (coerce value 'double-float))
;; typedefs: we don't want to create all of them automatically,
;; because typedefs for structures confuse with-foreign-slots
@@ -81,9 +81,7 @@
(cl:defconstant CAIRO_VERSION_MINOR 4)
-(cl:defconstant CAIRO_VERSION_MICRO 6)
-
-(cl:defconstant CAIRO_VERSION_STRING "1.4.6")
+(cl:defconstant CAIRO_VERSION_MICRO 10)
(cl:defconstant CAIRO_HAS_SVG_SURFACE 1)
Modified: cl-cairo2.asd
==============================================================================
--- cl-cairo2.asd (original)
+++ cl-cairo2.asd Thu Jul 12 10:01:08 2007
@@ -1,6 +1,6 @@
(defsystem cl-cairo2
:description "Cairo 1.4 bindings"
- :version "0.2"
+ :version "0.2.1"
:author "Tamas K Papp"
:license "GPL"
:components ((:file "package")
@@ -8,10 +8,10 @@
(:file "cl-cairo2-swig" :depends-on ("cairo"))
(:file "tables" :depends-on ("cl-cairo2-swig"))
(:file "surface" :depends-on ("cairo" "tables" "cl-cairo2-swig"))
- (:file "context" :depends-on ("surface" "cl-cairo2-swig"))
- (:file "path" :depends-on ("context")) ; "cl-cairo2-swig"))
- (:file "text" :depends-on ("context")) ; "cl-cairo2-swig"))
- (:file "transformations" :depends-on ("context")) ; "cl-cairo2-swig")))
+ (:file "context" :depends-on ("surface" "tables" "cl-cairo2-swig"))
+ (:file "path" :depends-on ("context"))
+ (:file "text" :depends-on ("context"))
+ (:file "transformations" :depends-on ("context"))
(:file "xlib-context" :depends-on ("context")
:in-order-to ((load-op (feature :unix))
(compile-op (feature :unix)))))
Modified: cl-cairo2.i
==============================================================================
--- cl-cairo2.i (original)
+++ cl-cairo2.i Thu Jul 12 10:01:08 2007
@@ -1,6 +1,7 @@
%module "cl-cairo2-swig"
%ignore CAIRO_VERSION;
+%ignore CAIRO_VERSION_STRING;
%typemap(cin) double "my-double";
/* %typemap(cin) int ":my-int"; */
@@ -9,10 +10,10 @@
(in-package :cl-cairo2)
(defctype my-double :double)
-;; (defmethod expand-to-foreign (value (type (eql 'my-double)))
-;; `(coerce ,value 'double-float))
-(defmethod translate-to-foreign (value (type (eql 'my-double)))
- (coerce value 'double-float))
+(defmethod cffi:expand-to-foreign (value (type (eql 'my-double)))
+ `(coerce ,value 'double-float))
+;; (defmethod translate-to-foreign (value (type my-double))
+;; (coerce value 'double-float))
;; typedefs: we don't want to create all of them automatically,
;; because typedefs for structures confuse with-foreign-slots
Modified: context.lisp
==============================================================================
--- context.lisp (original)
+++ context.lisp Thu Jul 12 10:01:08 2007
@@ -29,14 +29,23 @@
(with-surface (surface pointer)
(let ((context (make-instance 'context)))
(setf (slot-value context 'pointer) (cairo_create pointer))
- ;; !!! error checking
+ ;; register finalizer
+ (let ((context-pointer (slot-value context 'pointer)))
+ (finalize context
+ #'(lambda ()
+ (cairo_destroy context-pointer))))
+ ;; return context
context))))
(defmethod destroy ((object context))
(with-slots (pointer) object
(when pointer
(cairo_destroy pointer)
- (setf pointer nil))))
+ (setf pointer nil)))
+ ;; deregister finalizer
+ (cancel-finalization object))
+
+(defgeneric sync (object))
(defmethod sync ((object context))
;; most contexts don't need syncing
@@ -46,7 +55,7 @@
;;;; default context and convenience macros
;;;;
-(export (defvar *context* nil "default cairo context"))
+(defvar *context* nil "default cairo context")
(defmacro with-context ((context pointer) &body body)
"Execute body with pointer pointing to context, and check status."
@@ -121,7 +130,6 @@
;;;; simple functions using context
;;;;
-(define-with-default-context save)
(define-many-with-default-context
(save)
(restore)
Modified: package.lisp
==============================================================================
--- package.lisp (original)
+++ package.lisp Thu Jul 12 10:01:08 2007
@@ -1,5 +1,13 @@
(defpackage :cl-cairo2
(:use :common-lisp :cffi)
- (:export deg-to-rad
- make-trans-matrix trans-matrix-xx trans-matrix-yx trans-matrix-xy
- trans-matrix-yy trans-matrix-x0 trans-matrix-y0 trans-matrix-p))
+ (:export ; !!! when the interface
+ ; stabilizes, remove export's
+ ; from all other places and
+ ; list them here
+ ;; utility functions
+ deg-to-rad
+ ;; context
+ *context*
+ ;; transformations
+ make-trans-matrix trans-matrix-xx trans-matrix-yx trans-matrix-xy
+ trans-matrix-yy trans-matrix-x0 trans-matrix-y0 trans-matrix-p))
Modified: path.lisp
==============================================================================
--- path.lisp (original)
+++ path.lisp Thu Jul 12 10:01:08 2007
@@ -10,7 +10,6 @@
(line-to x y)
(move-to x y)
(rectangle x y width height)
- (rel-curve-to dx1 dy1 dx2 dy2 dx3 dy3)
(rel-move-to dx dy)
(rel-curve-to dx1 dy1 dx2 dy2 dx3 dy3)
(rel-line-to dx dy)
Modified: surface.lisp
==============================================================================
--- surface.lisp (original)
+++ surface.lisp Thu Jul 12 10:01:08 2007
@@ -44,12 +44,17 @@
(let ((surface (make-instance 'surface)))
(check-surface-pointer-status pointer
(setf (slot-value surface 'pointer) pointer)
+ ;; register finalizer
+ (finalize surface #'(lambda () (cairo_surface_destroy pointer)))
+ ;; return surface
surface)))
(defmethod destroy ((object surface))
(with-alive-surface (object pointer)
(cairo_surface_destroy pointer)
- (setf pointer nil)))
+ (setf pointer nil))
+ ;; deregister finalizer
+ (cancel-finalization object))
;;;;
;;;; Macros to create surfaces (that are written into files) and
Modified: tables.lisp
==============================================================================
--- tables.lisp (original)
+++ tables.lisp Thu Jul 12 10:01:08 2007
@@ -2,7 +2,8 @@
(defmacro exporting-table (name definition)
`(progn
- (export (defparameter ,name ,definition))
+ (defparameter ,name ,definition)
+ (export ',name)
(dolist (i ,name)
; (export (car i))
(export (cdr i)))))
Modified: transformations.lisp
==============================================================================
--- transformations.lisp (original)
+++ transformations.lisp Thu Jul 12 10:01:08 2007
@@ -138,7 +138,7 @@
"Define a matrix transformation function with matrix and args,
which returns the new matrix."
`(export
- (defun ,(prepend-intern "trans-matrix-init-" name :replace-dash nil) (matrix ,@args)
+ (defun ,(prepend-intern "trans-matrix-" name :replace-dash nil) (matrix ,@args)
(with-trans-matrix-in-out matrix matrix-pointer
(,(prepend-intern "cairo_matrix_" name)
matrix-pointer
@@ -169,6 +169,3 @@
(with-trans-matrix-in matrix matrix-pointer
(with-x-y
(cairo_matrix_transform_point matrix-pointer xp yp)))))
-
-
-
Added: tutorial/test-finalizer.lisp
==============================================================================
--- (empty file)
+++ tutorial/test-finalizer.lisp Thu Jul 12 10:01:08 2007
@@ -0,0 +1,13 @@
+(in-package :cl-cairo2)
+
+(setf *context* (create-pdf-context "/tmp/foo.pdf" 100 100))
+(move-to 0 0)
+(line-to 100 100)
+(set-source-rgb 0 0 1)
+(stroke)
+
+;; destroy object, after this, it will be ready to be GC'd
+(setf *context* nil)
+
+;; call GC
+#+sbcl (sb-ext:gc)
Modified: tutorial/tutorial.tex
==============================================================================
--- tutorial/tutorial.tex (original)
+++ tutorial/tutorial.tex Thu Jul 12 10:01:08 2007
@@ -131,9 +131,11 @@
When the context is created from a surface, the reference count of the
latter is incremented. You can immediately destroy the surface: it
will not be destroyed (ie the file will not be closed) until you
-destroy the context. The following code draws a white diagonal line
-on a blue background, using a Postscript file -- the result is shown
-in Figure~\ref{fig:example}.
+destroy the context.\footnote{The file will also be closed if the
+ wrapper object is garbage collected. However, you should not rely
+ on this, as calling the garbage collector is not portable.} The
+following code draws a white diagonal line on a blue background, using
+a Postscript file -- the result is shown in Figure~\ref{fig:example}.
\lstinputlisting[firstline=13,lastline=27]{example.lisp}
Modified: xlib-context.lisp
==============================================================================
--- xlib-context.lisp (original)
+++ xlib-context.lisp Thu Jul 12 10:01:08 2007
@@ -69,12 +69,19 @@
(setf (slot-value xlc 'pointer) (mem-ref context-pointer :pointer))
(foreign-free xc-pointer)
(foreign-free context-pointer)
+ ;; register finalizer
+ (let ((xc (slot-value xlc 'xc)))
+ (finalize xlc
+ #'(lambda ()
+ (close_xlib_context xc))))
+ ;; return object
xlc))
(export 'create-xlib-context)
(defmethod destroy ((object xlib-context))
- (close_xlib_context (slot-value object 'xc)))
+ (close_xlib_context (slot-value object 'xc))
+ (cancel-finalization object))
(defmethod sync ((object xlib-context))
(sync_xlib (slot-value object 'xc)))
