chiark / gitweb /
Type definitions now done by introspection
[clg] / gtk / gtkwidget.lisp
CommitLineData
560af5c5 1;; Common Lisp bindings for GTK+ v2.0
2;; Copyright (C) 2000 Espen S. Johnsen <espejohn@online.no>
3;;
4;; This library is free software; you can redistribute it and/or
5;; modify it under the terms of the GNU Lesser General Public
6;; License as published by the Free Software Foundation; either
7;; version 2 of the License, or (at your option) any later version.
8;;
9;; This library is distributed in the hope that it will be useful,
10;; but WITHOUT ANY WARRANTY; without even the implied warranty of
11;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12;; Lesser General Public License for more details.
13;;
14;; You should have received a copy of the GNU Lesser General Public
15;; License along with this library; if not, write to the Free Software
16;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
17
449a6ce9 18;; $Id: gtkwidget.lisp,v 1.3 2000-10-05 17:34:53 espen Exp $
560af5c5 19
20(in-package "GTK")
21
22
560af5c5 23(defmethod initialize-instance ((widget widget) &rest initargs &key parent)
24 (declare (ignore initargs))
25 (cond
26 ((consp parent)
27 (with-slots ((container parent) child-slots) widget
28 (setf
29 container (car parent)
30 child-slots
31 (apply
32 #'make-instance
33 (slot-value (class-of container) 'child-class)
34 :parent container :child widget (cdr parent)))))
35 (parent
36 (setf (slot-value widget 'parent) parent)))
37 (call-next-method))
38
39
40(defmethod slot-unbound ((class object-class) (object widget) slot)
41 (cond
42 ((and (eq slot 'child-slots) (slot-value object 'parent))
43 (with-slots (parent child-slots) object
44 (setf
45 child-slots
46 (make-instance
47 (slot-value (class-of parent) 'child-class)
48 :parent parent :child object))))
49 (t (call-next-method))))
50
51
52(defun child-slot-value (widget slot)
53 (slot-value (widget-child-slots widget) slot))
54
55(defun (setf child-slot-value) (value widget slot)
56 (setf (slot-value (widget-child-slots widget) slot) value))
57
58(defmacro with-child-slots (slots widget &body body)
59 `(with-slots ,slots (widget-child-slots ,widget)
60 ,@body))
61
62(defmacro widget-destroyed (place)
63 `(setf ,place nil))
64
65(define-foreign widget-destroy () nil
66 (widget widget))
67
68(define-foreign widget-unparent () nil
69 (widget widget))
70
71(define-foreign widget-show () nil
72 (widget widget))
73
74(define-foreign widget-show-now () nil
75 (widget widget))
76
77(define-foreign widget-hide () nil
78 (widget widget))
79
80(define-foreign widget-show-all () nil
81 (widget widget))
82
83(define-foreign widget-hide-all () nil
84 (widget widget))
85
86(define-foreign widget-map () nil
87 (widget widget))
88
89(define-foreign widget-unmap () nil
90 (widget widget))
91
92(define-foreign widget-realize () nil
93 (widget widget))
94
95(define-foreign widget-unrealize () nil
96 (widget widget))
97
98(define-foreign widget-add-accelerator
99 (widget signal accel-group key modifiers flags) nil
100 (widget widget)
101 ((name-to-string signal) string)
102 (accel-group accel-group)
103 ((gdk:keyval-from-name key) unsigned-int)
104 (modifiers gdk:modifier-type)
105 (flags accel-flags))
106
107(define-foreign widget-remove-accelerator
108 (widget accel-group key modifiers) nil
109 (widget widget)
110 (accel-group accel-group)
111 ((gdk:keyval-from-name key) unsigned-int)
112 (modifiers gdk:modifier-type))
113
114(define-foreign widget-accelerator-signal
115 (widget accel-group key modifiers) unsigned-int
116 (widget widget)
117 (accel-group accel-group)
118 ((gdk:keyval-from-name key) unsigned-int)
119 (modifiers gdk:modifier-type))
120
121(define-foreign widget-lock-accelerators () nil
122 (widget widget))
123
124(define-foreign widget-unlock-accelerators () nil
125 (widget widget))
126
127(define-foreign
128 ("gtk_widget_accelerators_locked" widget-accelerators-locked-p) () boolean
129 (widget widget))
130
131(define-foreign widget-event () int
132 (widget widget)
133 (event gdk:event))
134
aace61f5 135(define-foreign get-event-widget () widget
136 (event gdk:event))
137
560af5c5 138(define-foreign widget-activate () boolean
139 (widget widget))
140
141(define-foreign widget-set-scroll-adjustments () boolean
142 (widget widget)
143 (hadjustment adjustment)
144 (vadjustment adjustment))
145
146(define-foreign widget-reparent () nil
147 (widget widget)
148 (new-parent widget))
149
150(define-foreign widget-popup () nil
151 (widget widget)
152 (x int)
153 (y int))
154
155(define-foreign widget-grab-focus () nil
156 (widget widget))
157
158(define-foreign widget-grab-default () nil
159 (widget widget))
160
aace61f5 161(define-foreign grab-add () nil
162 (widget widget))
163
164(define-foreign grab-get-current () widget)
165
166(define-foreign grab-remove () nil
167 (widget widget))
168
560af5c5 169(define-foreign widget-allocation () nil
170 (widget widget)
171 (width int :out)
172 (height int :out))
173
174
175(define-foreign widget-set-uposition (widget &key (x t) (y t)) nil
176 (widget widget)
177 ((case x
178 ((t) -2)
179 ((nil) -1)
180 (otherwise x)) int)
181 ((case y
182 ((t) -2)
183 ((nil) -1)
184 (otherwise y)) int))
185
186(define-foreign widget-add-events () nil
187 (widget widget)
188 (events gdk:event-mask))
189
190(define-foreign ("gtk_widget_get_toplevel" widget-toplevel) () widget
191 (widget widget))
192
193(define-foreign ("gtk_widget_get_ancestor"
194 widget-ancestor) (widget type) widget
195 (widget widget)
196 ((find-type-number type) type-number))
197
198; (define-foreign ("gtk_widget_get_colormap" widget-colormap) () gdk:colormap
199; (widget widget))
200
201; (define-foreign ("gtk_widget_get_visual" widget-visual) () gdk:visual
202; (widget widget))
203
204(define-foreign ("gtk_widget_get_pointer" widget-pointer) () nil
205 (widget widget)
206 (x int :out)
207 (y int :out))
208
209(define-foreign ("gtk_widget_is_ancestor" widget-is-ancestor-p) () boolean
210 (widget widget)
211 (ancestor widget))
212
213(define-foreign widget-set-rc-style () nil
214 (widget widget))
215
216(define-foreign widget-ensure-style () nil
217 (widget widget))
218
219(define-foreign widget-restore-default-style () nil
220 (widget widget))
221
222(define-foreign widget-reset-rc-styles () nil
223 (widget widget))
224
225(defun (setf widget-cursor) (cursor-type widget)
226 (let ((cursor (gdk:cursor-new cursor-type))
227 (window (widget-window widget)))
228 (gdk:window-set-cursor window cursor)
229 ;(gdk:cursor-destroy cursor)
230 ))
231
232;; Push/pop pairs, to change default values upon a widget's creation.
233;; This will override the values that got set by the
234;; widget-set-default-* functions.
235
236(define-foreign widget-push-style () nil
237 (style style))
238
239(define-foreign widget-push-colormap () nil
240 (colormap gdk:colormap))
241
242; (define-foreign widget-push-visual () nil
243; (visual gdk:visual))
244
245(define-foreign widget-push-composite-child () nil)
246
247(define-foreign widget-pop-style () nil)
248
249(define-foreign widget-pop-colormap () nil)
250
251;(define-foreign widget-pop-visual () nil)
252
253(define-foreign widget-pop-composite-child () nil)
254
255
256;; Set certain default values to be used at widget creation time.
257
258(define-foreign widget-set-default-style () nil
259 (style style))
260
261(define-foreign widget-set-default-colormap () nil
262 (colormap gdk:colormap))
263
264; (define-foreign widget-set-default-visual () nil
265; (visual gdk:visual))
266
267(define-foreign widget-get-default-style () style)
268
269(define-foreign widget-get-default-colormap () gdk:colormap)
270
271(define-foreign widget-get-default-visual () gdk:visual)
272
273(define-foreign widget-shape-combine-mask () nil
274 (widget widget)
275 (shape-mask gdk:bitmap)
276 (x-offset int)
277 (y-offset int))
278
aace61f5 279;; defined in gtkglue.c
560af5c5 280(define-foreign widget-mapped-p () boolean
281 (widget widget))
282