chiark - git - mdw - clg/blob - glib/gparam.lisp

   1 ;; Common Lisp bindings for GTK+ v2.x
   2 ;; Copyright 2000-2005 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: gparam.lisp,v 1.20 2006-02-15 09:55:50 espen Exp $
  24
  25 (in-package "GLIB")
  26
  27 (deftype gvalue () 'pointer)
  28
  29 (register-type 'gvalue '|g_value_get_type|)
  30
  31 (eval-when (:compile-toplevel :load-toplevel :execute)
  32   (defbinding (size-of-gvalue "size_of_gvalue") () unsigned-int))
  33
  34 ;(defconstant +gvalue-size+ (+ (size-of 'type-number) (* 2 (size-of 'double-float))))
  35 (defconstant +gvalue-size+ #.(size-of-gvalue))
  36
  37 (defconstant +gvalue-value-offset+ (size-of 'type-number))
  38
  39 (defbinding (%gvalue-init "g_value_init") () nil
  40   (value gvalue)
  41   (type type-number))
  42
  43 (defbinding (gvalue-unset "g_value_unset") () nil
  44   (value gvalue))
  45
  46 (defun gvalue-init (gvalue type &optional (value nil value-p))
  47   (%gvalue-init gvalue (find-type-number type))
  48   (when value-p
  49     (funcall (writer-function type) value gvalue +gvalue-value-offset+)))
  50
  51 (defun gvalue-new (&optional type (value nil value-p))
  52   (let ((gvalue (allocate-memory +gvalue-size+)))
  53     (cond
  54      (value-p (gvalue-init gvalue type value))
  55      (type (gvalue-init gvalue type)))
  56     gvalue))
  57
  58 (defun gvalue-free (gvalue &optional (unset-p t))
  59   (unless (null-pointer-p gvalue)
  60     (when unset-p
  61       (gvalue-unset gvalue))
  62     (deallocate-memory gvalue)))
  63
  64 (defun gvalue-type (gvalue)
  65   (type-from-number (sap-ref-32 gvalue 0)))
  66
  67 (defun gvalue-get (gvalue &optional weak-p)
  68   (funcall (reader-function (gvalue-type gvalue))
  69    gvalue +gvalue-value-offset+ weak-p))
  70
  71 (defun gvalue-set (gvalue value)
  72   (funcall (writer-function (gvalue-type gvalue))
  73    value gvalue +gvalue-value-offset+)
  74   value)
  75
  76 (defbinding (gvalue-p "g_type_check_value") () boolean
  77   (location pointer))
  78
  79 (defmacro with-gvalue ((gvalue &optional type (value nil value-p)) &body body)
  80   `(with-allocated-memory (,gvalue +gvalue-size+)
  81      ,(cond
  82        ((and type value-p) `(gvalue-init ,gvalue ,type ,value))
  83        (type `(gvalue-init ,gvalue ,type)))
  84      ,@body
  85      ,(unless value-p `(gvalue-get ,gvalue))))
  86
  87
  88 (deftype param-flag-type ()
  89   '(flags
  90     (:readable 1)
  91     (:writable 2)
  92     (:construct 4)
  93     (:construct-only 8)
  94     (:lax-validation 16)
  95     (:private 32)))
  96
  97 (eval-when (:compile-toplevel :load-toplevel :execute)
  98   (defclass param-spec-class (ginstance-class)
  99     ())
 100
 101   (defmethod validate-superclass  ((class param-spec-class) (super standard-class))
 102     t ;(subtypep (class-name super) 'param)
 103 ))
 104
 105
 106 (defbinding %param-spec-ref () pointer
 107   (location pointer))
 108
 109 (defbinding %param-spec-unref () nil
 110   (location pointer))
 111
 112 (defmethod reference-foreign ((class param-spec-class) location)
 113   (declare (ignore class))
 114   (%param-spec-ref location))
 115
 116 (defmethod unreference-foreign ((class param-spec-class) location)
 117   (declare (ignore class))
 118   (%param-spec-unref location))
 119
 120
 121
 122 ;; TODO: rename to param-spec
 123 (defclass param (ginstance)
 124   ((name
 125     :allocation :alien
 126     :reader param-name
 127     :type string)
 128    (flags
 129     :allocation :alien
 130     :reader param-flags
 131     :type param-flag-type)
 132    (value-type
 133     :allocation :alien
 134     :reader param-value-type
 135     :type type-number)
 136    (owner-type
 137     :allocation :alien
 138     :reader param-owner-type
 139     :type type-number)
 140    (nickname
 141     :allocation :virtual
 142     :getter "g_param_spec_get_nick"
 143     :reader param-nickname
 144     :type (copy-of string))
 145    (documentation
 146     :allocation :virtual
 147     :getter "g_param_spec_get_blurb"
 148     :reader param-documentation
 149     :type (copy-of string)))
 150   (:metaclass param-spec-class)
 151   (:gtype "GParam"))
 152
 153
 154 (defclass param-char (param)
 155   ((minimum
 156     :allocation :alien
 157     :reader param-char-minimum
 158     :type char)
 159    (maximum
 160     :allocation :alien
 161     :reader param-char-maximum
 162     :type char)
 163    (default-value
 164     :allocation :alien
 165     :reader param-char-default-value
 166     :type char))
 167   (:metaclass param-spec-class)
 168   (:gtype "GParamChar"))
 169
 170 (defclass param-unsigned-char (param)
 171   (
 172 ; (minimum
 173 ;     :allocation :alien
 174 ;     :reader param-unsigned-char-minimum
 175 ;     :type unsigned-char)
 176 ;    (maximum
 177 ;     :allocation :alien
 178 ;     :reader param-unsigned-char-maximum
 179 ;     :type unsigned-char)
 180 ;    (default-value
 181 ;     :allocation :alien
 182 ;     :reader param-unsigned-char-default-value
 183 ;     :type unsigned-char)
 184    )
 185   (:metaclass param-spec-class)
 186   (:gtype "GParamUChar"))
 187
 188 (defclass param-boolean (param)
 189   ((default-value
 190      :allocation :alien
 191      :reader param-boolean-default-value
 192      :type boolean))
 193   (:metaclass param-spec-class)
 194   (:gtype "GParamBoolean"))
 195
 196 (defclass param-int (param)
 197   ((minimum
 198     :allocation :alien
 199     :reader param-int-minimum
 200     :type int)
 201    (maximum
 202     :allocation :alien
 203     :reader param-int-maximum
 204     :type int)
 205    (default-value
 206     :allocation :alien
 207     :reader param-int-default-value
 208     :type int))
 209   (:metaclass param-spec-class)
 210   (:gtype "GParamInt"))
 211
 212 (defclass param-unsigned-int (param)
 213   ((minimum
 214     :allocation :alien
 215     :reader param-unsigned-int-minimum
 216     :type unsigned-int)
 217    (maximum
 218     :allocation :alien
 219     :reader param-unsigned-int-maximum
 220     :type unsigned-int)
 221    (default-value
 222     :allocation :alien
 223     :reader param-unsigned-int-default-value
 224     :type unsigned-int))
 225   (:metaclass param-spec-class)
 226   (:gtype "GParamUInt"))
 227
 228 (defclass param-long (param)
 229   ((minimum
 230     :allocation :alien
 231     :reader param-long-minimum
 232     :type long)
 233    (maximum
 234     :allocation :alien
 235     :reader param-long-maximum
 236     :type long)
 237    (default-value
 238     :allocation :alien
 239     :reader param-long-default-value
 240     :type long))
 241   (:metaclass param-spec-class)
 242   (:gtype "GParam"))
 243
 244 (defclass param-unsigned-long (param)
 245   ((minimum
 246     :allocation :alien
 247     :reader param-unsigned-long-minimum
 248     :type unsigned-long)
 249    (maximum
 250     :allocation :alien
 251     :reader param-unsigned-long-maximum
 252     :type unsigned-long)
 253    (default-value
 254     :allocation :alien
 255     :reader param-unsigned-long-default-value
 256     :type unsigned-long))
 257   (:metaclass param-spec-class)
 258   (:gtype "GParamULong"))
 259
 260 (defclass param-unichar (param)
 261   ()
 262   (:metaclass param-spec-class)
 263   (:gtype "GParamUnichar"))
 264
 265 (defclass param-enum (param)
 266   ((class
 267     :allocation :alien
 268     :reader param-enum-class
 269     :type pointer)
 270    (default-value
 271     :allocation :alien
 272     :reader param-enum-default-value
 273     :type long))
 274   (:metaclass param-spec-class)
 275   (:gtype "GParamEnum"))
 276
 277 (defclass param-flags (param)
 278   ((class
 279     :allocation :alien
 280     :reader param-flags-class
 281     :type pointer)
 282    (default-value
 283     :allocation :alien
 284     :reader param-flags-default-value
 285     :type long))
 286   (:metaclass param-spec-class)
 287   (:gtype "GParamFlags"))
 288
 289 (defclass param-single-float (param)
 290   ((minimum
 291     :allocation :alien
 292     :reader param-single-float-minimum
 293     :type single-float)
 294    (maximum
 295     :allocation :alien
 296     :reader param-single-float-maximum
 297     :type single-float)
 298    (default-value
 299     :allocation :alien
 300     :reader param-single-float-default-value
 301     :type single-float)
 302    (epsilon
 303     :allocation :alien
 304     :reader param-single-float-epsilon
 305     :type single-float))
 306   (:metaclass param-spec-class)
 307   (:gtype "GParamFloat"))
 308
 309 (defclass param-double-float (param)
 310   ((minimum
 311     :allocation :alien
 312     :reader param-double-float-minimum
 313     :type double-float)
 314    (maximum
 315     :allocation :alien
 316     :reader param-double-float-maximum
 317     :type double-float)
 318    (default-value
 319     :allocation :alien
 320     :reader param-double-float-default-value
 321     :type double-float)
 322    (epsilon
 323     :allocation :alien
 324     :reader param-double-float-epsilon
 325     :type double-float))
 326   (:metaclass param-spec-class)
 327   (:gtype "GParamDouble"))
 328
 329 (defclass param-string (param)
 330   ((default-value
 331     :allocation :alien
 332     :reader param-string-default-value
 333     :type string))
 334   (:metaclass param-spec-class)
 335   (:gtype "GParamString"))
 336
 337 (defclass param-param (param)
 338   ()
 339   (:metaclass param-spec-class)
 340   (:gtype "GParamParam"))
 341
 342 (defclass param-boxed (param)
 343   ()
 344   (:metaclass param-spec-class)
 345   (:gtype "GParamBoxed"))
 346
 347 (defclass param-pointer (param)
 348   ()
 349   (:metaclass param-spec-class)
 350   (:gtype "GParamPointer"))
 351
 352 (defclass param-value-array (param)
 353   ((element-spec
 354     :allocation :alien
 355     :reader param-value-array-element-spec
 356     :type param)
 357    (length
 358     :allocation :alien
 359     :reader param-value-array-length
 360     :type unsigned-int))
 361   (:metaclass param-spec-class)
 362   (:gtype "GParamValueArray"))
 363
 364 (defclass param-object (param)
 365   ()
 366   (:metaclass param-spec-class)
 367   (:gtype "GParamObject"))
 368
 369 (defclass param-overrride (param)
 370   ()
 371   (:metaclass param-spec-class)
 372   (:gtype "GParamOverride"))