/[gtk-cffi]/gtk-cffi/g-object/g-object-class.lisp
ViewVC logotype

Contents of /gtk-cffi/g-object/g-object-class.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.8 - (show annotations)
Mon Dec 31 13:33:38 2012 UTC (15 months, 2 weeks ago) by rklochkov
Branch: MAIN
CVS Tags: HEAD
Changes since 1.7: +10 -7 lines
Backed to CFFI 10.7 (was version from git)
1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
2 ;;;
3 ;;; g-object-class.lisp --- G-ObjectClass wrappers for Common Lisp
4 ;;;
5 ;;; Copyright (C) 2007, Roman Klochkov <kalimehtar@mail.ru>
6 ;;;
7
8 (in-package #:g-object-cffi)
9
10 (defclass g-object-class (object)
11 ((free-after :initform nil)))
12
13 (defcstruct* g-object-class-struct
14 (type-class g-type-class) ; :struct
15 (construct-properties :pointer)
16 (constructor :pointer)
17 (set-property :pointer)
18 (get-property :pointer)
19 (dispose :pointer)
20 (finalize :pointer)
21 (dispatch-properties-changed :pointer)
22 (notify :pointer)
23 (constructed :pointer)
24 (pdummy :pointer :count 7))
25
26 (defmethod gconstructor ((g-object-class g-object-class) &key object)
27 (mem-ref (pointer object) :pointer))
28
29 (defcfun "g_object_class_list_properties"
30 (garray (object g-param-spec)) (obj-class pobject) (n-props :pointer))
31
32 (defclass g-param-spec (object)
33 ())
34
35 (defmethod list-properties ((g-object-class g-object-class))
36 (g-object-class-list-properties g-object-class *array-length*))
37
38 (defcfun "g_object_class_find_property" :pointer
39 (obj-class pobject) (key :string))
40
41 (defmethod find-property ((g-object-class g-object-class) key)
42 (let ((ptr (g-object-class-find-property g-object-class key)))
43 (unless (null-pointer-p ptr)
44 (make-instance 'g-param-spec :pointer ptr))))
45
46 (defcfun "g_param_spec_get_name" :string (param pobject))
47
48 (defmethod name ((g-param-spec g-param-spec))
49 (g-param-spec-get-name g-param-spec))
50
51 (defcfun "g_param_spec_get_nick" :string (param pobject))
52
53 (defmethod nick ((g-param-spec g-param-spec))
54 (g-param-spec-get-nick g-param-spec))
55
56 (defcfun "g_param_spec_get_blurb" :string (param pobject))
57
58 (defmethod blurb ((g-param-spec g-param-spec))
59 (g-param-spec-get-blurb g-param-spec))
60
61 (defbitfield g-param-flags
62 :readable :writable :construct :construct-only :lax-validation
63 :static-name :static-nick :static-blurb)
64
65 (defcstruct* g-param-spec-struct
66 "GParamSpec"
67 (g-type-instance :pointer)
68 (name :string)
69 (flags g-param-flags)
70 (g-param-spec-type :ulong)
71 (owner-type :ulong))
72
73 (defmethod flags ((g-param-spec g-param-spec))
74 (flags (make-instance 'g-param-spec-struct :pointer (pointer g-param-spec))))
75
76 (defmethod g-type ((g-param-spec g-param-spec) &key owner)
77 (let ((struct (make-instance 'g-param-spec-struct
78 :pointer (pointer g-param-spec))))
79 (if owner
80 (owner-type struct)
81 (g-param-spec-type struct))))
82
83 (defun show-properties (g-object)
84 (let ((gclass (make-instance 'g-object-class :object g-object)))
85 (map nil
86 (lambda (param)
87 (format t "~A~% nick=~A~% blurb=~A~% type=~A
88 owner-type=~A~% flags=~A~%~%"
89 (name param) (nick param) (blurb param)
90 (g-type->lisp (g-type param))
91 (g-type->lisp (g-type param :owner t)) (flags param)))
92 (list-properties gclass))))

  ViewVC Help
Powered by ViewVC 1.1.5