Added function to get the GDK window associated to a Cairo xlib surface

[clg] / gdk / gdk.lisp

diff --git a/gdk/gdk.lisp b/gdk/gdk.lisp
index cf5ea87..5e18e2e 100644 (file)
--- a/gdk/gdk.lisp
+++ b/gdk/gdk.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: gdk.lisp,v 1.31 2006-07-06 13:05:59 espen Exp $
+;; $Id: gdk.lisp,v 1.35 2007-04-06 14:25:20 espen Exp $
 
 
 (in-package "GDK")
@@ -36,11 +36,21 @@
 
 ;;; Display
 
+#-debug-ref-counting
+(defmethod print-object ((display display) stream)
+  (if (and (proxy-valid-p display) (slot-boundp display 'name))
+      (print-unreadable-object (display stream :type t :identity nil)
+        (format stream "~S at 0x~X" 
+        (display-name display) (pointer-address (foreign-location display))))
+    (call-next-method)))
+
 (defbinding %display-open () display
   (display-name (or null string)))
 
 (defun display-open (&optional display-name)
-  (let ((display (%display-open display-name)))
+  (let ((display (or
+                 (%display-open display-name)
+                 (error "Opening display failed: ~A" display-name))))
     (unless (display-get-default)
       (display-set-default display))
     display))
@@ -90,19 +100,40 @@
     (&optional (display (display-get-default))) int
   (display display))
 
+(defun find-display (name)
+  (find name (list-displays) :key #'display-name :test #'string=))
+
+(defun ensure-display (display)
+  (etypecase display
+    (null (display-get-default))
+    (display display)
+    (string 
+     (or
+      (find display (list-displays) :key #'display-name :test #'string=)
+      (display-open display)))))
 
 
 ;;; Display manager
 
 (defbinding display-get-default () display)
 
-(defbinding (display-manager "gdk_display_manager_get") () display-manager)
-
 (defbinding (display-set-default "gdk_display_manager_set_default_display")
     (display) nil
   ((display-manager) display-manager)
   (display display))
 
+(defbinding (list-displays "gdk_display_manager_list_displays") ()
+    (gslist (static display))
+  ((display-manager) display-manager))
+
+;; The only purpose of exporting this is to make it possible for
+;; applications to connect to the display-opened signal
+(defbinding (display-manager "gdk_display_manager_get") () display-manager)
+
+(defbinding display-get-core-pointer 
+    (&optional (display (display-get-default))) device
+  (display display))
+
 
 ;;; Primitive graphics structures (points, rectangles and regions)
 
@@ -244,11 +275,18 @@
 
 ;;; Miscellaneous functions
 
-(defbinding screen-width () int)
-(defbinding screen-height () int)
+(defbinding screen-width () int
+  (screen screen))
+
+(defbinding screen-height () int
+  (screen screen))
+
+(defbinding screen-width-mm () int
+  (screen screen))
+
+(defbinding screen-height-mm () int
+  (screen screen))
 
-(defbinding screen-width-mm () int)
-(defbinding screen-height-mm () int)
 
 (defbinding pointer-grab 
     (window &key owner-events events confine-to cursor time) grab-status
@@ -606,7 +644,7 @@
 
 ;(defbinding window-set-geometry-hints () nil
 
-(defbinding window-icon-list () nil
+(defbinding window-set-icon-list () nil
   (window window)
   (icons (glist pixbufs)))
 
@@ -1010,6 +1048,10 @@
 ;;   (defbinding cairo-region () nil
 ;;     (cr cairo:context)
 ;;     (region region))
+
+  (defbinding (cairo-xlib-surface-get-window 
+              "clg_gdk_cairo_xlib_surface_get_window") () window
+  (surface cairo:xlib-surface))
 )