Refactor gtype-from-id, gtype-from-name
[cl-gtk2.git] / gtk / gtk.objects.lisp
blob1516e70859ed2e78c591222f50494d5e0355ee75
1 (in-package :gtk)
3 (define-g-boxed-cstruct border "GtkBorder"
4 (left :int :initform 0)
5 (right :int :initform 0)
6 (top :int :initform 0)
7 (bottom :int :initform 0))
9 (at-init () (foreign-funcall "gtk_border_get_type" :int))
10 (at-init () (foreign-funcall "gtk_ui_manager_get_type" :int))
12 (export (boxed-related-symbols 'border))
14 (define-foreign-type pointer-as-integer-foreign-type ()
16 (:actual-type :pointer)
17 (:simple-parser pointer-as-integer))
19 (defmethod translate-to-foreign (value (type pointer-as-integer-foreign-type))
20 (make-pointer value))
22 (defmethod translate-from-foreign (value (type pointer-as-integer-foreign-type))
23 (pointer-address value))
25 (define-g-boxed-cstruct tree-iter "GtkTreeIter"
26 (stamp :int :initform 0)
27 (user-data pointer-as-integer :initform 0)
28 (user-data-2 pointer-as-integer :initform 0)
29 (user-data-3 pointer-as-integer :initform 0))
31 (export 'tree-iter)
32 (export 'tree-iter-stamp)
33 (export 'tree-iter-user-data)
35 (defctype tree-path :pointer)
37 (defcfun gtk-tree-path-new :pointer)
38 (defcfun gtk-tree-path-free :void (path :pointer))
40 (define-g-boxed-opaque tree-path "GtkTreePath"
41 :alloc (gtk-tree-path-new))
43 (defcfun (%gtk-tree-path-get-depth "gtk_tree_path_get_depth") :int
44 (path tree-path))
46 (defcfun (%gtk-tree-path-get-indices "gtk_tree_path_get_indices") (:pointer :int)
47 (path tree-path))
49 (defcfun (%gtk-tree-path-append-index "gtk_tree_path_append_index") :void
50 (path :pointer)
51 (index :int))
53 (defun tree-path-indices (path)
54 (tree-path-get-indices path))
56 (defun (setf tree-path-indices) (new-value path)
57 (tree-path-set-indices new-value path))
59 (defun tree-path-get-indices (path)
60 (setf path (pointer path))
61 (let ((n (%gtk-tree-path-get-depth path))
62 (indices (%gtk-tree-path-get-indices path)))
63 (loop
64 for i from 0 below n
65 collect (mem-aref indices :int i))))
67 (defun tree-path-set-indices (indices path)
68 (setf path (pointer path))
69 (loop
70 repeat (%gtk-tree-path-get-depth path)
71 do (foreign-funcall "gtk_tree_path_up" :pointer path :boolean))
72 (loop
73 for index in indices
74 do(foreign-funcall "gtk_tree_path_append_index" :pointer path :int index :void)))
76 (export 'tree-path)
77 (export 'tree-path-indices)
79 (defcfun (tree-path-compare "gtk_tree_path_compare") :int
80 (tree-path-1 (g-boxed-foreign tree-path))
81 (tree-path-2 (g-boxed-foreign tree-path)))
83 (export 'tree-path-compare)
85 (defcfun (tree-path-next "gtk_tree_path_next") :void
86 (tree-path (g-boxed-foreign tree-path)))
88 (export 'tree-path-next)
90 (defcfun (tree-path-prev "gtk_tree_path_prev") :void
91 (tree-path (g-boxed-foreign tree-path)))
93 (export 'tree-path-prev)
95 (defcfun (tree-path-up "gtk_tree_path_up") :boolean
96 (tree-path (g-boxed-foreign tree-path)))
98 (export 'tree-path-up)
100 (defcfun (tree-path-down "gtk_tree_path_down") :void
101 (tree-path (g-boxed-foreign tree-path)))
103 (export 'tree-path-down)
105 (defcfun (tree-path-is-ancestor "gtk_tree_path_is_ancestor") :boolean
106 (tree-path (g-boxed-foreign tree-path))
107 (descendant (g-boxed-foreign tree-path)))
109 (export 'tree-path-is-ancestor)
111 (defcfun (tree-path-is-descendant "gtk_tree_path_is_descendant") :boolean
112 (tree-path (g-boxed-foreign tree-path))
113 (ancestor (g-boxed-foreign tree-path)))
115 (export 'tree-path-is-descendant)
117 (at-init () (gobject::type-initializer-call "gtk_tree_row_reference_get_type"))
119 (define-g-boxed-opaque tree-row-reference "GtkTreeRowReference" :alloc (lambda () (error "")))
121 (export 'tree-row-reference)
123 (defcfun (tree-row-reference-new "gtk_tree_row_reference_new") (g-boxed-foreign tree-row-reference :return)
124 (model (g-object tree-model))
125 (path (g-boxed-foreign tree-path)))
127 (export 'tree-row-reference)
129 (define-boxed-opaque-accessor tree-row-reference tree-row-reference-model
130 :reader "gtk_tree_row_reference_get_model" :type (g-object tree-model))
132 (define-boxed-opaque-accessor tree-row-reference tree-row-reference-path
133 :reader "gtk_tree_row_reference_get_path" :type (g-boxed-foreign tree-path :return))
135 (define-boxed-opaque-accessor tree-row-reference tree-row-reference-valid
136 :reader "gtk_tree_row_reference_valid" :type :boolean)
138 (export '(tree-row-reference-model tree-row-reference-path tree-row-reference-valid))
140 (defcfun (adjustment-clamp-page "gtk_adjustment_clamp_page") :void
141 (adjustment (g-object adjustment))
142 (lower :double)
143 (upper :double))
145 (export 'adjustment-clamp-page)
147 (define-g-boxed-cstruct requisition "GtkRequisition"
148 (width :int :initform 0)
149 (height :int :initform 0))
151 (export (boxed-related-symbols 'requisition))
153 (define-g-boxed-cstruct allocation "GtkAllocation"
154 (x :int :initform 0)
155 (y :int :initform 0)
156 (width :int :initform 0)
157 (height :int :initform 0))
159 (export (boxed-related-symbols 'allocation))
161 (defcfun (h-s-v-set-color "gtk_hsv_set_color") :void
162 (h-s-v (g-object h-s-v))
163 (h :double)
164 (s :double)
165 (v :double))
167 (export 'h-s-v-set-color)
169 (defcfun gtk-hsv-get-color :void
170 (h-s-v (g-object h-s-v))
171 (h (:pointer :double))
172 (s (:pointer :double))
173 (v (:pointer :double)))
175 (defun h-s-v-get-color (h-s-v)
176 (with-foreign-objects ((h :double) (s :double) (v :double))
177 (gtk-hsv-get-color h-s-v h s v)
178 (values (mem-ref h :double) (mem-ref s :double) (mem-ref v :double))))
180 (export 'h-s-v-get-color)
182 (defcfun (h-s-v-set-metrics "gtk_hsv_set_metrics") :void
183 (h-s-v (g-object h-s-v))
184 (size :int)
185 (ring-width :int))
187 (export 'h-s-v-set-metrics)
189 (defcfun gtk-hsv-get-metrics :void
190 (h-s-v (g-object h-s-v))
191 (size (:pointer :int))
192 (ring-width (:pointer :int)))
194 (defun h-s-v-get-metrics (h-s-v)
195 (with-foreign-objects ((size :int) (ring-width :int))
196 (gtk-hsv-get-metrics h-s-v size ring-width)
197 (values (mem-ref size :int) (mem-ref ring-width :int))))
199 (export 'h-s-v-get-metrics)
201 (defcfun (h-s-v-is-adjusting "gtk_hsv_is_adjusting") :boolean
202 (h-s-v (g-object h-s-v)))
204 (export 'h-s-v-is-adjusting)
206 (defcfun gtk-hsv-to-rgb :void
207 (h :double)
208 (s :double)
209 (v :double)
210 (r (:pointer :double))
211 (g (:pointer :double))
212 (b (:pointer :double)))
214 (defun h-s-v-to-r-g-b (h s v)
215 (with-foreign-objects ((r :double) (g :double) (b :double))
216 (gtk-hsv-to-rgb h s v r g b)
217 (values (mem-ref r :double) (mem-ref g :double) (mem-ref b :double))))
219 (export 'h-s-v-to-r-g-b)
221 (defcfun gtk-rgb-to-hsv :void
222 (r :double)
223 (g :double)
224 (b :double)
225 (h (:pointer :double))
226 (s (:pointer :double))
227 (v (:pointer :double)))
229 (defun r-g-b-to-h-s-v (r g b)
230 (with-foreign-objects ((h :double) (s :double) (v :double))
231 (gtk-rgb-to-hsv r g b h s v)
232 (values (mem-ref h :double) (mem-ref s :double) (mem-ref v :double))))
234 (export 'r-g-b-to-h-s-v)