From tpapp at common-lisp.net  Mon Aug 13 14:30:45 2007
From: tpapp at common-lisp.net (tpapp at common-lisp.net)
Date: Mon, 13 Aug 2007 10:30:45 -0400 (EDT)
Subject: [cl-cairo2-cvs] r11 -  cffi tutorial
Message-ID: <20070813143045.D2ACA5B0AD@common-lisp.net>

Author: tpapp
Date: Mon Aug 13 10:30:44 2007
New Revision: 11

Added:
   tutorial/x11-example.lisp
   x11-context.lisp
   xlib.lisp
Removed:
   README.xlib-context
   cffi/
   tutorial/xlib-example.lisp
   xlib-context.lisp
Modified:
   cl-cairo2-swig.lisp
   cl-cairo2.asd
   cl-cairo2.i
   context.lisp
   package.lisp
   path.lisp
   surface.lisp
   transformations.lisp
   tutorial/tutorial.tex
Log:
minor bugfixes, complete reworking of x11 support, support for cl-colors

Modified: cl-cairo2-swig.lisp
==============================================================================
--- cl-cairo2-swig.lisp	(original)
+++ cl-cairo2-swig.lisp	Mon Aug 13 10:30:44 2007
@@ -1279,50 +1279,4 @@
 (cffi:defcfun ("cairo_svg_version_to_string" cairo_svg_version_to_string) :string
   (version cairo_svg_version_t))
 
-(cffi:defcfun ("cairo_xlib_surface_create" cairo_xlib_surface_create) :pointer
-  (dpy :pointer)
-  (drawable :pointer)
-  (visual :pointer)
-  (width :int)
-  (height :int))
-
-(cffi:defcfun ("cairo_xlib_surface_create_for_bitmap" cairo_xlib_surface_create_for_bitmap) :pointer
-  (dpy :pointer)
-  (bitmap :pointer)
-  (screen :pointer)
-  (width :int)
-  (height :int))
-
-(cffi:defcfun ("cairo_xlib_surface_set_size" cairo_xlib_surface_set_size) :void
-  (surface :pointer)
-  (width :int)
-  (height :int))
-
-(cffi:defcfun ("cairo_xlib_surface_set_drawable" cairo_xlib_surface_set_drawable) :void
-  (surface :pointer)
-  (drawable :pointer)
-  (width :int)
-  (height :int))
-
-(cffi:defcfun ("cairo_xlib_surface_get_display" cairo_xlib_surface_get_display) :pointer
-  (surface :pointer))
-
-(cffi:defcfun ("cairo_xlib_surface_get_drawable" cairo_xlib_surface_get_drawable) :pointer
-  (surface :pointer))
-
-(cffi:defcfun ("cairo_xlib_surface_get_screen" cairo_xlib_surface_get_screen) :pointer
-  (surface :pointer))
-
-(cffi:defcfun ("cairo_xlib_surface_get_visual" cairo_xlib_surface_get_visual) :pointer
-  (surface :pointer))
-
-(cffi:defcfun ("cairo_xlib_surface_get_depth" cairo_xlib_surface_get_depth) :int
-  (surface :pointer))
-
-(cffi:defcfun ("cairo_xlib_surface_get_width" cairo_xlib_surface_get_width) :int
-  (surface :pointer))
-
-(cffi:defcfun ("cairo_xlib_surface_get_height" cairo_xlib_surface_get_height) :int
-  (surface :pointer))
-
 

Modified: cl-cairo2.asd
==============================================================================
--- cl-cairo2.asd	(original)
+++ cl-cairo2.asd	Mon Aug 13 10:30:44 2007
@@ -1,6 +1,6 @@
 (defsystem cl-cairo2
   :description "Cairo 1.4 bindings"
-  :version "0.2.3"
+  :version "0.3"
   :author "Tamas K Papp"
   :license "GPL"
   :components ((:file "package")
@@ -12,7 +12,10 @@
                (: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)))))
-  :depends-on (:cffi :cl-colors))
+	       (:file "xlib" :depends-on ("context")
+			     :in-order-to ((load-op (feature :unix))
+					   (compile-op (feature :unix))))
+	       (:file "x11-context" :depends-on ("xlib")
+			     :in-order-to ((load-op (feature :unix))
+					   (compile-op (feature :unix)))))
+  :depends-on (:cffi :cl-colors :cl-utilities))

Modified: cl-cairo2.i
==============================================================================
--- cl-cairo2.i	(original)
+++ cl-cairo2.i	Mon Aug 13 10:30:44 2007
@@ -44,6 +44,5 @@
 %include /usr/include/cairo/cairo-xlib-xrender.h
 %include /usr/include/cairo/cairo-pdf.h
 %include /usr/include/cairo/cairo-svg.h
-%include /usr/include/cairo/cairo-xlib.h
 
 

Modified: context.lisp
==============================================================================
--- context.lisp	(original)
+++ context.lisp	Mon Aug 13 10:30:44 2007
@@ -30,10 +30,10 @@
      (let ((context (make-instance 'context)))
        (setf (slot-value context 'pointer) (cairo_create pointer))
        ;; register finalizer
-       (let ((context-pointer (slot-value context 'pointer)))
-	 (finalize context 
-		   #'(lambda ()
-		       (cairo_destroy context-pointer))))
+;;        (let ((context-pointer (slot-value context 'pointer)))
+;; 	 (finalize context 
+;; 		   #'(lambda ()
+;; 		       (cairo_destroy context-pointer))))
        ;; return context
        context))))
 
@@ -97,7 +97,7 @@
       (with-context (context ,pointer)
 	, at body))))
 
-(defmacro define-many-with-default-context (&rest args)
+(defmacro define-many-with-default-context (&body args)
   "Apply define-with-default context to a list.  Each item is
   itself a list, first element gives the function name, the rest
   the arguments."
@@ -131,8 +131,8 @@
 ;;;;
 
 (define-many-with-default-context
-    (save)
-    (restore)
+  (save)
+  (restore)
   (push-group)
   (pop-group)
   (pop-group-to-source)
@@ -151,28 +151,27 @@
 (define-with-default-context-sync stroke-preserve)
 
 ;;;;
-;;;; set colors using the color library
+;;;; set colors using the cl-colors library
 ;;;;
+
 (defgeneric set-source-color (color &optional context))
 
 (defmethod set-source-color 
-    ((color rgb-color) &optional (context *context*))
-  (set-source-rgb 
-   (rgb-color-red color)
-   (rgb-color-green color)
-   (rgb-color-blue color)
-   context))
+    ((color rgb) &optional (context *context*))
+  (with-slots (red green blue) color
+    (set-source-rgb red green blue context)))
 
 (defmethod set-source-color 
-    ((color rgba-color) &optional (context *context*))
-  (set-source-rgba 
-   (rgba-color-red color)
-   (rgba-color-green color)
-   (rgba-color-blue color)
-   (rgba-color-alpha color)
-   context))
-  
+    ((color rgba) &optional (context *context*))
+  (with-slots (red green blue alpha) color
+    (set-source-rgb red green blue alpha context)))
+
+(defmethod set-source-color
+    ((color hsv) &optional (context *context*))
+  (with-slots (red green blue) (hsv->rgb color)
+    (set-source-rgb red green blue context)))
 
+  
 ;;;; 
 ;;;; functions that get/set a property without any conversion
 ;;;; 

Modified: package.lisp
==============================================================================
--- package.lisp	(original)
+++ package.lisp	Mon Aug 13 10:30:44 2007
@@ -1,5 +1,5 @@
 (defpackage :cl-cairo2
-   (:use :common-lisp :cffi :cl-colors)
+   (:use :common-lisp :cffi :cl-colors :cl-utilities)
    (:export 				; !!! when the interface
 					; stabilizes, remove export's
 					; from all other places and
@@ -10,4 +10,6 @@
     *context* set-source-color
     ;; 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))
+    trans-matrix-yy trans-matrix-x0 trans-matrix-y0 trans-matrix-p
+    ;; x11-context
+    x11-context x11-display open-x11-display create-x11-context))

Modified: path.lisp
==============================================================================
--- path.lisp	(original)
+++ path.lisp	Mon Aug 13 10:30:44 2007
@@ -1,8 +1,8 @@
 (in-package :cl-cairo2)
 
 (define-many-with-default-context
-    (new-path)
-    (new-sub-path)
+  (new-path)
+  (new-sub-path)
   (close-path)
   (arc xc yc radius angle1 angle2)
   (arc-negative xc yc radius angle1 angle2)

Modified: surface.lisp
==============================================================================
--- surface.lisp	(original)
+++ surface.lisp	Mon Aug 13 10:30:44 2007
@@ -45,7 +45,7 @@
     (check-surface-pointer-status pointer
       (setf (slot-value surface 'pointer) pointer)
       ;; register finalizer
-      (finalize surface #'(lambda () (cairo_surface_destroy pointer)))
+;;      (finalize surface #'(lambda () (cairo_surface_destroy pointer)))
       ;; return surface
       surface)))
 

Modified: transformations.lisp
==============================================================================
--- transformations.lisp	(original)
+++ transformations.lisp	Mon Aug 13 10:30:44 2007
@@ -18,8 +18,8 @@
 ;;;;
 
 (define-many-with-default-context 
-    (translate tx ty)
-    (scale sx sy)
+  (translate tx ty)
+  (scale sx sy)
   (rotate angle))
 
 (define-flexible (reset-matrix pointer)
@@ -82,8 +82,8 @@
   and copies x and y in/out before/after (respectively) the
   execution of body."
   `(with-foreign-objects ((xp :double) (yp :double))
-     (setf (mem-ref xp :double) x
-	  (mem-ref yp :double) y)
+     (setf (mem-ref xp :double) (coerce x 'double-float)
+	   (mem-ref yp :double) (coerce y 'double-float))
      , at body
      (values (mem-ref xp :double) (mem-ref yp :double))))
 
@@ -92,7 +92,7 @@
   returns the latter two."
   `(define-flexible (,name pointer x y)
      (with-x-y 
-	 (,(prepend-intern "cairo_" name) pointer xp yp))))
+       (,(prepend-intern "cairo_" name) pointer xp yp))))
 
 ;;;;
 ;;;;  transformation and conversion functions

Modified: tutorial/tutorial.tex
==============================================================================
--- tutorial/tutorial.tex	(original)
+++ tutorial/tutorial.tex	Mon Aug 13 10:30:44 2007
@@ -229,7 +229,7 @@
 written to PNG files) are supported.
 
 Drawing in X11 windows is implemented using the
-\lstinline!xlib-context! class --- see Section~\ref{sec:xlib-context}
+\lstinline!x11-context! class --- see Section~\ref{sec:x11-context}
 for more information.
 
 \subsection{Contexts}
@@ -331,32 +331,42 @@
 with \lstinline!trans-matrix-!, and other a few other functions have
 been renamed to avoid conflicts with linear algebra packages.
 
-\subsection{Xlib Contexts}
-\label{sec:xlib-context}
+\subsection{X11 Contexts}
+\label{sec:x11-context}
 
-The xlib context is not part of cairo -- it is a bit of glue code that
+The x11 context is not part of cairo -- it is a bit of glue code that
 uses cairo's X11 surface on a pixmap, and displays this pixmap when
 needed (when X11 asks for the window contents to be redrawn or when
-cairo draws on the pixmap).  For the latter, it uses the XDamage
-extension.
+cairo draws on the pixmap).
 
-The X11 event loop runs in a separate thread, so you need a Lisp
-implementation that supports threads.  The surface is not exposed to
-the user, who is only allowed to see the context.  This makes memory
-management and proper cleanup easier.
-
-\textbf{Important:} before proceeding, make sure that you read
-\verb!README.xlib-context! on how to install the shared library with
-the necessary code.
+In order to open an \lstinline!x11-context!, first you need to open an
+\lstinline!x11-display!, for example,
+\begin{lstlisting}
+(defparameter *display* (open-x11-display ":0"))
+\end{lstlisting}
+opens a display on the local host.  Each display runs an event loop in
+a separate thread, and you can open several display and several
+windows on each simultaneously.  The X11 event loop runs in a separate
+thread, so you need a Lisp implementation that supports threads.  You
+can close displays with \lstinline!destroy!, all open windows will be
+closed and the contexts mapping into these windows will be destroyed
+(drawing on them will be an invalid operation).
+
+For cl-cairo2, each window maps to a context.  The surface is not
+exposed to the user, who is only allowed to see the context.  This
+makes memory management and proper cleanup easier.
 
 You can create Xlib contexts with
 \begin{lstlisting}
-  (create-xlib-context width height)
+  (create-x11-context width height display)
 \end{lstlisting}
 When \lstinline!destroy!ed, the window is closed.  This works the
 other way too: when the window is closed, the context is destroyed.
+The windows are double-buffered using a pixmap on the X11 server,
+therefore redrawing exposed windows is fast.  However, this
+implementation precludes the resizing of the window.
 
-Example code can be found in \verb!tutorial/xlib-example.lisp!.  The
+Example code can be found in \verb!tutorial/x11-example.lisp!.  The
 current implementation is not optimized for speed (the whole window is
 redrawn all the time) but it is fast enough for me.  If you need speed
 improvements desperately, please contact the author.

Added: tutorial/x11-example.lisp
==============================================================================
--- (empty file)
+++ tutorial/x11-example.lisp	Mon Aug 13 10:30:44 2007
@@ -0,0 +1,60 @@
+(asdf:operate 'asdf:load-op :cl-cairo2)
+
+;;;; Make a test package
+(defpackage :cairo-xlib-example
+  (:use :common-lisp :cl-cairo2))
+
+(in-package :cairo-xlib-example)
+
+;; open display
+(defparameter *display* (open-x11-display ":0"))
+
+(let ((width 400)
+      (height 300))
+  (setf *context* (create-x11-context width height *display*))
+  ;; clear the whole canvas with blue
+  (rectangle 0 0 width height)
+  (set-source-rgb 0.2 0.2 0.5)
+  (fill-path)
+  ;; draw a white diagonal line
+  (move-to width 0)
+  (line-to 0 height)
+  (set-source-rgb 1 1 1)
+  (set-line-width 5)
+  (stroke)
+  ;; draw a green diagonal line
+  (move-to 0 0)
+  (line-to width height)
+  (set-source-rgb 0 1 0)
+  (set-line-width 5)
+  (stroke))
+;; need to close window manually
+
+
+(defun random-square (alpha)
+  "Draw a blue rectangle with fixed size and the given transparency alpha."
+  (move-to 1 1)
+  (line-to -1 1)
+  (line-to -1 -1)
+  (line-to 1 -1)
+  (close-path)
+  (set-source-rgba 0 0 1 alpha)
+  (fill-path))
+
+(defparameter width 800)
+(defparameter height 600)
+(defparameter max-angle 90d0)
+(setf *context* (create-x11-context width height *display*))
+;; fill with white
+(rectangle 0 0 width height)
+(set-source-rgb 1 1 1)
+(fill-path)
+;; draw the rectangles
+(dotimes (i 500)
+  (let ((scaling (+ 5d0 (random 40d0))))
+    (reset-matrix)		; reset matrix
+    (translate (random width) (random height)) ; move the origin
+    (scale scaling scaling)			  ; scale
+    (rotate (deg-to-rad (random max-angle))) ; rotate
+    (random-square (+ 0.1 (random 0.4)))))
+;; need to close window manually

Added: x11-context.lisp
==============================================================================
--- (empty file)
+++ x11-context.lisp	Mon Aug 13 10:30:44 2007
@@ -0,0 +1,272 @@
+(in-package :cl-cairo2)
+
+
+(defconstant x11-display-destroy-message-type 29653)
+(defconstant x11-display-destroy-data0 17875817)
+
+(defvar *x11-context-count* 0 "window counter for autogenerating names")
+
+(defun next-x11-context-name ()
+  "Return an autogenerated window name using *x11-context-count*."
+  (format nil "cl-cairo2 ~a" (incf *x11-context-count*)))
+
+;; x11-display 
+
+(defclass x11-context (context)
+  ((width :initarg :width)
+   (height :initarg :height)
+   (window :initarg :window :accessor window)
+   (pixmap :initarg :pixmap)
+   (graphics-context :initarg :graphics-context)
+   (x11-display
+    :initarg :x11-display
+    :documentation "refers back to the context's X11 display")))
+
+(defclass x11-display ()
+  ((display
+    :initform nil
+    :documentation "pointer to an xlib display, if nil, the display is
+closed and all other fields should be ignored")
+   (screen
+    :documentation "screen number")
+   (root)
+   (visual)
+   (depth)
+   (whitepixel)
+   (wm-delete-window 
+    :documentation "atom for the WM_DELETE_WINDOW event")
+   (signal-window
+    :documentation "window used for sending signals to the event loop, unmapped")
+   (thread
+    :documentation "the thread id")
+   (x11-contexts
+    :initform nil
+    :documentation "a list of X11 contexts on this display")))
+
+
+;; code to make threads, please extend with your own Lisp if needed
+;; testing is welcome, I only tested cmucl and sbcl
+(defun start-thread (function name)
+  #+allegro (mp:process-run-function name function)
+  #+armedbear (ext:make-thread function :name name)
+  #+cmu (mp:make-process function :name name)
+  #+lispworks (mp:process-run-function name nil function)
+  #+openmcl (ccl:process-run-function name function)
+  #+sbcl (sb-thread:make-thread function :name name))
+
+;; we create this definition manually, SWIG just messes things up
+(defcfun ("cairo_xlib_surface_create" cairo_xlib_surface_create) cairo_surface_t
+  (display display)
+  (drawable drawable)
+  (visual visual)
+  (width :int)
+  (height :int))
+    
+;;;;
+;;;; The important code starts here.  The event model is the
+;;;; following: we open an x11-display, which is attached to an Xlib
+;;;; display, and has a list of x11-contexts, which is initially
+;;;; empty.  An event loop is started in a separate thread: each time
+;;;; an event arrives, it is matched to one of the windows and is
+;;;; acted upon.
+;;;;
+;;;; Each x11-context has a window where its contents appear.
+;;;;
+;;;; The window signal-window serves a special purpose.  It remains
+;;;; unmapped, but allows us to send events (eg requests to terminate)
+;;;; to the event loop even if there are no x11-contexts.
+
+(defun refresh-x11-context (display x11-context)
+  "Copy the contents of the pixmap to the window."
+  (with-slots (width height window pixmap graphics-context) x11-context
+    (xcopyarea display pixmap window graphics-context
+	       0 0 width height 0 0)
+    (xsync display 1)))
+
+
+(defun open-x11-display (display-name)
+  "Open an X11 display, get the constants and start an event loop."
+  (let ((x11-display (make-instance 'x11-display)))
+    (with-slots (display screen root visual depth whitepixel wm-delete-window
+			 signal-window thread x11-contexts) x11-display
+      ;; open display
+      (setf display (xopendisplay display-name))
+      (when (null-pointer-p display)
+	(error "couldn't open display ~a" display-name))
+      ;; get defaults
+      (setf screen (xdefaultscreen display)
+	    root (xdefaultrootwindow display))
+      (setf visual (xdefaultvisual display screen)
+	    depth (xdefaultdepth display screen)
+	    whitepixel (xwhitepixel display screen))
+      ;; get WM_DELETE_WINDOW atom
+      (setf wm-delete-window 
+	    (xinternatom display "WM_DELETE_WINDOW" 1))
+      ;; create signal-window
+      (setf signal-window 
+	    ;; window is given strictly positive size
+	    (xcreatesimplewindow display root 0 0 1 1 0 
+				 whitepixel whitepixel))
+      (xselectinput display signal-window 0)
+      ;; start threads
+      (setf thread
+	    (start-thread
+	     (lambda ()
+	       (let ((wm-protocols (xinternatom display "WM_PROTOCOLS" 1)))
+		 (with-foreign-object (xev :long 24)
+		   (do ((got-close-signal nil))
+		       (got-close-signal)
+		     ;; get next event
+		     (xnextevent display xev)
+		     ;; decipher structure, at least partially
+		     (with-foreign-slots ((type window) xev xanyevent)
+		       (let ((x11-context (find window x11-contexts :key #'window)))
+			 ;; action based on event type
+			 (cond
+			   ;; expose event
+			   ((and (= type 12) x11-context)
+			    (refresh-x11-context display x11-context))
+			    ; clientnotify event
+			   ((= type 33)
+			    (with-foreign-slots ((message-type data0) xev 
+						 xclientmessageevent)
+			      ;; WM_DELETE_WINDOW
+			      (when (and x11-context
+					 (= message-type wm-protocols)
+					 (= data0 wm-delete-window))
+				(destroy x11-context))
+			      ;; signal to the x11-display
+			      (when (= window signal-window)
+				(xclosedisplay display)
+				(setf display nil)
+				(setf got-close-signal t)))))))))))
+	     (format nil "thread for display ~a" display-name)))
+      ;; return x11-display
+      x11-display)))
+
+
+(defun close-x11-context (x11-context)
+  "Close related window and do some cleanup, except removal from
+  x11-contexts of the x11-display.  This function is meant to be used
+  internally and is not exported."
+  (with-slots (x11-display window pixmap pointer) x11-context
+    (with-slots (x11-contexts display) x11-display
+      ;; we will sync all operations during destruction of the window
+      (xsynchronize display 1)
+      ;; destroy cairo context
+      (let ((saved-pointer pointer))
+	(setf pointer nil)	; invalidate first so it can't be used
+	(cairo_destroy saved-pointer))
+      ;; free pixmap
+      (xfreepixmap display pixmap)
+      (setf pixmap nil)
+      ;; destroy window
+      (xdestroywindow display window)
+      (setf window nil)
+      ;; set x11-display of context to nil
+      (setf x11-display nil))))
+
+
+(defmethod destroy ((object x11-context))
+  (with-slots (x11-contexts) (slot-value object 'x11-display)
+    ;; close
+    (close-x11-context object)
+    ;; remove from the list of windows
+    (setf x11-contexts (remove object x11-contexts))))
+
+
+(defun create-x11-context (width height x11-display
+			   &optional (x11-context-name (next-x11-context-name)))
+  "Create an x11-context (a window with a context that belongs to it)
+with given dimensions and optional name.  If the name is not given, it
+will be autogenerated."
+  (assert (typep x11-display 'x11-display))
+  (let ((x11-context (make-instance 'x11-context
+		      :width width
+		      :height height
+		      :x11-display x11-display)))
+    (with-slots (pointer width height window pixmap graphics-context) x11-context
+      (with-slots (display screen root visual depth whitepixel wm-delete-window
+			   x11-contexts) x11-display
+	;; add window to list
+	(push x11-context x11-contexts)
+	;; we will sync all operations during setup of the window
+	(xsynchronize display 1)
+	;; create window and pixmap
+	(setf window
+	      (xcreatesimplewindow display root 0 0 width height
+				   0 whitepixel whitepixel))
+	(setf pixmap
+	      (xcreatepixmap display window width height depth))
+	;; create graphics context
+	(setf graphics-context
+	      (xcreategc display pixmap 0 (null-pointer)))
+	;; window name
+	(xstorename display window x11-context-name)
+	;; size hints (most window managers will respect this)
+	(let ((hints (xallocsizehints)))
+	  (with-foreign-slots ((flags x y min-width min-height
+				      max-width max-height)
+			       hints
+			       xsizehints)
+	    ;; we only set the first four values because old WM's might
+	    ;; get confused if we don't, they should be ignored
+	    (setf flags (logior pminsize pmaxsize)
+		  x 0
+		  y 0
+		  (foreign-slot-value hints 'xsizehints 'width) width
+		  (foreign-slot-value hints 'xsizehints 'height) height
+		  min-width width
+		  max-width width
+		  min-height height
+		  max-height height)
+	    (xsetwmnormalhints display window hints)))
+	;; select input
+	(xselectinput display window (logior exposuremask structurenotifymask))
+	;; handle window closing
+	(with-foreign-object (prot 'atom)
+	  (setf (mem-aref prot 'atom) wm-delete-window)
+	  (xsetwmprotocols display window prot 1))
+	;; map window
+	(xmapwindow display window)
+	;; create xlib surface and context, destroy surface (not needed any more)
+	(let ((surface (cairo_xlib_surface_create display pixmap visual
+						  width height)))
+	  (setf pointer (cairo_create surface))
+	  ;; !!! error checking
+	  (cairo_surface_destroy surface))
+	;; turn of synchronization
+	(xsynchronize display 0)
+	;; return x11-context
+	x11-context))))
+
+
+(defmethod sync ((object x11-context))
+  (with-slots (x11-display) object
+    (with-slots (display) x11-display
+      (refresh-x11-context display object))))
+
+
+(defmethod destroy ((object x11-display))
+  "Close X11 display, destroying all the contexts if necessary."
+  (with-slots ((display-pointer display) signal-window x11-contexts)
+      object
+    (unless display-pointer
+      (error "This display is not open."))
+    (when x11-contexts
+      (dolist (x11-context x11-contexts)
+	(close-x11-context x11-context)
+	(setf x11-contexts nil)))
+    (with-foreign-object (xev :long 24)
+      (with-foreign-slots 
+	  ((type display window message-type format data0) 
+	   xev xclientmessageevent)
+	(setf type 33)			; clientnotify
+	(setf display display-pointer)
+	(setf window signal-window)
+	(setf message-type 0)
+	(setf format 32)
+	(setf data0 0)
+	(xsendevent display signal-window 0 0 xev))
+      (xflush display-pointer))))
+	

Added: xlib.lisp
==============================================================================
--- (empty file)
+++ xlib.lisp	Mon Aug 13 10:30:44 2007
@@ -0,0 +1,319 @@
+(in-package :cl-cairo2)
+
+;;;;
+;;;; a limited interface to certain Xlib functions
+;;;;
+
+(load-foreign-library "libX11.so")
+
+;;;; types
+
+(defctype display :pointer)
+(defctype xid :unsigned-long)	; X Id type
+(defctype drawable xid)
+(defctype window xid)
+(defctype pixmap xid)
+(defctype graphics-context xid)
+(defctype visual :pointer)
+(defctype atom :unsigned-long)
+(defctype bool :int)
+
+;; constants
+
+(defmacro define-bitmask-constants (&body name-power-pairs)
+  "Define a list of constants from name-value pairs, raising 2 to
+the power value."
+  (labels ((dbc (pairs)
+	     (case (length pairs)
+	       (0 nil)
+	       (1 (error "no power after ~a" (car name-power-pairs)))
+	       (t (destructuring-bind (name power &rest rest) pairs
+		    `((defconstant ,name (expt 2 ,power))
+		       ,@(dbc rest)))))))
+    `(progn
+       ,@(dbc name-power-pairs))))
+
+(defconstant noeventmask 0)
+(define-bitmask-constants 
+  keypressmask 0
+  keyreleasemask 1
+  buttonpressmask 2            
+  buttonreleasemask 3          
+  enterwindowmask 4            
+  leavewindowmask 5            
+  pointermotionmask 6          
+  pointermotionhintmask 7      
+  button1motionmask 8          
+  button2motionmask 9          
+  button3motionmask 10         
+  button4motionmask 11         
+  button5motionmask 12         
+  buttonmotionmask 13          
+  keymapstatemask 14           
+  exposuremask 15                
+  visibilitychangemask 16        
+  structurenotifymask 17         
+  resizeredirectmask 18          
+  substructurenotifymask 19      
+  substructureredirectmask 20    
+  focuschangemask 21             
+  propertychangemask 23          
+  colormapchangemask 23          
+  ownergrabbuttonmask 24)
+
+
+
+;;;; error code handling
+(defmacro check-status (call)
+  "Check the return calue of call, if nonzero, display an error message."
+  (with-unique-names (status)
+  `(let ((,status ,call))
+     (if (zerop ,status)
+	 (values)
+	 (error "operations ~a returned status (error) ~a" ',call ,status)))))
+
+;;;; display operations
+
+(defcfun ("XOpenDisplay" xopendisplay) display
+  (display-name :string))
+
+(defcfun ("XCloseDisplay" xclosedisplay) :int
+  (display display))
+
+
+;;;; defaults for the X11 display & screen
+
+(defcfun ("XDefaultDepth" xdefaultdepth) :int 
+  (display display)
+  (screen-number :int))
+
+(defcfun ("XDefaultRootWindow" xdefaultrootwindow) window
+  (display display))
+
+(defcfun ("XDefaultScreen" xdefaultscreen) :int
+  (display display))
+
+(defcfun ("XDefaultVisual" xdefaultvisual) visual
+  (display display)
+  (screen-number :int))
+
+(defcfun ("XBlackPixel" xblackpixel) :unsigned-long
+  (display display)
+  (screen-number :int))
+
+(defcfun ("XWhitePixel" xwhitepixel) :unsigned-long
+  (display display)
+  (screen-number :int))
+
+
+;;;; graphics contexts
+
+(defcfun ("XDefaultGC" xdefaultgc) graphics-context
+  (display display)
+  (screen-number :int))
+
+(defcfun ("XCreateGC" xcreategc) graphics-context
+  (display display)
+  (drawable drawable)
+  (valuemask :unsigned-long)
+  (xgcvalues :pointer))
+
+(defcfun ("XFreeGC" xfreegc) :int
+  (display display)
+  (graphics-context graphics-context))
+
+;;;; window and pixmap management
+
+(defcfun ("XMapWindow" xmapwindow) :int
+  (display display)
+  (window window))
+
+(defcfun ("XCreateSimpleWindow" xcreatesimplewindow) window
+  (display display)
+  (parent window)
+  (x :int)
+  (y :int)
+  (width :unsigned-int)
+  (height :unsigned-int)
+  (border-width :unsigned-int)
+  (border :unsigned-long)
+  (background :unsigned-long))
+
+(defcfun ("XDestroyWindow" xdestroywindow) :int
+  (display display)
+  (window window))
+
+(defcfun ("XCreatePixmap" xcreatepixmap) pixmap
+  (display display)
+  (drawable drawable)
+  (width :unsigned-int)
+  (height :unsigned-int)
+  (depth :unsigned-int))
+
+(defcfun ("XFreePixmap" xfreepixmap) :int
+  (display display)
+  (pixmap pixmap))
+  
+(defcfun ("XSelectInput" xselectinput) :int
+  (display display)
+  (window window)
+  (event-mask :long))
+
+(defcfun ("XCopyArea" xcopyarea) :int
+  (display display)
+  (source drawable)
+  (destination drawable)
+  (graphics-context graphics-context)
+  (source-x :int)
+  (source-y :int)
+  (width :unsigned-int)
+  (height :unsigned-int)
+  (destination-x :int)
+  (destination-y :int))
+		      
+
+;; synchronization & threads 
+
+(defcfun ("XInitThreads" xinitthreads) :int)
+
+(defcfun ("XSynchronize" xsynchronize) :int
+  (display display)
+  (onoff :int))
+
+(defcfun ("XFlush" xflush) :int
+  (display display))
+
+(defcfun ("XSync" xsync) :int
+  (display display)
+  (discard :int))
+
+;; atoms & protocols 
+
+(defcfun ("XInternAtom" xinternatom) atom
+  (display display)
+  (atom-name :string)
+  (only-if-exists :int))
+
+(defcfun ("XSetWMProtocols" xsetwmprotocols) :int
+  (display display)
+  (window window)
+  (protocols :pointer)
+  (count :int))
+
+
+;; events
+
+(defcstruct xanyevent
+  (type :int)
+  (serial :unsigned-long)
+  (send-event bool)
+  (display display)
+  (window window))
+
+(defcstruct xexposeevent
+  (type :int)
+  (serial :unsigned-long)
+  (send-event bool)
+  (display display)
+  (drawable drawable)
+  (x :int)
+  (y :int)
+  (width :int)
+  (height :int)
+  (count :int)
+  (major-code :int)
+  (minor-code :int))
+
+(defcstruct xdestroywindowevent
+  (type :int)
+  (serial :unsigned-long)
+  (send-event bool)
+  (display display)
+  (event window)
+  (window window))
+
+(defcstruct xclientmessageevent
+  (type :int)
+  (serial :unsigned-long)
+  (send-event bool)
+  (display display)
+  (window window)
+  (message-type atom)
+  (format :int)
+  ;; we only use first field, union of message data is not included
+  (data0 :unsigned-long))
+
+(defcfun ("XNextEvent" xnextevent) :int
+  (display display)
+  (event-return :pointer))
+
+(defcfun ("XSendEvent" xsendevent) :int
+  (display display)
+  (window window)
+  (propagate bool)
+  (event-mask :long)
+  (xevent :pointer))
+
+;; hints & misc
+
+(defcstruct xsizehints
+  (flags :long)	    ; marks which fields in this structure are defined
+  (x :int)				; Obsolete
+  (y :int)				; Obsolete
+  (width :int)				; Obsolete
+  (height :int)				; Obsolete
+  (min-width :int)
+  (min-height :int)
+  (max-width :int)
+  (max-height :int)
+  (min-aspect-x :int)			; numerator
+  (min-aspect-y :int)			; denominator
+  (max-aspect-x :int)			; numerator
+  (max-aspect-y :int)			; denominator
+  (base-width :int)
+  (base_height :int)
+  (win_gravity :int))
+
+(define-bitmask-constants 
+    USPosition 0
+  USSize 1
+  PPosition 2
+  PSize 3
+  PMinSize 4
+  PMaxSize 5
+  PResizeInc 6
+  PAspect 7
+  PBaseSize 8
+  PWinGravity 9)
+
+(defcfun ("XAllocSizeHints" xallocsizehints) :pointer)
+
+(defcfun ("XSetWMNormalHints" xsetwmnormalhints) :void
+  (display display)
+  (window window)
+  (hints :pointer))
+
+(defcfun ("XStoreName" xstorename) :int
+  (display display)
+  (window window)
+  (window-name :string))
+
+(defcfun ("XFree" xfree) :int
+  (data :pointer))
+
+
+;; extensions
+
+(defcfun ("XAddExtension" xaddextension) :pointer
+  (display display))
+
+(defcstruct xextcodes
+  (extensions :int)
+  (major-opcode :int)
+  (first-event :int)
+  (first-error :int))
+
+
+;; call xinitthreads
+
+(xinitthreads)


From tpapp at common-lisp.net  Tue Aug 14 07:53:12 2007
From: tpapp at common-lisp.net (tpapp at common-lisp.net)
Date: Tue, 14 Aug 2007 03:53:12 -0400 (EDT)
Subject: [cl-cairo2-cvs] r12 -  tutorial
Message-ID: <20070814075312.BB18E431B7@common-lisp.net>

Author: tpapp
Date: Tue Aug 14 03:53:12 2007
New Revision: 12

Modified:
   transformations.lisp
   tutorial/   (props changed)
   tutorial/example.lisp
   tutorial/tutorial.tex
Log:
minor fixes in transformations code

Modified: transformations.lisp
==============================================================================
--- transformations.lisp	(original)
+++ transformations.lisp	Tue Aug 14 03:53:12 2007
@@ -5,13 +5,16 @@
 ;;;;  cairo-matrix-init is not defined, as we have a structure in lisp
 ;;;;    with an appropriate constructor
 ;;;;  
-;;;;  cairo_identity_matrix is reset-matrix
+;;;;  cairo_identity_matrix is reset-trans-matrix
 ;;;;  
 ;;;;  functions that manipulate transformation matrices have
 ;;;;    trans-matrix instead of matrix in their name
 ;;;;
 ;;;;  cairo_matrix_transform_distance and cairo_matrix_transform_point
 ;;;;    are simply transform-distance and transform-point
+;;;; 
+;;;;  cairo_matrix_init is not defined, make-trans-matrix will give
+;;;;    you an identity matrix
 
 ;;;;
 ;;;;  simple functions
@@ -22,7 +25,7 @@
   (scale sx sy)
   (rotate angle))
 
-(define-flexible (reset-matrix pointer)
+(define-flexible (reset-trans-matrix pointer)
   (cairo_identity_matrix pointer))
   
 
@@ -30,7 +33,13 @@
 ;;;;  transition matrix structure and helper functions/macros
 ;;;;
 
-(defstruct trans-matrix xx yx xy yy x0 y0)
+(defstruct trans-matrix
+  (xx 1d0 :type double-float)
+  (yx 0d0 :type double-float)
+  (xy 0d0 :type double-float)
+  (yy 1d0 :type double-float)
+  (x0 0d0 :type double-float)
+  (y0 0d0 :type double-float))
 
 (defun trans-matrix-copy-in (pointer matrix)
   "Copy matrix to a memory location."
@@ -108,7 +117,7 @@
 
 (define-flexible (get-trans-matrix pointer)
   (with-trans-matrix-out matrix-pointer
-    (cairo_set_matrix pointer matrix-pointer)))
+    (cairo_get_matrix pointer matrix-pointer)))
 
 (define-with-x-y user-to-device)
 (define-with-x-y user-to-device-distance)
@@ -129,7 +138,6 @@
 	  matrix-pointer
 	  , at args)))))
 
-(define-matrix-init identity)
 (define-matrix-init translate tx ty)
 (define-matrix-init scale sx sy)
 (define-matrix-init rotate radians)

Modified: tutorial/example.lisp
==============================================================================
--- tutorial/example.lisp	(original)
+++ tutorial/example.lisp	Tue Aug 14 03:53:12 2007
@@ -167,7 +167,7 @@
   ;; draw the hearts
   (dotimes (i 200)
      (let ((scaling (+ 5d0 (random 40d0))))
-       (reset-matrix)		; reset matrix
+       (reset-trans-matrix)			  ; reset matrix
        (translate (random width) (random height)) ; move the origin
        (scale scaling scaling)			  ; scale
        (rotate (deg-to-rad (- (random (* 2 max-angle)) max-angle 180))) ; rotate

Modified: tutorial/tutorial.tex
==============================================================================
--- tutorial/tutorial.tex	(original)
+++ tutorial/tutorial.tex	Tue Aug 14 03:53:12 2007
@@ -189,7 +189,8 @@
     \verb!cairo_fill! (would conflict with \lstinline!cl:fill!) 
     & \lstinline!fill-path! \\
     \verb!cairo_identity_matrix! (would
-    conflict with matrix algebra packages)& \lstinline!reset-matrix! \\
+    conflict with matrix algebra packages)& \lstinline!reset-trans-matrix! \\
+    \verb!cairo_matrix_init_identity! & use \lstinline!(make-trans-matrix)!\\
     \verb!cairo_matrix_transform_distance! 
     & \lstinline!transform-distance!\\
     \verb!cairo_matrix_transform_point! &
@@ -320,10 +321,12 @@
 
 cl-cairo2 defines the structure \lstinline!trans-matrix! with the
 slots \lstinline!xx!, \lstinline!yx!, \lstinline!xy!, \lstinline!yy!,
-\lstinline!x0!, \lstinline!y0!.  All the functions that use
-transformation matrices use this structure.  Consequently,
-\verb!cairo_matrix_init! has no corresponding function in cl-cairo2:
-you can construct a translation matrix using
+\lstinline!x0!, \lstinline!y0!.  The defaults for these slots give you
+the identity matrix.
+
+All the functions that use transformation matrices use this structure.
+Consequently, \verb!cairo_matrix_init! has no corresponding function
+in cl-cairo2: you can construct a translation matrix using
 \lstinline!make-trans-matrix!.
 
 Some functions are renamed, see Table~\ref{tab:naming}.  Generally,


From tpapp at common-lisp.net  Wed Aug 22 16:13:16 2007
From: tpapp at common-lisp.net (tpapp at common-lisp.net)
Date: Wed, 22 Aug 2007 12:13:16 -0400 (EDT)
Subject: [cl-cairo2-cvs] r13 -  tutorial
Message-ID: <20070822161316.7B8792814B@common-lisp.net>

Author: tpapp
Date: Wed Aug 22 12:13:14 2007
New Revision: 13

Added:
   xlib-context.lisp
Removed:
   x11-context.lisp
Modified:
   cl-cairo2.asd
   context.lisp
   package.lisp
   surface.lisp
   transformations.lisp
   tutorial/tutorial.tex
   xlib.lisp
Log:
another major revamping of X11 code, also put exported symbols in package.lisp where they belong

Modified: cl-cairo2.asd
==============================================================================
--- cl-cairo2.asd	(original)
+++ cl-cairo2.asd	Wed Aug 22 12:13:14 2007
@@ -15,7 +15,7 @@
 	       (:file "xlib" :depends-on ("context")
 			     :in-order-to ((load-op (feature :unix))
 					   (compile-op (feature :unix))))
-	       (:file "x11-context" :depends-on ("xlib")
+	       (:file "xlib-context" :depends-on ("xlib")
 			     :in-order-to ((load-op (feature :unix))
 					   (compile-op (feature :unix)))))
   :depends-on (:cffi :cl-colors :cl-utilities))

Modified: context.lisp
==============================================================================
--- context.lisp	(original)
+++ context.lisp	Wed Aug 22 12:13:14 2007
@@ -22,20 +22,24 @@
 ;;;; context class
 ;;;;
 
-(defclass context () ((pointer :initform nil)))
-
-(export 
- (defun create-context (surface)
-   (with-surface (surface pointer)
-     (let ((context (make-instance 'context)))
-       (setf (slot-value context 'pointer) (cairo_create pointer))
-       ;; register finalizer
-;;        (let ((context-pointer (slot-value context 'pointer)))
-;; 	 (finalize context 
-;; 		   #'(lambda ()
-;; 		       (cairo_destroy context-pointer))))
-       ;; return context
-       context))))
+(defclass context () 
+  ((pointer :initform nil :initarg :pointer)
+   (width :initarg :width :reader get-width)
+   (height :initarg :height :reader get-height)))
+
+(defun create-context (surface)
+  (with-surface (surface pointer)
+    (let ((context (make-instance 'context
+				  :pointer (cairo_create pointer)
+				  :width (get-width surface)
+				  :height  (get-height surface))))
+      ;; 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
@@ -45,11 +49,23 @@
   ;; deregister finalizer
   (cancel-finalization object))
 
-(defgeneric sync (object))
-
-(defmethod sync ((object context))
-  ;; most contexts don't need syncing
-  )
+(defgeneric sync (object)
+  (:documentation "Synchronize contents of the object with the
+  physical device if needed."))
+(defgeneric sync-lock (object)
+  (:documentation "Suspend syncing (ie sync will have no effect) until
+  sync-unlock is called.  Calls to sync-lock nest."))
+(defgeneric sync-unlock (object)
+  (:documentation "Undo a call to sync-lock."))
+(defgeneric sync-reset (object)
+  (:documentation "Undo all calls to sync, ie object will be
+synced (if necessary) no matter how many times sync was called before."))
+
+;; most contexts don't need syncing
+(defmethod sync ((object context)))
+(defmethod sync-lock ((object context)))
+(defmethod sync-unlock ((object context)))
+(defmethod sync-reset ((object context)))
 
 ;;;;
 ;;;; default context and convenience macros 
@@ -74,28 +90,25 @@
   "Define cairo function with *context* as its first argument and
   args as the rest, automatically mapping name to the appropriate
   cairo function."
-  `(export 
-    (defun ,name (, at args &optional (context *context*))
-      (with-context (context pointer)
-	(,(prepend-intern "cairo_" name) pointer , at args)))))
+  `(defun ,name (, at args &optional (context *context*))
+     (with-context (context pointer)
+       (,(prepend-intern "cairo_" name) pointer , at args))))
 
 (defmacro define-with-default-context-sync (name &rest args)
   "Define cairo function with *context* as its first argument and
   args as the rest, automatically mapping name to the appropriate
   cairo function.  sync will be called after the operation."
-  `(export 
-    (defun ,name (, at args &optional (context *context*))
-      (with-context (context pointer)
-	(,(prepend-intern "cairo_" name) pointer , at args))
-      (sync context))))
+  `(defun ,name (, at args &optional (context *context*))
+     (with-context (context pointer)
+       (,(prepend-intern "cairo_" name) pointer , at args))
+     (sync context)))
 
 (defmacro define-flexible ((name pointer &rest args) &body body)
   "Like define-with-default context, but with arbitrary body,
   pointer will point to the context."
-  `(export
-    (defun ,name (, at args &optional (context *context*))
-      (with-context (context ,pointer)
-	, at body))))
+  `(defun ,name (, at args &optional (context *context*))
+     (with-context (context ,pointer)
+       , at body)))
 
 (defmacro define-many-with-default-context (&body args)
   "Apply define-with-default context to a list.  Each item is
@@ -156,18 +169,15 @@
 
 (defgeneric set-source-color (color &optional context))
 
-(defmethod set-source-color 
-    ((color rgb) &optional (context *context*))
+(defmethod set-source-color ((color rgb) &optional (context *context*))
   (with-slots (red green blue) color
     (set-source-rgb red green blue context)))
 
-(defmethod set-source-color 
-    ((color rgba) &optional (context *context*))
+(defmethod set-source-color ((color rgba) &optional (context *context*))
   (with-slots (red green blue alpha) color
     (set-source-rgb red green blue alpha context)))
 
-(defmethod set-source-color
-    ((color hsv) &optional (context *context*))
+(defmethod set-source-color ((color hsv) &optional (context *context*))
   (with-slots (red green blue) (hsv->rgb color)
     (set-source-rgb red green blue context)))
 
@@ -228,3 +238,11 @@
 
 (define-flexible (in-stroke pointer x y)
   (not (zerop (cairo_in_stroke pointer x y))))
+
+;;;;
+;;;;  convenience functions for creating contexts directly
+;;;;
+
+(define-create-context ps)
+(define-create-context pdf)
+(define-create-context svg)

Modified: package.lisp
==============================================================================
--- package.lisp	(original)
+++ package.lisp	Wed Aug 22 12:13:14 2007
@@ -1,15 +1,54 @@
 (defpackage :cl-cairo2
    (:use :common-lisp :cffi :cl-colors :cl-utilities)
-   (:export 				; !!! when the interface
-					; stabilizes, remove export's
-					; from all other places and
-					; list them here
-    ;; utility functions
-    deg-to-rad
+   (:export
+
+    ;; cairo
+    
+    destroy deg-to-rad
+    
+    ;; surface
+
+    get-width get-height destroy create-image-surface
+    image-surface-get-format image-surface-get-width
+    image-surface-get-height image-surface-create-from-png
+    surface-write-to-png with-png-file
+    
     ;; context
-    *context* set-source-color
+    
+    create-context sync sync-lock sync
+    sync-unlock sync-reset *context* save restore push-group pop-group
+    pop-group-to-source set-source-rgb set-source-rgba clip
+    clip-preserve reset-clip copy-page show-page fill-preserve paint
+    paint-with-alpha stroke stroke-preserve set-source-color
+    get-line-width set-line-width get-miter-limit set-miter-limit
+    get-antialias set-antialias get-fill-rule set-fill-rule
+    get-line-cap set-line-cap get-line-join set-line-join get-operator
+    set-operator fill-path set-dash get-dash clip-extents fill-extents
+    in-fill in-stoke create-ps-context create-pdf-context
+    create-svg-context
+
+    ;; path
+
+    new-path new-sub-path close-path arc arc-negative curve-to line-to
+    move-to rectangle rel-move-to rel-curve-to rel-line-to text-path
+    get-current-point 
+
+    ;; text
+
+    select-font-face set-font-size text-extents show-text
+
     ;; 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
-    ;; x11-context
-    x11-context x11-display open-x11-display create-x11-context))
+
+    translate scale rotate reset-trans-matrix make-trans-matrix
+    trans-matrix-xx trans-matrix-yx trans-matrix-xy trans-matrix-yy
+    trans-matrix-x0 trans-matrix-y0 trans-matrix-p transform
+    set-trans-matrix get-trans-matrix user-to-device
+    user-to-device-distance device-to-user device-to-user-distance
+    trans-matrix-init-translate trans-matrix-init-scale
+    trans-matrix-init-rotate trans-matrix-rotate trans-matrix-scale
+    trans-matrix-rotate trans-matrix-invert trans-matrix-multiply
+    trans-matrix-distance transform-point
+
+    ;; xlib-context
+
+    xlib-context xlib-display open-xlib-display create-xlib-context))

Modified: surface.lisp
==============================================================================
--- surface.lisp	(original)
+++ surface.lisp	Wed Aug 22 12:13:14 2007
@@ -13,7 +13,10 @@
 ;;;;  class surface
 ;;;;
 
-(defclass surface () ((pointer :initarg :pointer :initform nil)))
+(defclass surface () 
+  ((pointer :initarg :pointer :initform nil)
+   (width :initarg :width :reader get-width)
+   (height :initarg :height :reader get-height)))
 
 (defmacro with-alive-surface ((surface pointer) &body body)
   "Execute body with pointer pointing to cairo surface, if nil,
@@ -39,9 +42,9 @@
      (check-surface-pointer-status ,pointer
        , at body)))
 
-(defun new-surface-with-check (pointer)
+(defun new-surface-with-check (pointer width height)
   "Check if the creation of new surface was successful, if so, return new class."
-  (let ((surface (make-instance 'surface)))
+  (let ((surface (make-instance 'surface :width width :height height)))
     (check-surface-pointer-status pointer
       (setf (slot-value surface 'pointer) pointer)
       ;; register finalizer
@@ -62,97 +65,93 @@
 ;;;;
 
 (defmacro define-create-surface (type)
-  `(export
-    (defun ,(prepend-intern "create-" type :replace-dash nil :suffix "-surface")
-	(filename width-in-points height-in-points)
-      (new-surface-with-check
-       (,(prepend-intern "cairo_" type :replace-dash nil
-				       :suffix "_surface_create")
-	 filename width-in-points height-in-points)))))
+  "Define the function create-<type>-surface."
+  `(defun ,(prepend-intern "create-" type :replace-dash nil :suffix "-surface")
+      (filename width height)
+    (new-surface-with-check
+     (,(prepend-intern "cairo_" type :replace-dash nil
+		       :suffix "_surface_create")
+       filename width height)
+     width height)))
 
 (defmacro define-create-context (type)
-  `(export
-    (defun ,(prepend-intern "create-" type :replace-dash nil :suffix "-context")
-	(filename width-in-points height-in-points)
-      "Create a surface, then a context for a file, then
+  `(defun ,(prepend-intern "create-" type :replace-dash nil :suffix "-context")
+       (filename width height)
+     "Create a surface, then a context for a file, then
 destroy (dereference) the surface.  The user only needs to
 destroy the context when done."
-      (let* ((surface (,(prepend-intern "create-"
-					type :replace-dash nil :suffix "-surface")
-			filename width-in-points height-in-points))
-	     (context (create-context surface)))
-	(destroy surface)
-	context))))
-
+     (let* ((surface (,(prepend-intern "create-"
+				       type :replace-dash nil :suffix "-surface")
+		       filename width height))
+	    (context (create-context surface)))
+       (destroy surface)
+       context)))
 
 ;;;;
 ;;;; PDF surface
 ;;;;
 
 (define-create-surface pdf)
-(define-create-context pdf)
 
 ;;;;
 ;;;; PostScript surface
 ;;;;
 
 (define-create-surface ps)
-(define-create-context ps)
 
 ;;;;
 ;;;; SVG surface
 ;;;;
 
 (define-create-surface svg)
-(define-create-context svg)
 
 ;;;;
 ;;;;  image surface
 ;;;;
 
-(export
- (defun create-image-surface (format width height)
-   (new-surface-with-check
-    (cairo_image_surface_create (lookup-enum format table-format)
-				width height))))
-
-(export
- (defun image-surface-get-format (surface)
-   (with-surface (surface pointer)
-     (lookup-cairo-enum (cairo_image_surface_get_format pointer) table-format))))
-
-(export
- (defun image-surface-get-width (surface)
-   (with-surface (surface pointer)
-     (cairo_image_surface_get_width pointer))))
-
-(export
- (defun image-surface-get-height (surface)
-   (with-surface (surface pointer)
-     (cairo_image_surface_get_height pointer))))
+(defun create-image-surface (format width height)
+  (new-surface-with-check
+   (cairo_image_surface_create (lookup-enum format table-format)
+			       width height)
+   width height))
+
+(defun image-surface-get-format (surface)
+  (with-surface (surface pointer)
+    (lookup-cairo-enum (cairo_image_surface_get_format pointer) table-format)))
+
+(defun image-surface-get-width (surface)
+  (with-surface (surface pointer)
+    (cairo_image_surface_get_width pointer)))
+
+(defun image-surface-get-height (surface)
+  (with-surface (surface pointer)
+    (cairo_image_surface_get_height pointer)))
 
 ;;;;
 ;;;;  PNG surfaces
 ;;;;
 
-(export 
- (defun image-surface-create-from-png (filename)
-   (new-surface-with-check (cairo_image_surface_create_from_png filename))))
-
-(export
- (defun surface-write-to-png (surface filename)
-   (with-surface (surface pointer)
-     (cairo_surface_write_to_png pointer filename))))
-
-(export
- (defmacro with-png-file ((filename format width height) &body body)
-   "Execute the body with context bound to a newly created png
+(defun image-surface-create-from-png (filename)
+  (let ((surface 
+	 (new-surface-with-check (cairo_image_surface_create_from_png filename)
+				 0 0)))
+    (with-slots (width height) surface
+      (setf width (image-surface-get-width surface)
+	    height (image-surface-get-height surface))
+      surface)))
+
+(defun surface-write-to-png (surface filename)
+  (with-surface (surface pointer)
+    (cairo_surface_write_to_png pointer filename)))
+
+(defmacro with-png-file ((filename format width height) &body body)
+  "Execute the body with context bound to a newly created png
    file, and close it after executing body."
-   (let ((surface-name (gensym)))
-     `(let* ((,surface-name (create-image-surface ,format ,width ,height))
-	     (*context* (create-context ,surface-name)))
-	(progn
-	  , at body
-	  (surface-write-to-png ,surface-name ,filename)
-	  (destroy ,surface-name)
-	  (destroy *context*))))))
+  (let ((surface-name (gensym)))
+    `(let* ((,surface-name (create-image-surface ,format ,width ,height))
+	    (*context* (create-context ,surface-name)))
+       (progn
+	 , at body
+	 (surface-write-to-png ,surface-name ,filename)
+	 (destroy ,surface-name)
+	 (destroy *context*)))))

Modified: transformations.lisp
==============================================================================
--- transformations.lisp	(original)
+++ transformations.lisp	Wed Aug 22 12:13:14 2007
@@ -131,12 +131,11 @@
 (defmacro define-matrix-init (name &rest args)
   "Define a matrix initializer function with args, which returns the
   new matrix."
-  `(export
-    (defun ,(prepend-intern "trans-matrix-init-" name :replace-dash nil) ,args
-      (with-trans-matrix-out matrix-pointer
-	(,(prepend-intern "cairo_matrix_init_" name) 
-	  matrix-pointer
-	  , at args)))))
+  `(defun ,(prepend-intern "trans-matrix-init-" name :replace-dash nil) ,args
+     (with-trans-matrix-out matrix-pointer
+       (,(prepend-intern "cairo_matrix_init_" name) 
+	 matrix-pointer
+	 , at args))))
 
 (define-matrix-init translate tx ty)
 (define-matrix-init scale sx sy)
@@ -157,23 +156,20 @@
 (define-matrix-transformation rotate radians)
 (define-matrix-transformation invert)
 
-(export
- (defun trans-matrix-multiply (a b)
-   (with-trans-matrix-in a a-pointer
-     (with-trans-matrix-in b b-pointer
-       (with-trans-matrix-out result-pointer
-	 (cairo_matrix_multiply result-pointer
-				a-pointer
-				b-pointer))))))
-
-(export
- (defun transform-distance (matrix x y)
-   (with-trans-matrix-in matrix matrix-pointer
-     (with-x-y 
-       (cairo_matrix_transform_distance matrix-pointer xp yp)))))
-
-(export
- (defun transform-point (matrix x y)
-   (with-trans-matrix-in matrix matrix-pointer
-     (with-x-y 
-       (cairo_matrix_transform_point matrix-pointer xp yp)))))
+(defun trans-matrix-multiply (a b)
+  (with-trans-matrix-in a a-pointer
+    (with-trans-matrix-in b b-pointer
+      (with-trans-matrix-out result-pointer
+	(cairo_matrix_multiply result-pointer
+			       a-pointer
+			       b-pointer)))))
+
+(defun transform-distance (matrix x y)
+  (with-trans-matrix-in matrix matrix-pointer
+    (with-x-y 
+      (cairo_matrix_transform_distance matrix-pointer xp yp))))
+
+(defun transform-point (matrix x y)
+  (with-trans-matrix-in matrix matrix-pointer
+    (with-x-y 
+      (cairo_matrix_transform_point matrix-pointer xp yp))))

Modified: tutorial/tutorial.tex
==============================================================================
--- tutorial/tutorial.tex	(original)
+++ tutorial/tutorial.tex	Wed Aug 22 12:13:14 2007
@@ -128,14 +128,15 @@
 CLOS wrappers, and can be closed (\emph{destroyed}) with
 \lstinline!destroy!.
 
-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.\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}.
+When the context is created from a surface, the reference count (in
+the internals of Cairo) 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.\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}
 
@@ -153,6 +154,10 @@
 \begin{lstlisting}
 (setf *context* (create-ps-context "example.ps" 200 100))
 \end{lstlisting}
+Unlike the original Cairo API, surfaces and contexts in
+\lstinline!cl-cairo2! remember their width and height.  Use the
+generic functions \lstinline!get-width! and \lstinline!get-height! to
+extract these.
 
 When you want to write the output into a bitmap file (for example, in
 PNG format), you first need to create an \emph{image surface}, then
@@ -230,7 +235,7 @@
 written to PNG files) are supported.
 
 Drawing in X11 windows is implemented using the
-\lstinline!x11-context! class --- see Section~\ref{sec:x11-context}
+\lstinline!x11-context! class --- see Section~\ref{sec:xlib-context}
 for more information.
 
 \subsection{Contexts}
@@ -334,45 +339,50 @@
 with \lstinline!trans-matrix-!, and other a few other functions have
 been renamed to avoid conflicts with linear algebra packages.
 
-\subsection{X11 Contexts}
-\label{sec:x11-context}
+\subsection{Xlib Contexts}
+\label{sec:xlib-context}
 
-The x11 context is not part of cairo -- it is a bit of glue code that
+The xlib context is not part of cairo -- it is a bit of glue code that
 uses cairo's X11 surface on a pixmap, and displays this pixmap when
 needed (when X11 asks for the window contents to be redrawn or when
 cairo draws on the pixmap).
 
-In order to open an \lstinline!x11-context!, first you need to open an
-\lstinline!x11-display!, for example,
-\begin{lstlisting}
-(defparameter *display* (open-x11-display ":0"))
-\end{lstlisting}
-opens a display on the local host.  Each display runs an event loop in
-a separate thread, and you can open several display and several
-windows on each simultaneously.  The X11 event loop runs in a separate
-thread, so you need a Lisp implementation that supports threads.  You
-can close displays with \lstinline!destroy!, all open windows will be
-closed and the contexts mapping into these windows will be destroyed
-(drawing on them will be an invalid operation).
-
-For cl-cairo2, each window maps to a context.  The surface is not
+In cl-cairo2, each window maps to a context.  The surface is not
 exposed to the user, who is only allowed to see the context.  This
-makes memory management and proper cleanup easier.
-
-You can create Xlib contexts with
+makes memory management and proper cleanup easier.  For example, you
+can create an \lstinline!xlib-context! with
 \begin{lstlisting}
-  (create-x11-context width height display)
+(setf *context* (create-xlib-context 500 400
+                                         :display-name "localhost:0"
+                                         :window-name "my pretty drawing"))
 \end{lstlisting}
-When \lstinline!destroy!ed, the window is closed.  This works the
-other way too: when the window is closed, the context is destroyed.
-The windows are double-buffered using a pixmap on the X11 server,
-therefore redrawing exposed windows is fast.  However, this
+If you give \lstinline!nil! for \lstinline!display-name!, Xlib fill
+probably figure out a reasonable default, usually from your
+\verb!$DISPLAY! environment variable.
+
+The X11 event loop runs in a separate thread, so you need a Lisp
+implementation that supports threads.  
+
+When the context \lstinline!destroy!ed, the window is closed.  This
+works the other way too: when the window is closed, the context is
+destroyed.  The windows are double-buffered using a pixmap on the X11
+server, therefore redrawing exposed windows is fast.  However, this
 implementation precludes the resizing of the window.
 
 Example code can be found in \verb!tutorial/x11-example.lisp!.  The
 current implementation is not optimized for speed (the whole window is
-redrawn all the time) but it is fast enough for me.  If you need speed
-improvements desperately, please contact the author.
+redrawn all the time) but it is fast enough.  If you draw a lot of
+objects at the same time, it is suggested that you suspend
+synchronizing with the X-window server using
+ \lstinline!(sync-lock context)!.
+  When you are done, you can call \lstinline!(sync-unlock context)!, which will automatically sync the buffer and the window.
+You can nest calls to \lstinline!sync-lock!  and
+\lstinline!sync-unlock!, and if you want to restore syncing
+unconditionally, use \lstinline!sync-reset!, which also performs
+syncing too.  These are generic functions which do nothing for other
+contexts.
+
+
 
 \subsection{To Do}
 \label{sec:todo}

Added: xlib-context.lisp
==============================================================================
--- (empty file)
+++ xlib-context.lisp	Wed Aug 22 12:13:14 2007
@@ -0,0 +1,238 @@
+(in-package :cl-cairo2)
+
+;; constants for communicating with the signal window
+(defconstant +destroy-message+ 4072)	; just some random constant
+(defconstant +refresh-message+ 2495)	; ditto
+
+(defvar *xlib-context-count* 0 "window counter for autogenerating names")
+
+(defun next-xlib-context-name ()
+  "Return an autogenerated window name using *xlib-context-count*."
+  (format nil "cl-cairo2 ~a" (incf *xlib-context-count*)))
+
+;; code to make threads, please extend with your own Lisp if needed
+;; testing is welcome, I only tested cmucl and sbcl
+(defun start-thread (function name)
+  #+allegro (mp:process-run-function name function)
+  #+armedbear (ext:make-thread function :name name)
+  #+cmu (mp:make-process function :name name)
+  #+lispworks (mp:process-run-function name nil function)
+  #+openmcl (ccl:process-run-function name function)
+  #+sbcl (sb-thread:make-thread function :name name))
+
+;; we create this definition manually, SWIG just messes things up
+(defcfun ("cairo_xlib_surface_create" cairo_xlib_surface_create) cairo_surface_t
+  (display display)
+  (drawable drawable)
+  (visual visual)
+  (width :int)
+  (height :int))
+
+;; The class for an x11 context.  Each context has a separate display
+;; queue, window and an event loop in a separate thread.  Once the
+;; event loop is started, communication with the thread is done via
+;; X11 ClientNotify events (see wacky constants above).
+
+(defclass xlib-context (context)
+  ((display :initarg :display)
+   (wm-delete-window)
+   (window)
+   (signal-window)
+   (pixmap)
+   (graphics-context)
+   (thread)
+   (sync-counter :initform 0 :accessor sync-counter)))
+
+(defun refresh-xlib-context (xlib-context)
+  "Copy the contents of the pixmap to the window.  This function is
+meant for internal use in the cl-cairo2 package."
+  (with-slots (display width height window pixmap graphics-context) xlib-context
+    (xcopyarea display pixmap window graphics-context
+	       0 0 width height 0 0)
+    (xsync display 1)))
+
+(defun create-window (display parent width height class visual background-pixel
+		      event-mask &optional (backing-store t))
+  "Create an x11 window, placed at 0 0, with the given attributes.
+For internal use in the cl-cairo2 package."
+  ;; call xcreatewindow with attributes
+  (with-foreign-object (attributes 'xsetwindowattributes)
+    (setf (foreign-slot-value attributes 'xsetwindowattributes 'event-mask)
+	  event-mask
+	  (foreign-slot-value attributes 'xsetwindowattributes 'background-pixel)
+	  background-pixel
+	  (foreign-slot-value attributes 'xsetwindowattributes 'backing-store)
+	  (if backing-store 1 0))
+    (xcreatewindow display parent 0 0 width height 
+		   0 			; zero border width
+		   0 			; depth - copy from parent
+		   (ecase class
+		     (copyfromparent 0)
+		     (inputoutput 1)
+		     (inputonly 2))	; class
+		   visual
+		   (if (eq class 'inputonly)
+		       cweventmask
+		       (logior cwbackpixel cwbackingstore cweventmask))
+		   attributes)))
+
+(defun create-xlib-context (width height &key
+			    (display-name nil) 
+			    (window-name (next-xlib-context-name)))
+  (let ((display (xopendisplay (if display-name display-name (null-pointer)))))
+    (when (null-pointer-p display)
+      (error "couldn't open display ~a" display-name))
+    (let ((xlib-context (make-instance 'xlib-context
+				       :display display
+				       :width width
+				       :height height)))
+      (flet ((event-loop ()
+	       (with-slots (display (this-window window) signal-window
+				    pixmap
+				    wm-delete-window graphics-context)
+		   xlib-context
+		 (let ((wm-protocols (xinternatom display "WM_PROTOCOLS" 1)))
+		   (with-foreign-object (xev :long 24)
+		     (do ((got-close-signal nil))
+			 (got-close-signal)
+		       ;; get next event
+		       (xnextevent display xev)
+		       ;; decipher structure, at least partially
+		       (with-foreign-slots ((type window serial) xev xanyevent)
+			 ;; action based on event type
+			 (cond
+			   ;; expose and configurenotify events
+			   ((and (= type 12) (= window this-window))
+			    (refresh-xlib-context xlib-context))
+			   ;; clientnotify event
+			   ((= type 33)
+			    (with-foreign-slots ((message-type data0) xev 
+						 xclientmessageevent)
+			      (cond
+				((or (and (= window signal-window)
+					  (= data0 +destroy-message+))
+				     (and (= window this-window)
+					  (= message-type wm-protocols)
+					  (= data0 wm-delete-window)))
+				 (setf got-close-signal t))
+				((and (= window signal-window)
+				      (= data0 +refresh-message+))
+				 (refresh-xlib-context xlib-context)))))))))))
+	       ;; close down everything
+	       (with-slots (display pixmap window signal-window pointer)
+		   xlib-context
+		 (let ((saved-pointer pointer))
+		   (setf pointer nil) ; invalidate first so it can't be used
+		   (cairo_destroy saved-pointer))
+		 (xfreepixmap display pixmap)
+		 (xdestroywindow display window)
+		 (xdestroywindow display signal-window)
+		 (xclosedisplay display))))
+	;; initialize 
+	(xsynchronize display 1)
+	(let* ((screen (xdefaultscreen display))
+	       (root (xdefaultrootwindow display))
+	       (visual (xdefaultvisual display screen))
+	       (depth (xdefaultdepth display screen))
+	       (whitepixel (xwhitepixel display screen)))
+	  (with-slots (window pixmap signal-window thread wm-delete-window
+			      pointer graphics-context) xlib-context
+	    ;; create signal window and window
+	    (setf window
+		  (create-window display root width height 'inputoutput visual 
+				 whitepixel 
+				 (logior exposuremask
+					 structurenotifymask)
+				 t))
+	    (setf signal-window
+		  (create-window display root 1 1 'inputonly visual
+				 whitepixel 0 nil))
+	    ;; create pixmap
+	    (setf pixmap
+		  (xcreatepixmap display window width height depth))
+	    ;; create graphics-context
+	    (setf graphics-context
+		  (xcreategc display pixmap 0 (null-pointer)))
+	    ;; set size hints on window (most window managers will respect this)
+	    (let ((hints (xallocsizehints)))
+	      (with-foreign-slots ((flags x y min-width min-height
+					  max-width max-height)
+				   hints
+				   xsizehints)
+		;; we only set the first four values because old WM's might
+		;; get confused if we don't, they should be ignored
+		(setf flags (logior pminsize pmaxsize)
+		      x 0
+		      y 0
+		      (foreign-slot-value hints 'xsizehints 'width) width
+		      (foreign-slot-value hints 'xsizehints 'height) height
+		      min-width width
+		      max-width width
+		      min-height height
+		      max-height height)
+		(xsetwmnormalhints display window hints)
+		(xfree hints)))
+	    ;; intern atom for window closing, set protocol on window
+	    (setf wm-delete-window 
+		  (xinternatom display "WM_DELETE_WINDOW" 1))
+	    (with-foreign-object (prot 'atom)
+	      (setf (mem-aref prot 'atom) wm-delete-window)
+	      (xsetwmprotocols display window prot 1))
+	    ;; store name
+	    (xstorename display window window-name)
+	    ;; create cairo context
+	    (let ((surface (cairo_xlib_surface_create display pixmap visual
+						      width height)))
+	      (setf pointer (cairo_create surface))
+	      ;; !!! error checking
+	      (cairo_surface_destroy surface))
+	    ;; map window
+	    (xmapwindow display window)
+	    ;; end of synchronizing
+	    (xsynchronize display 0)
+	    ;; start thread
+	    (setf thread
+		  (start-thread
+		   #'event-loop
+		   (format nil "thread for display ~a" display-name))))))
+      ;; return context
+      xlib-context)))
+
+
+(defun send-message-to-signal-window (xlib-context message)
+  "Send the desired message to the context window."
+  (with-slots ((display-pointer display) signal-window) xlib-context
+    (with-foreign-object (xev :long 24)
+      (with-foreign-slots 
+	  ((type display window message-type format data0) 
+	   xev xclientmessageevent)
+	(setf type 33)			; clientnotify
+	(setf display display-pointer)
+	(setf window signal-window)
+	(setf message-type 0)
+	(setf format 32)
+	(setf data0 message)
+	(xsendevent display-pointer signal-window 0 0 xev))
+      (xflush display-pointer))))
+
+
+(defmethod destroy ((object xlib-context))
+  (send-message-to-signal-window object +destroy-message+))
+
+(defmethod sync ((object xlib-context))
+  (when (zerop (sync-counter object))
+    (send-message-to-signal-window object +refresh-message+)))
+
+(defmethod sync-lock ((object xlib-context))
+  (incf (sync-counter object)))
+
+(defmethod sync-unlock ((object xlib-context))
+  (with-slots (sync-counter) object
+    (when (plusp sync-counter)
+      (decf sync-counter)))
+  (sync object))
+
+(defmethod sync-reset ((object xlib-context))
+  (setf (sync-counter object) 0)
+  (sync object))
+

Modified: xlib.lisp
==============================================================================
--- xlib.lisp	(original)
+++ xlib.lisp	Wed Aug 22 12:13:14 2007
@@ -13,6 +13,8 @@
 (defctype drawable xid)
 (defctype window xid)
 (defctype pixmap xid)
+(defctype cursor xid)
+(defctype colormap xid)
 (defctype graphics-context xid)
 (defctype visual :pointer)
 (defctype atom :unsigned-long)
@@ -62,7 +64,6 @@
   ownergrabbuttonmask 24)
 
 
-
 ;;;; error code handling
 (defmacro check-status (call)
   "Check the return calue of call, if nonzero, display an error message."
@@ -139,6 +140,60 @@
   (border :unsigned-long)
   (background :unsigned-long))
 
+(defcfun ("XCreateWindow" xcreatewindow) window
+  (display display)
+  (parent window)
+  (x :int)
+  (y :int)
+  (width :unsigned-int)
+  (height :unsigned-int)
+  (border-width :unsigned-int)
+  (depth :int)
+  (class :unsigned-int)
+  (visual visual)
+  (valuemask :unsigned-long)
+  (attributes :pointer))
+
+(defcstruct xsetwindowattributes
+  (background-pixmap pixmap)
+  (background-pixel :unsigned-long)
+  (border-pixmap pixmap)
+  (border-pixel :unsigned-long)
+  (bit-gravity :int)
+  (win-gravity :int)
+  (backing-store :int)
+  (backing-planes :unsigned-long)
+  (backing-pixel :unsigned-long)
+  (save-under bool)
+  (event-mask :long)
+  (do-not-propagate_mask :long)
+  (override-redirect bool)
+  (colormap colormap)
+  (cursor cursor))
+
+(define-bitmask-constants
+  CWBackPixmap       0
+  CWBackPixel        1
+  CWBorderPixmap     2
+  CWBorderPixel      3
+  CWBitGravity       4
+  CWWinGravity       5
+  CWBackingStore     6
+  CWBackingPlanes    7
+  CWBackingPixel     8
+  CWOverrideRedirect 9
+  CWSaveUnder        10
+  CWEventMask        11
+  CWDontPropagate    12
+  CWColormap         13
+  CWCursor           14)
+
+(defcfun ("XChangeWindowAttributes" xchangewindowattributes) :int
+  (display display)
+  (window window)
+  (valuemask :unsigned-long)
+  (attributes :pointer))
+
 (defcfun ("XDestroyWindow" xdestroywindow) :int
   (display display)
   (window window))
@@ -170,12 +225,23 @@
   (height :unsigned-int)
   (destination-x :int)
   (destination-y :int))
-		      
 
+(defcfun ("XSetGraphicsExposures" xsetgraphicsexposures) :int
+  (display display)
+  (graphics-context graphics-context)
+  (graphics-exposures bool))
+
+		      
 ;; synchronization & threads 
 
 (defcfun ("XInitThreads" xinitthreads) :int)
 
+(defcfun ("XLockDisplay" xlockdisplay) :int
+  (display display))
+
+(defcfun ("XUnlockDisplay" xunlockdisplay) :int
+  (display display))
+
 (defcfun ("XSynchronize" xsynchronize) :int
   (display display)
   (onoff :int))
@@ -243,6 +309,14 @@
   ;; we only use first field, union of message data is not included
   (data0 :unsigned-long))
 
+(defcstruct xvisibilityevent
+  (type :int)
+  (serial :unsigned-long)
+  (send-event bool)
+  (display display)
+  (window window)
+  (state :int))
+
 (defcfun ("XNextEvent" xnextevent) :int
   (display display)
   (event-return :pointer))


From tpapp at common-lisp.net  Sat Aug 25 12:34:49 2007
From: tpapp at common-lisp.net (tpapp at common-lisp.net)
Date: Sat, 25 Aug 2007 08:34:49 -0400 (EDT)
Subject: [cl-cairo2-cvs] r14 -  tutorial
Message-ID: <20070825123449.34A8C1C0C5@common-lisp.net>

Author: tpapp
Date: Sat Aug 25 08:34:48 2007
New Revision: 14

Modified:
   context.lisp
   package.lisp
   tutorial/x11-example.lisp
Log:
with-sync-lock added, x11-example.lisp fixed

Modified: context.lisp
==============================================================================
--- context.lisp	(original)
+++ context.lisp	Sat Aug 25 08:34:48 2007
@@ -67,6 +67,15 @@
 (defmethod sync-unlock ((object context)))
 (defmethod sync-reset ((object context)))
 
+(defmacro with-sync-lock ((context) &body body)
+  "Lock sync for context for the duration of body.  Protected against
+nonlocal exits."
+  (once-only (context)
+    `(progn
+       (sync-lock ,context)
+       (unwind-protect (progn , at body)
+	 (sync-unlock ,context)))))
+
 ;;;;
 ;;;; default context and convenience macros 
 ;;;;

Modified: package.lisp
==============================================================================
--- package.lisp	(original)
+++ package.lisp	Sat Aug 25 08:34:48 2007
@@ -15,8 +15,8 @@
     
     ;; context
     
-    create-context sync sync-lock sync
-    sync-unlock sync-reset *context* save restore push-group pop-group
+    create-context sync sync-lock sync sync-unlock sync-reset
+    with-sync-lock *context* save restore push-group pop-group
     pop-group-to-source set-source-rgb set-source-rgba clip
     clip-preserve reset-clip copy-page show-page fill-preserve paint
     paint-with-alpha stroke stroke-preserve set-source-color

Modified: tutorial/x11-example.lisp
==============================================================================
--- tutorial/x11-example.lisp	(original)
+++ tutorial/x11-example.lisp	Sat Aug 25 08:34:48 2007
@@ -7,11 +7,9 @@
 (in-package :cairo-xlib-example)
 
 ;; open display
-(defparameter *display* (open-x11-display ":0"))
-
 (let ((width 400)
       (height 300))
-  (setf *context* (create-x11-context width height *display*))
+  (setf *context* (create-xlib-context width height :window-name "diagonal lines"))
   ;; clear the whole canvas with blue
   (rectangle 0 0 width height)
   (set-source-rgb 0.2 0.2 0.5)
@@ -44,7 +42,7 @@
 (defparameter width 800)
 (defparameter height 600)
 (defparameter max-angle 90d0)
-(setf *context* (create-x11-context width height *display*))
+(setf *context* (create-xlib-context width height :window-name "rectangles"))
 ;; fill with white
 (rectangle 0 0 width height)
 (set-source-rgb 1 1 1)
@@ -52,9 +50,9 @@
 ;; draw the rectangles
 (dotimes (i 500)
   (let ((scaling (+ 5d0 (random 40d0))))
-    (reset-matrix)		; reset matrix
+    (reset-trans-matrix)		       ; reset matrix
     (translate (random width) (random height)) ; move the origin
-    (scale scaling scaling)			  ; scale
-    (rotate (deg-to-rad (random max-angle))) ; rotate
+    (scale scaling scaling)		       ; scale
+    (rotate (deg-to-rad (random max-angle)))   ; rotate
     (random-square (+ 0.1 (random 0.4)))))
 ;; need to close window manually