chiark / gitweb /
Changed define-foreign to defbinding
[clg] / gtk / gtkwidget.lisp
CommitLineData
560af5c5 1;; Common Lisp bindings for GTK+ v2.0
0d270bd9 2;; Copyright (C) 2000-2001 Espen S. Johnsen <esj@stud.cs.uit.no>
560af5c5 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
0d270bd9 18;; $Id: gtkwidget.lisp,v 1.4 2001-05-29 15:58:24 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))
0d270bd9 25 (call-next-method)
560af5c5 26 (cond
27 ((consp parent)
28 (with-slots ((container parent) child-slots) widget
29 (setf
30 container (car parent)
31 child-slots
32 (apply
33 #'make-instance
34 (slot-value (class-of container) 'child-class)
35 :parent container :child widget (cdr parent)))))
36 (parent
0d270bd9 37 (setf (slot-value widget 'parent) parent))))
560af5c5 38
39
0d270bd9 40(defmethod slot-unbound ((class gobject) (object widget) slot)
560af5c5 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
0d270bd9 47 (gethash (class-of parent) *container-to-child-class-mappings*)
560af5c5 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
0d270bd9 65(defbinding widget-destroy () nil
560af5c5 66 (widget widget))
67
0d270bd9 68(defbinding widget-unparent () nil
560af5c5 69 (widget widget))
70
0d270bd9 71(defbinding widget-show () nil
560af5c5 72 (widget widget))
73
0d270bd9 74(defbinding widget-show-now () nil
560af5c5 75 (widget widget))
76
0d270bd9 77(defbinding widget-hide () nil
560af5c5 78 (widget widget))
79
0d270bd9 80(defbinding widget-show-all () nil
560af5c5 81 (widget widget))
82
0d270bd9 83(defbinding widget-hide-all () nil
560af5c5 84 (widget widget))
85
0d270bd9 86(defbinding widget-map () nil
560af5c5 87 (widget widget))
88
0d270bd9 89(defbinding widget-unmap () nil
560af5c5 90 (widget widget))
91
0d270bd9 92(defbinding widget-realize () nil
560af5c5 93 (widget widget))
94
0d270bd9 95(defbinding widget-unrealize () nil
560af5c5 96 (widget widget))
97
0d270bd9 98(defbinding widget-add-accelerator
560af5c5 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
0d270bd9 107(defbinding widget-remove-accelerator
560af5c5 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
0d270bd9 114(defbinding widget-accelerator-signal
560af5c5 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
0d270bd9 121(defbinding widget-lock-accelerators () nil
560af5c5 122 (widget widget))
123
0d270bd9 124(defbinding widget-unlock-accelerators () nil
560af5c5 125 (widget widget))
126
0d270bd9 127(defbinding (widget-accelerators-locked-p "gtk_widget_accelerators_locked")
128 () boolean
560af5c5 129 (widget widget))
130
0d270bd9 131(defbinding widget-event () int
560af5c5 132 (widget widget)
133 (event gdk:event))
134
0d270bd9 135(defbinding get-event-widget () widget
aace61f5 136 (event gdk:event))
137
0d270bd9 138(defbinding widget-activate () boolean
560af5c5 139 (widget widget))
140
0d270bd9 141(defbinding widget-set-scroll-adjustments () boolean
560af5c5 142 (widget widget)
143 (hadjustment adjustment)
144 (vadjustment adjustment))
145
0d270bd9 146(defbinding widget-reparent () nil
560af5c5 147 (widget widget)
148 (new-parent widget))
149
0d270bd9 150; (defbinding widget-popup () nil
151; (widget widget)
152; (x int)
153; (y int))
560af5c5 154
0d270bd9 155(defbinding widget-grab-focus () nil
560af5c5 156 (widget widget))
157
0d270bd9 158(defbinding widget-grab-default () nil
560af5c5 159 (widget widget))
160
0d270bd9 161(defbinding grab-add () nil
aace61f5 162 (widget widget))
163
0d270bd9 164(defbinding grab-get-current () widget)
aace61f5 165
0d270bd9 166(defbinding grab-remove () nil
aace61f5 167 (widget widget))
168
0d270bd9 169(defbinding widget-allocation () nil
560af5c5 170 (widget widget)
171 (width int :out)
172 (height int :out))
173
174
0d270bd9 175(defbinding widget-set-uposition (widget &key (x t) (y t)) nil
560af5c5 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
0d270bd9 186(defbinding widget-add-events () nil
560af5c5 187 (widget widget)
188 (events gdk:event-mask))
189
0d270bd9 190(defbinding (widget-toplevel "gtk_widget_get_toplevel") () widget
560af5c5 191 (widget widget))
192
0d270bd9 193(defbinding (widget-ancestor "gtk_widget_get_ancestor") (widget type) widget
560af5c5 194 (widget widget)
195 ((find-type-number type) type-number))
196
0d270bd9 197; (defbinding ("gtk_widget_get_colormap" widget-colormap) () gdk:colormap
560af5c5 198; (widget widget))
199
0d270bd9 200; (defbinding ("gtk_widget_get_visual" widget-visual) () gdk:visual
560af5c5 201; (widget widget))
202
0d270bd9 203(defbinding (widget-pointer "gtk_widget_get_pointer") () nil
560af5c5 204 (widget widget)
205 (x int :out)
206 (y int :out))
207
0d270bd9 208(defbinding (widget-is-ancestor-p "gtk_widget_is_ancestor") () boolean
560af5c5 209 (widget widget)
210 (ancestor widget))
211
0d270bd9 212(defbinding widget-set-rc-style () nil
560af5c5 213 (widget widget))
214
0d270bd9 215(defbinding widget-ensure-style () nil
560af5c5 216 (widget widget))
217
0d270bd9 218(defbinding widget-restore-default-style () nil
560af5c5 219 (widget widget))
220
0d270bd9 221(defbinding widget-reset-rc-styles () nil
560af5c5 222 (widget widget))
223
224(defun (setf widget-cursor) (cursor-type widget)
225 (let ((cursor (gdk:cursor-new cursor-type))
226 (window (widget-window widget)))
227 (gdk:window-set-cursor window cursor)
228 ;(gdk:cursor-destroy cursor)
229 ))
230
231;; Push/pop pairs, to change default values upon a widget's creation.
232;; This will override the values that got set by the
233;; widget-set-default-* functions.
234
0d270bd9 235(defbinding widget-push-style () nil
560af5c5 236 (style style))
237
0d270bd9 238(defbinding widget-push-colormap () nil
560af5c5 239 (colormap gdk:colormap))
240
0d270bd9 241; (defbinding widget-push-visual () nil
560af5c5 242; (visual gdk:visual))
243
0d270bd9 244(defbinding widget-push-composite-child () nil)
560af5c5 245
0d270bd9 246(defbinding widget-pop-style () nil)
560af5c5 247
0d270bd9 248(defbinding widget-pop-colormap () nil)
560af5c5 249
0d270bd9 250;(defbinding widget-pop-visual () nil)
560af5c5 251
0d270bd9 252(defbinding widget-pop-composite-child () nil)
560af5c5 253
254
255;; Set certain default values to be used at widget creation time.
256
0d270bd9 257(defbinding widget-set-default-style () nil
560af5c5 258 (style style))
259
0d270bd9 260(defbinding widget-set-default-colormap () nil
560af5c5 261 (colormap gdk:colormap))
262
0d270bd9 263; (defbinding widget-set-default-visual () nil
560af5c5 264; (visual gdk:visual))
265
0d270bd9 266(defbinding widget-get-default-style () style)
560af5c5 267
0d270bd9 268(defbinding widget-get-default-colormap () gdk:colormap)
560af5c5 269
0d270bd9 270(defbinding widget-get-default-visual () gdk:visual)
560af5c5 271
0d270bd9 272(defbinding widget-shape-combine-mask () nil
560af5c5 273 (widget widget)
274 (shape-mask gdk:bitmap)
275 (x-offset int)
276 (y-offset int))
277
aace61f5 278;; defined in gtkglue.c
0d270bd9 279(defbinding widget-mapped-p () boolean
560af5c5 280 (widget widget))
281