chiark - git - mdw - clg/blob - gdk/gdktypes.lisp

   1 ;; Common Lisp bindings for GTK+ v2.x
   2 ;; Copyright 2000-2006 Espen S. Johnsen <espen@users.sf.net>
   3 ;;
   4 ;; Permission is hereby granted, free of charge, to any person obtaining
   5 ;; a copy of this software and associated documentation files (the
   6 ;; "Software"), to deal in the Software without restriction, including
   7 ;; without limitation the rights to use, copy, modify, merge, publish,
   8 ;; distribute, sublicense, and/or sell copies of the Software, and to
   9 ;; permit persons to whom the Software is furnished to do so, subject to
  10 ;; the following conditions:
  11 ;;
  12 ;; The above copyright notice and this permission notice shall be
  13 ;; included in all copies or substantial portions of the Software.
  14 ;;
  15 ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  16 ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
  17 ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
  18 ;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
  19 ;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
  20 ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
  21 ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
  22
  23 ;; $Id: gdktypes.lisp,v 1.28 2007-06-06 10:43:54 espen Exp $
  24
  25 (in-package "GDK")
  26
  27 (eval-when (:compile-toplevel :load-toplevel :execute)
  28   (init-types-in-library gdk "libgdk-2.0" :prefix ("gdk_" "_gdk_"))
  29   (init-types-in-library gdk "libgdk_pixbuf-2.0" :prefix "gdk_"))
  30
  31
  32 (defclass color (boxed)
  33   ((pixel
  34     :allocation :alien
  35     :type (unsigned 32))
  36    (red
  37     :allocation :alien
  38     :accessor color-red
  39     :type (unsigned 16))
  40    (green
  41     :allocation :alien
  42     :accessor color-green
  43     :type (unsigned 16))
  44    (blue
  45     :allocation :alien
  46     :accessor color-blue
  47     :type (unsigned 16)))
  48   (:metaclass boxed-class)
  49   (:packed t))
  50
  51
  52 (deftype point () '(vector int 2))
  53 (deftype segment () '(vector int 4))
  54 (deftype trapezoid () '(vector double-float 6))
  55 (deftype atom () 'unsigned-int)
  56
  57
  58 ;; Could this just as well have been a vector?
  59 (defclass rectangle (boxed)
  60   ((x
  61     :allocation :alien
  62     :accessor rectangle-x
  63     :initarg :x
  64     :type int)
  65    (y
  66     :allocation :alien
  67     :accessor rectangle-y
  68     :initarg :y
  69     :type int)
  70    (width
  71     :allocation :alien
  72     :accessor rectangle-width
  73     :initarg :width
  74     :type int)
  75    (height
  76     :allocation :alien
  77     :accessor rectangle-height
  78     :initarg :height
  79     :type int))
  80   (:metaclass boxed-class))
  81
  82 (defclass region (struct)
  83   ()
  84   (:metaclass struct-class)
  85   (:ref %region-copy)
  86   (:unref %region-destroy))
  87
  88
  89 (register-type 'event-mask '|gdk_event_mask_get_type|)
  90 (define-flags-type event-mask
  91   (:exposure 2)
  92   :pointer-motion
  93   :pointer-motion-hint
  94   :button-motion
  95   :button1-motion
  96   :button2-motion
  97   :button3-motion
  98   :button-press
  99   :button-release
 100   :key-press
 101   :key-release
 102   :enter-notify
 103   :leave-notify
 104   :focus-change
 105   :structure
 106   :property-change
 107   :visibility-notify
 108   :proximity-in
 109   :proximity-out
 110   :substructure
 111   :scroll
 112   (:all-events #x3FFFFE))
 113
 114 (register-type 'modifier-type '|gdk_modifier_type_get_type|)
 115 (define-flags-type modifier-type
 116   :shift :lock :control :mod1 :mod2 :mod3 :mod4 :mod5
 117   :button1 :button2 :button3 :button4 :button5
 118   (:release #.(ash 1 30)))
 119
 120
 121 (define-types-by-introspection "Gdk"
 122   ("GdkFunction" :type gc-function)
 123   ("GdkWMDecoration" :type wm-decoration)
 124   ("GdkWMFunction" :type wm-function)
 125   ("GdkGC" :type gc)
 126   ("GdkGCX11" :type gc-x11)
 127   ("GdkGCValuesMask" :type gc-values-mask)
 128   ("GdkDrawableImplX11" :ignore t)
 129   ("GdkWindowImplX11" :ignore t)
 130   ("GdkPixmapImplX11" :ignore t)
 131   ("GdkGCX11" :ignore t)
 132   ("GdkColor" :ignore t)
 133   ("GdkEvent" :ignore t)
 134   ("GdkRectangle" :ignore t)
 135   ("GdkCursor" :ignore t)
 136   ("GdkFont" :ignore t) ; deprecated
 137   ("GdkEventMask" :ignore t) ; manually defined
 138   ("GdkModifierType" :ignore t) ; manually defined
 139
 140   ("GdkDisplay"
 141    :slots
 142    ((name
 143      :allocation :virtual
 144      :getter "gdk_display_get_name"
 145      :reader display-name
 146      :type (copy-of string))
 147     (screens
 148      :allocation :virtual
 149      :getter display-screens)
 150     (devices
 151      :allocation :virtual
 152      :getter "gdk_display_list_devices"
 153      :reader display-devices
 154      :type (copy-of (glist device)))))
 155
 156   ;; TODO: add unbound options
 157   ("GdkDrawable"
 158    :slots
 159    ((display
 160      :allocation :virtual
 161      :getter "gdk_drawable_get_display"
 162      :reader drawable-display
 163      :type display)
 164     (screen
 165      :allocation :virtual
 166      :getter "gdk_drawable_get_screen"
 167      :reader drawable-screen
 168      :type screen)
 169     (visual
 170      :allocation :virtual
 171      :getter "gdk_drawable_get_visual"
 172      :reader drawable-visual
 173      :type visual)
 174     (colormap
 175      :allocation :virtual
 176      :getter "gdk_drawable_get_colormap"
 177      :setter "gdk_drawable_set_colormap"
 178      :unbound nil
 179      :accessor drawable-colormap
 180      :initarg :colormap
 181      :type colormap)
 182     (depth
 183      :allocation :virtual
 184      :getter "gdk_drawable_get_depth"
 185      :reader drawable-depth
 186      :type int)
 187     (with
 188      :allocation :virtual
 189      :getter drawable-width)
 190     (height
 191      :allocation :virtual
 192      :getter drawable-height)))
 193
 194   ("GdkWindow"
 195    :slots
 196    ((state
 197      :allocation :virtual
 198      :getter "gdk_window_get_state"
 199      :reader window-state
 200      :type window-state)
 201     (parent
 202      :allocation :virtual
 203      :getter "gdk_window_get_parent"
 204      :reader window-parent
 205      :type window)
 206     (toplevel
 207      :allocation :virtual
 208      :getter "gdk_window_get_toplevel"
 209      :reader window-toplevel
 210      :type window)
 211     (children
 212      :allocation :virtual
 213      :getter "gdk_window_get_children"
 214      :reader window-children
 215      :type (glist window))
 216     (events
 217      :allocation :virtual
 218      :getter "gdk_window_get_events"
 219      :setter "gdk_window_set_events"
 220      :accessor window-events
 221      :type event-mask)
 222     (group
 223      :allocation :virtual
 224      :getter "gdk_window_get_group"
 225      :setter "gdk_window_set_group"
 226      :unbound nil
 227      :accessor window-group
 228      :type window)
 229     #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.10.0")
 230     (type-hint
 231      :allocation :virtual
 232      :getter "gdk_window_get_type_hint"
 233      :setter "gdk_window_set_type_hint"
 234      :accessor window-type-hint
 235      :type window-type-hint)
 236     #?-(pkg-exists-p "gtk+-2.0" :atleast-version "2.10.0")
 237     (type-hint
 238      :allocation :virtual
 239      :getter "gdk_window_get_type_hint"
 240      :accessor window-type-hint
 241      :type window-type-hint)
 242     (decorations
 243      :allocation :virtual
 244      :getter %window-decoration-getter
 245      :setter "gdk_window_set_decoration"
 246      :boundp %window-decoration-boundp
 247      :accessor window-decorations
 248      :type wm-decoration))))
 249
 250
 251 (deftype bitmap () 'pixmap)
 252
 253 (defclass cursor (boxed)
 254   ((type
 255     :allocation :alien
 256     :reader cursor-type
 257     :type cursor-type)
 258    (ref-count
 259     :allocation :alien
 260     :type unsigned-int)
 261    (display
 262     :allocation :virtual
 263     :getter "gdk_cursor_get_display"
 264     :reader cursor-display
 265     :type display))
 266   (:metaclass boxed-class)
 267   (:ref %cursor-ref)
 268   (:unref %cursor-unref))
 269
 270
 271 (defclass geometry (struct)
 272   ((min-width
 273     :allocation :alien
 274     :accessor geometry-min-width
 275     :initarg :min-width
 276     :type int)
 277    (min-height
 278     :allocation :alien
 279     :accessor geometry-min-height
 280     :initarg :min-height
 281     :type int)
 282    (max-width
 283     :allocation :alien
 284     :accessor geometry-max-width
 285     :initarg :max-width
 286     :type int)
 287    (max-height
 288     :allocation :alien
 289     :accessor geometry-max-height
 290     :initarg :max-height
 291     :type int)
 292    (base-width
 293     :allocation :alien
 294     :accessor geometry-base-width
 295     :initarg :base-width
 296     :type int)
 297    (base-height
 298     :allocation :alien
 299     :accessor geometry-base-height
 300     :initarg :base-height
 301     :type int)
 302    (width-inc
 303     :allocation :alien
 304     :accessor geometry-width-inc
 305     :initarg :width-inc
 306     :type int)
 307    (height-inc
 308     :allocation :alien
 309     :accessor geometry-height-inc
 310     :initarg :height-inc
 311     :type int)
 312    (min-aspect
 313     :allocation :alien
 314     :accessor geometry-min-aspect
 315     :initarg :min-aspect
 316     :type double-float)
 317    (max-aspect
 318     :allocation :alien
 319     :accessor geometry-max-aspect
 320     :initarg :max-aspect
 321     :type double-float)
 322    (gravity
 323     :allocation :alien
 324     :accessor geometry-gravity
 325     :initarg :gravity
 326     :type gravity))
 327   (:metaclass struct-class))
 328
 329 (deftype native-window () '(unsigned 32))