;; 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.32 2006-08-14 14:03:32 espen Exp $
+;; $Id: gdk.lisp,v 1.35 2007-04-06 14:25:20 espen Exp $
(in-package "GDK")
;;; 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))
(&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)
;;; 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
;; (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))
)