X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/blobdiff_plain/4fc1b6fe857abe6cae7ef8059ae9524d5ab89475..1d2032d45fc8c2603685f5f8f606c066b9418e6e:/gdk/gdktypes.lisp diff --git a/gdk/gdktypes.lisp b/gdk/gdktypes.lisp index 447b611..7a0783e 100644 --- a/gdk/gdktypes.lisp +++ b/gdk/gdktypes.lisp @@ -1,433 +1,332 @@ -;; Common Lisp bindings for GTK+ v2.0 -;; Copyright (C) 1999-2000 Espen S. Johnsen +;; Common Lisp bindings for GTK+ v2.x +;; Copyright 2000-2006 Espen S. Johnsen ;; -;; This library is free software; you can redistribute it and/or -;; modify it under the terms of the GNU Lesser General Public -;; License as published by the Free Software Foundation; either -;; version 2 of the License, or (at your option) any later version. +;; Permission is hereby granted, free of charge, to any person obtaining +;; a copy of this software and associated documentation files (the +;; "Software"), to deal in the Software without restriction, including +;; without limitation the rights to use, copy, modify, merge, publish, +;; distribute, sublicense, and/or sell copies of the Software, and to +;; permit persons to whom the Software is furnished to do so, subject to +;; the following conditions: ;; -;; This library is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; Lesser General Public License for more details. +;; The above copyright notice and this permission notice shall be +;; included in all copies or substantial portions of the Software. ;; -;; You should have received a copy of the GNU Lesser General Public -;; License along with this library; if not, write to the Free Software -;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -;; $Id: gdktypes.lisp,v 1.2 2001-02-11 20:28:07 espen Exp $ +;; $Id: gdktypes.lisp,v 1.29 2008-10-27 18:42:01 espen Exp $ (in-package "GDK") +(eval-when (:compile-toplevel :load-toplevel :execute) + (init-types-in-library gdk "libgdk-2.0" :prefix ("gdk_" "_gdk_")) + (init-types-in-library gdk "libgdk_pixbuf-2.0" :prefix "gdk_")) -(defclass color (alien-structure) + +(defclass color (boxed) ((pixel :allocation :alien - :type unsigned-long) + :type (unsigned 32)) (red :allocation :alien :accessor color-red - :type unsigned-short) + :type (unsigned 16)) (green :allocation :alien - :accessor color-grenn - :type unsigned-short) + :accessor color-green + :type (unsigned 16)) (blue :allocation :alien :accessor color-blue - :type unsigned-short)) - (:metaclass alien-class) - (:alien-name "GdkColor")) - - -(defclass visual (static-structure) - () - (:metaclass alien-class) - (:alien-name "GdkVisual")) - - -(defclass colormap (gobject) - () - (:metaclass gobject-class) - (:alien-name "GdkColormap")) - - -(defclass drawable (gobject) - () - (:metaclass gobject-class) - (:alien-name "GdkDrawable")) - + :type (unsigned 16))) + (:metaclass boxed-class) + (:packed t)) -(defclass window (drawable) - () - (:metaclass gobject-class) - (:alien-name "GdkWindow") - (:type-init "gdk_window_object_get_type")) +(deftype point () '(vector int 2)) +(deftype segment () '(vector int 4)) +(deftype trapezoid () '(vector double-float 6)) +(deftype atom () 'unsigned-int) -(defclass pixmap (drawable) - () - (:metaclass gobject-class) - (:alien-name "GdkPixmap")) - -;; Bitmaps is not defined as a propper type in gdk, only as an alias for -;; GdkDrawable, so we have to define it this way as a workaround -(defclass bitmap (alien-object) - () - (:metaclass alien-class)) - - -; (defclass geometry (alien-structure) -; ((min-width -; :allocation :alien -; :accessor geometry-min-width -; :initarg :min-width -; :type int) -; (min-height -; :allocation :alien -; :accessor geometry-min-height -; :initarg :min-heigth -; :type int) -; (max-width -; :allocation :alien -; :accessor geometry-max-width -; :initarg :max-width -; :type int) -; (max-height -; :allocation :alien -; :accessor geometry-max-height -; :initarg :max-heigth -; :type int) -; (base-width -; :allocation :alien -; :accessor geometry-base-width -; :initarg :base-width -; :type int) -; (base-height -; :allocation :alien -; :accessor geometry-base-height -; :initarg :base-heigth -; :type int) -; (width-inc -; :allocation :alien -; :accessor geometry-width-inc -; :initarg :width-inc -; :type int) -; (height-inc -; :allocation :alien -; :accessor geometry-height-inc -; :initarg :heigth-inc -; :type int) -; (min-aspect -; :allocation :alien -; :accessor geometry-min-aspect -; :initarg :min-aspect -; :type double-float) -; (max-aspect -; :allocation :alien -; :accessor geometry-max-aspect -; :initarg :max-aspect -; :type double-float)) -; (:metaclass alien-class)) - -(defclass image (gobject) - () - (:metaclass gobject-class) - (:alien-name "GdkImage")) - - -(defclass gc (gobject) - () - (:metaclass gobject-class) - (:alien-name "GdkGC")) - - -(defclass font (alien-object) - () - (:metaclass alien-class) - (:alien-name "GdkFont")) - - -(defclass cursor (alien-object) - ((type - :allocation :alien - :accessor cursor-type - :initarg :type - :type cursor-type)) - (:metaclass alien-class)) - - -(defclass drag-context (gobject) - () - (:metaclass gobject-class) - (:alien-name "GdkDragContext")) - - -(defclass device (alien-structure) - () - (:metaclass alien-class)) - -(defclass event (alien-structure) - ((window - :allocation :alien - :offset #.(size-of 'pointer) - :accessor event-window - :initarg :window - :type window) - (send-event - :allocation :alien - :accessor event-send-event - :initarg :send-event - :type (boolean 8)) - (%align :allocation :alien :offset 2 :type (unsigned 8))) - (:metaclass alien-class) - (:alien-name "GdkEvent")) - -(defclass timed-event (event) - ((time - :allocation :alien - :accessor event-time - :initarg :time - :type (unsigned 32))) - (:metaclass alien-class)) - -(defclass delete-event (event) - () - (:metaclass alien-class)) - -(defclass destroy-event (event) - () - (:metaclass alien-class)) - -(defclass expose-event (event) +;; Could this just as well have been a vector? +(defclass rectangle (boxed) ((x :allocation :alien - :accessor event-x + :accessor rectangle-x :initarg :x :type int) (y :allocation :alien - :accessor event-y + :accessor rectangle-y :initarg :y :type int) (width :allocation :alien - :accessor event-width + :accessor rectangle-width :initarg :width :type int) (height :allocation :alien - :accessor event-height + :accessor rectangle-height :initarg :height - :type int) - (count - :allocation :alien - :accessor event-count - :initarg :count :type int)) - (:metaclass alien-class)) - -(defclass motion-notify-event (timed-event) - ((x - :allocation :alien - :accessor event-x - :initarg :x - :type double-float) - (y + (:metaclass boxed-class)) + +(defclass region (struct) + () + (:metaclass struct-class) + (:ref %region-copy) + (:unref %region-destroy)) + + +(register-type 'event-mask '|gdk_event_mask_get_type|) +(define-flags-type event-mask + (:exposure 2) + :pointer-motion + :pointer-motion-hint + :button-motion + :button1-motion + :button2-motion + :button3-motion + :button-press + :button-release + :key-press + :key-release + :enter-notify + :leave-notify + :focus-change + :structure + :property-change + :visibility-notify + :proximity-in + :proximity-out + :substructure + :scroll + (:all-events #x3FFFFE)) + +(register-type 'modifier-type '|gdk_modifier_type_get_type|) +(define-flags-type modifier-type + :shift :lock :control :mod1 :mod2 :mod3 :mod4 :mod5 + :button1 :button2 :button3 :button4 :button5 + (:release #.(ash 1 30))) + + +(define-types-by-introspection "Gdk" + ("GdkFunction" :type gc-function) + ("GdkWMDecoration" :type wm-decoration) + ("GdkWMFunction" :type wm-function) + ("GdkGC" :type gc) + ("GdkGCX11" :type gc-x11) + ("GdkGCValuesMask" :type gc-values-mask) + ("GdkDrawableImplX11" :ignore t) + ("GdkWindowImplX11" :ignore t) + ("GdkPixmapImplX11" :ignore t) + ("GdkGCX11" :ignore t) + ("GdkColor" :ignore t) + ("GdkEvent" :ignore t) + ("GdkRectangle" :ignore t) + ("GdkCursor" :ignore t) + ("GdkFont" :ignore t) ; deprecated + ("GdkEventMask" :ignore t) ; manually defined + ("GdkModifierType" :ignore t) ; manually defined + + ("GdkAppLaunchContext" :ignore t) ; needs GIO + + + ("GdkDisplay" + :slots + ((name + :allocation :virtual + :getter "gdk_display_get_name" + :reader display-name + :type (copy-of string)) + (screens + :allocation :virtual + :getter display-screens) + (devices + :allocation :virtual + :getter "gdk_display_list_devices" + :reader display-devices + :type (copy-of (glist device))))) + + ;; TODO: add unbound options + ("GdkDrawable" + :slots + ((display + :allocation :virtual + :getter "gdk_drawable_get_display" + :reader drawable-display + :type display) + (screen + :allocation :virtual + :getter "gdk_drawable_get_screen" + :reader drawable-screen + :type screen) + (visual + :allocation :virtual + :getter "gdk_drawable_get_visual" + :reader drawable-visual + :type visual) + (colormap + :allocation :virtual + :getter "gdk_drawable_get_colormap" + :setter "gdk_drawable_set_colormap" + :unbound nil + :accessor drawable-colormap + :initarg :colormap + :type colormap) + (depth + :allocation :virtual + :getter "gdk_drawable_get_depth" + :reader drawable-depth + :type int) + (with + :allocation :virtual + :getter drawable-width) + (height + :allocation :virtual + :getter drawable-height))) + + ("GdkWindow" + :slots + ((state + :allocation :virtual + :getter "gdk_window_get_state" + :reader window-state + :type window-state) + (parent + :allocation :virtual + :getter "gdk_window_get_parent" + :reader window-parent + :type window) + (toplevel + :allocation :virtual + :getter "gdk_window_get_toplevel" + :reader window-toplevel + :type window) + (children + :allocation :virtual + :getter "gdk_window_get_children" + :reader window-children + :type (glist window)) + (events + :allocation :virtual + :getter "gdk_window_get_events" + :setter "gdk_window_set_events" + :accessor window-events + :type event-mask) + (group + :allocation :virtual + :getter "gdk_window_get_group" + :setter "gdk_window_set_group" + :unbound nil + :accessor window-group + :type window) + #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.10.0") + (type-hint + :allocation :virtual + :getter "gdk_window_get_type_hint" + :setter "gdk_window_set_type_hint" + :accessor window-type-hint + :type window-type-hint) + #?-(pkg-exists-p "gtk+-2.0" :atleast-version "2.10.0") + (type-hint + :allocation :virtual + :getter "gdk_window_get_type_hint" + :accessor window-type-hint + :type window-type-hint) + (decorations + :allocation :virtual + :getter %window-decoration-getter + :setter "gdk_window_set_decoration" + :boundp %window-decoration-boundp + :accessor window-decorations + :type wm-decoration)))) + + +(deftype bitmap () 'pixmap) + +(defclass cursor (boxed) + ((type :allocation :alien - :accessor event-y - :initarg :y - :type double-float) - (state + :reader cursor-type + :type cursor-type) + (ref-count :allocation :alien - :offset #.(size-of 'pointer) - :accessor event-state - :initarg :state :type unsigned-int) - (is-hint - :allocation :alien - :accessor event-is-hint - :initarg :is-hint - :type (signed 16) ; should it be (boolean 16)? - ) - (device - :allocation :alien - :offset 2 - :accessor event-device - :initarg :device - :type device) - (root-x - :allocation :alien - :accessor event-root-x - :initarg :root-x - :type double-float) - (root-y - :allocation :alien - :accessor event-root-y - :initarg :root-y - :type double-float)) - (:metaclass alien-class)) + (display + :allocation :virtual + :getter "gdk_cursor_get_display" + :reader cursor-display + :type display)) + (:metaclass boxed-class) + (:ref %cursor-ref) + (:unref %cursor-unref)) -(defclass button-press-event (timed-event) - ((x - :allocation :alien - :accessor event-x - :initarg :x - :type double-float) - (y - :allocation :alien - :accessor event-y - :initarg :y - :type double-float) - (state + +(defclass geometry (struct) + ((min-width :allocation :alien - :offset #.(size-of 'pointer) - :accessor event-state - :initarg :state - :type modifier-type) - (button + :accessor geometry-min-width + :initarg :min-width + :type int) + (min-height :allocation :alien - :accessor event-button - :initarg :button - :type unsigned-int) - (device + :accessor geometry-min-height + :initarg :min-height + :type int) + (max-width :allocation :alien - :accessor event-device - :initarg :device - :type device) - (root-x + :accessor geometry-max-width + :initarg :max-width + :type int) + (max-height :allocation :alien - :accessor event-root-x - :initarg :root-x - :type double-float) - (root-y + :accessor geometry-max-height + :initarg :max-height + :type int) + (base-width :allocation :alien - :accessor event-root-y - :initarg :root-y - :type double-float)) - (:metaclass alien-class)) - -(defclass 2-button-press-event (button-press-event) - () - (:metaclass alien-class)) - -(defclass 3-button-press-event (button-press-event) - () - (:metaclass alien-class)) - -(defclass button-release-event (button-press-event) - () - (:metaclass alien-class)) - -(defclass key-press-event (event) - () - (:metaclass alien-class)) - -(defclass key-release-event (event) - () - (:metaclass alien-class)) - -(defclass enter-notify-event (event) - () - (:metaclass alien-class)) - -(defclass leave-notify-event (event) - () - (:metaclass alien-class)) - -(defclass focus-change-event (event) - () - (:metaclass alien-class)) - -(defclass configure-event (event) - ((x + :accessor geometry-base-width + :initarg :base-width + :type int) + (base-height :allocation :alien - :accessor event-x - :initarg :x + :accessor geometry-base-height + :initarg :base-height :type int) - (y + (width-inc :allocation :alien - :accessor event-y - :initarg :y + :accessor geometry-width-inc + :initarg :width-inc :type int) - (width + (height-inc :allocation :alien - :accessor event-width - :initarg :width + :accessor geometry-height-inc + :initarg :height-inc :type int) - (height + (min-aspect :allocation :alien - :accessor event-height - :initarg :height - :type int)) - (:metaclass alien-class)) - -(defclass map-event (event) - () - (:metaclass alien-class)) - -(defclass unmap-event (event) - () - (:metaclass alien-class)) - -(defclass property-notify-event (event) - () - (:metaclass alien-class)) - -(defclass selection-clear-event (event) - () - (:metaclass alien-class)) - -(defclass selection-request-event (event) - () - (:metaclass alien-class)) - -(defclass selection-notify-event (event) - () - (:metaclass alien-class)) - -(defclass drag-enter-event (event) - () - (:metaclass alien-class)) - -(defclass drag-leave-event (event) - () - (:metaclass alien-class)) - -(defclass drag-motion-event (event) - () - (:metaclass alien-class)) - -(defclass drag-status-event (event) - () - (:metaclass alien-class)) - -(defclass drag-start-event (event) - () - (:metaclass alien-class)) - -(defclass drag-finished-event (event) - () - (:metaclass alien-class)) - -(defclass client-event (event) - () - (:metaclass alien-class)) - -(defclass visibility-notify-event (event) - ((state + :accessor geometry-min-aspect + :initarg :min-aspect + :type double-float) + (max-aspect :allocation :alien - :accessor event-state - :initarg :state - :type visibility-state)) - (:metaclass alien-class)) - -(defclass no-expose-event (event) - () - (:metaclass alien-class)) - -(defclass scroll-event (timed-event) - () - (:metaclass alien-class)) + :accessor geometry-max-aspect + :initarg :max-aspect + :type double-float) + (gravity + :allocation :alien + :accessor geometry-gravity + :initarg :gravity + :type gravity)) + (:metaclass struct-class)) +(deftype native-window () '(unsigned 32))