chiark / gitweb /
Added :except keyword to use with :ignore-prefix in DEFINE-TYPES-BY-INTROSPECTION
[clg] / gtk / gtkwidget.lisp
CommitLineData
560af5c5 1;; Common Lisp bindings for GTK+ v2.0
e5b416f0 2;; Copyright (C) 2000-2001 Espen S. Johnsen <espen@users.sourceforge.net>
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
f784870f 18;; $Id: gtkwidget.lisp,v 1.7 2001-12-12 20:24:41 espen Exp $
560af5c5 19
20(in-package "GTK")
21
22
0f2634d2 23(defmethod shared-initialize ((widget widget) names &rest initargs &key parent)
24 (declare (ignore initargs names))
0d270bd9 25 (call-next-method)
e5b416f0 26 (when parent
0f2634d2 27 (let ((old-parent (widget-parent widget))
28 (parent-widget (first (mklist parent)))
e5b416f0 29 (args (rest (mklist parent))))
0f2634d2 30 (when old-parent
31 (container-remove old-parent widget))
e5b416f0 32 (apply #'container-add parent-widget widget args))))
33
0f2634d2 34(defmethod shared-initialize :after ((widget widget) names &rest initargs
35 &key show-all)
36 (declare (ignore initargs names))
e5b416f0 37 (when show-all
38 (widget-show-all widget)))
560af5c5 39
40
e5b416f0 41(defmethod slot-unbound ((class gobject-class) (object widget) slot)
560af5c5 42 (cond
43 ((and (eq slot 'child-slots) (slot-value object 'parent))
44 (with-slots (parent child-slots) object
45 (setf
46 child-slots
47 (make-instance
0d270bd9 48 (gethash (class-of parent) *container-to-child-class-mappings*)
560af5c5 49 :parent parent :child object))))
50 (t (call-next-method))))
51
52
53(defun child-slot-value (widget slot)
54 (slot-value (widget-child-slots widget) slot))
55
56(defun (setf child-slot-value) (value widget slot)
57 (setf (slot-value (widget-child-slots widget) slot) value))
58
59(defmacro with-child-slots (slots widget &body body)
60 `(with-slots ,slots (widget-child-slots ,widget)
61 ,@body))
62
63(defmacro widget-destroyed (place)
64 `(setf ,place nil))
65
0d270bd9 66(defbinding widget-destroy () nil
560af5c5 67 (widget widget))
68
0d270bd9 69(defbinding widget-unparent () nil
560af5c5 70 (widget widget))
71
0d270bd9 72(defbinding widget-show () nil
560af5c5 73 (widget widget))
74
0d270bd9 75(defbinding widget-show-now () nil
560af5c5 76 (widget widget))
77
0d270bd9 78(defbinding widget-hide () nil
560af5c5 79 (widget widget))
80
0d270bd9 81(defbinding widget-show-all () nil
560af5c5 82 (widget widget))
83
0d270bd9 84(defbinding widget-hide-all () nil
560af5c5 85 (widget widget))
86
0d270bd9 87(defbinding widget-map () nil
560af5c5 88 (widget widget))
89
0d270bd9 90(defbinding widget-unmap () nil
560af5c5 91 (widget widget))
92
0d270bd9 93(defbinding widget-realize () nil
560af5c5 94 (widget widget))
95
0d270bd9 96(defbinding widget-unrealize () nil
560af5c5 97 (widget widget))
98
f784870f 99#|
0d270bd9 100(defbinding widget-add-accelerator
560af5c5 101 (widget signal accel-group key modifiers flags) nil
102 (widget widget)
103 ((name-to-string signal) string)
104 (accel-group accel-group)
105 ((gdk:keyval-from-name key) unsigned-int)
106 (modifiers gdk:modifier-type)
107 (flags accel-flags))
108
0d270bd9 109(defbinding widget-remove-accelerator
560af5c5 110 (widget accel-group key modifiers) nil
111 (widget widget)
112 (accel-group accel-group)
113 ((gdk:keyval-from-name key) unsigned-int)
114 (modifiers gdk:modifier-type))
115
0d270bd9 116(defbinding widget-accelerator-signal
560af5c5 117 (widget accel-group key modifiers) unsigned-int
118 (widget widget)
119 (accel-group accel-group)
120 ((gdk:keyval-from-name key) unsigned-int)
121 (modifiers gdk:modifier-type))
122
0d270bd9 123(defbinding widget-lock-accelerators () nil
560af5c5 124 (widget widget))
125
0d270bd9 126(defbinding widget-unlock-accelerators () nil
560af5c5 127 (widget widget))
128
0d270bd9 129(defbinding (widget-accelerators-locked-p "gtk_widget_accelerators_locked")
130 () boolean
560af5c5 131 (widget widget))
f784870f 132|#
560af5c5 133
0d270bd9 134(defbinding widget-event () int
560af5c5 135 (widget widget)
136 (event gdk:event))
137
0d270bd9 138(defbinding get-event-widget () widget
aace61f5 139 (event gdk:event))
140
0d270bd9 141(defbinding widget-activate () boolean
560af5c5 142 (widget widget))
143
0d270bd9 144(defbinding widget-set-scroll-adjustments () boolean
560af5c5 145 (widget widget)
146 (hadjustment adjustment)
147 (vadjustment adjustment))
148
0d270bd9 149(defbinding widget-reparent () nil
560af5c5 150 (widget widget)
151 (new-parent widget))
152
0d270bd9 153; (defbinding widget-popup () nil
154; (widget widget)
155; (x int)
156; (y int))
560af5c5 157
0d270bd9 158(defbinding widget-grab-focus () nil
560af5c5 159 (widget widget))
160
0d270bd9 161(defbinding widget-grab-default () nil
560af5c5 162 (widget widget))
163
0d270bd9 164(defbinding grab-add () nil
aace61f5 165 (widget widget))
166
0d270bd9 167(defbinding grab-get-current () widget)
aace61f5 168
0d270bd9 169(defbinding grab-remove () nil
aace61f5 170 (widget widget))
171
0d270bd9 172(defbinding widget-allocation () nil
560af5c5 173 (widget widget)
174 (width int :out)
175 (height int :out))
176
0d270bd9 177(defbinding widget-add-events () nil
560af5c5 178 (widget widget)
179 (events gdk:event-mask))
180
0d270bd9 181(defbinding (widget-toplevel "gtk_widget_get_toplevel") () widget
560af5c5 182 (widget widget))
183
0d270bd9 184(defbinding (widget-ancestor "gtk_widget_get_ancestor") (widget type) widget
560af5c5 185 (widget widget)
186 ((find-type-number type) type-number))
187
0d270bd9 188(defbinding (widget-pointer "gtk_widget_get_pointer") () nil
560af5c5 189 (widget widget)
190 (x int :out)
191 (y int :out))
192
0d270bd9 193(defbinding (widget-is-ancestor-p "gtk_widget_is_ancestor") () boolean
560af5c5 194 (widget widget)
195 (ancestor widget))
196
0d270bd9 197(defbinding widget-ensure-style () nil
560af5c5 198 (widget widget))
199
0d270bd9 200(defbinding widget-reset-rc-styles () nil
560af5c5 201 (widget widget))
202
203(defun (setf widget-cursor) (cursor-type widget)
204 (let ((cursor (gdk:cursor-new cursor-type))
205 (window (widget-window widget)))
206 (gdk:window-set-cursor window cursor)
207 ;(gdk:cursor-destroy cursor)
208 ))
209
210;; Push/pop pairs, to change default values upon a widget's creation.
211;; This will override the values that got set by the
212;; widget-set-default-* functions.
213
0d270bd9 214(defbinding widget-push-colormap () nil
560af5c5 215 (colormap gdk:colormap))
216
0d270bd9 217(defbinding widget-push-composite-child () nil)
560af5c5 218
0d270bd9 219(defbinding widget-pop-colormap () nil)
560af5c5 220
0d270bd9 221(defbinding widget-pop-composite-child () nil)
560af5c5 222
223
224;; Set certain default values to be used at widget creation time.
225
0d270bd9 226(defbinding widget-set-default-colormap () nil
560af5c5 227 (colormap gdk:colormap))
228
0d270bd9 229(defbinding widget-get-default-style () style)
560af5c5 230
0d270bd9 231(defbinding widget-get-default-colormap () gdk:colormap)
560af5c5 232
0d270bd9 233(defbinding widget-shape-combine-mask () nil
560af5c5 234 (widget widget)
235 (shape-mask gdk:bitmap)
236 (x-offset int)
237 (y-offset int))
238
aace61f5 239;; defined in gtkglue.c
0d270bd9 240(defbinding widget-mapped-p () boolean
560af5c5 241 (widget widget))
242