1 ;; Common Lisp bindings for GTK+ v2.0
2 ;; Copyright (C) 2000 Espen S. Johnsen <espejohn@online.no>
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.
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.
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
18 ;; $Id: gtkwidget.lisp,v 1.2 2000/08/16 22:16:44 espen Exp $
23 (eval-when (:compile-toplevel :load-toplevel :execute)
24 (defclass widget (object)
27 :accessor widget-child-slots
28 :type container-child)
36 :accessor widget-parent
41 :accessor widget-x-position
46 :accessor widget-y-position
51 :accessor widget-width
56 :accessor widget-height
61 :accessor widget-visible-p
66 :accessor widget-sensitive-p
71 :reader widget-app-paintable-p
76 :accessor widget-can-focus-p
81 :accessor widget-has-focus-p
86 :accessor widget-can-default-p
91 :accessor widget-has-default-p
96 :accessor widget-receives-default-p
97 :initarg :receives-default
101 :accessor widget-composite-child-p
102 :initarg :composite-child
106 ; :accessor widget-style
111 :accessor widget-events
113 :type gdk:event-mask)
116 :accessor widget-extension-events
117 :initarg :extpension-events
118 :type gdk:event-mask)
121 :location ("gtk_widget_get_state" "gtk_widget_set_state")
122 :accessor widget-state
127 :location "gtk_widget_get_window"
128 :reader widget-window
132 :location "gtk_widget_get_colormap"
133 :reader widget-colormap
137 :location "gtk_widget_get_visual"
138 :reader widget-visual
140 (:metaclass object-class)
141 (:alien-name "GtkWidget")))
144 (defmethod initialize-instance ((widget widget) &rest initargs &key parent)
145 (declare (ignore initargs))
148 (with-slots ((container parent) child-slots) widget
150 container (car parent)
154 (slot-value (class-of container) 'child-class)
155 :parent container :child widget (cdr parent)))))
157 (setf (slot-value widget 'parent) parent)))
161 (defmethod slot-unbound ((class object-class) (object widget) slot)
163 ((and (eq slot 'child-slots) (slot-value object 'parent))
164 (with-slots (parent child-slots) object
168 (slot-value (class-of parent) 'child-class)
169 :parent parent :child object))))
170 (t (call-next-method))))
173 (defun child-slot-value (widget slot)
174 (slot-value (widget-child-slots widget) slot))
176 (defun (setf child-slot-value) (value widget slot)
177 (setf (slot-value (widget-child-slots widget) slot) value))
179 (defmacro with-child-slots (slots widget &body body)
180 `(with-slots ,slots (widget-child-slots ,widget)
183 (defmacro widget-destroyed (place)
186 (define-foreign widget-destroy () nil
189 (define-foreign widget-unparent () nil
192 (define-foreign widget-show () nil
195 (define-foreign widget-show-now () nil
198 (define-foreign widget-hide () nil
201 (define-foreign widget-show-all () nil
204 (define-foreign widget-hide-all () nil
207 (define-foreign widget-map () nil
210 (define-foreign widget-unmap () nil
213 (define-foreign widget-realize () nil
216 (define-foreign widget-unrealize () nil
219 (define-foreign widget-add-accelerator
220 (widget signal accel-group key modifiers flags) nil
222 ((name-to-string signal) string)
223 (accel-group accel-group)
224 ((gdk:keyval-from-name key) unsigned-int)
225 (modifiers gdk:modifier-type)
228 (define-foreign widget-remove-accelerator
229 (widget accel-group key modifiers) nil
231 (accel-group accel-group)
232 ((gdk:keyval-from-name key) unsigned-int)
233 (modifiers gdk:modifier-type))
235 (define-foreign widget-accelerator-signal
236 (widget accel-group key modifiers) unsigned-int
238 (accel-group accel-group)
239 ((gdk:keyval-from-name key) unsigned-int)
240 (modifiers gdk:modifier-type))
242 (define-foreign widget-lock-accelerators () nil
245 (define-foreign widget-unlock-accelerators () nil
249 ("gtk_widget_accelerators_locked" widget-accelerators-locked-p) () boolean
252 (define-foreign widget-event () int
256 (define-foreign get-event-widget () widget
259 (define-foreign widget-activate () boolean
262 (define-foreign widget-set-scroll-adjustments () boolean
264 (hadjustment adjustment)
265 (vadjustment adjustment))
267 (define-foreign widget-reparent () nil
271 (define-foreign widget-popup () nil
276 (define-foreign widget-grab-focus () nil
279 (define-foreign widget-grab-default () nil
282 (define-foreign grab-add () nil
285 (define-foreign grab-get-current () widget)
287 (define-foreign grab-remove () nil
290 (define-foreign widget-allocation () nil
296 (define-foreign widget-set-uposition (widget &key (x t) (y t)) nil
307 (define-foreign widget-add-events () nil
309 (events gdk:event-mask))
311 (define-foreign ("gtk_widget_get_toplevel" widget-toplevel) () widget
314 (define-foreign ("gtk_widget_get_ancestor"
315 widget-ancestor) (widget type) widget
317 ((find-type-number type) type-number))
319 ; (define-foreign ("gtk_widget_get_colormap" widget-colormap) () gdk:colormap
322 ; (define-foreign ("gtk_widget_get_visual" widget-visual) () gdk:visual
325 (define-foreign ("gtk_widget_get_pointer" widget-pointer) () nil
330 (define-foreign ("gtk_widget_is_ancestor" widget-is-ancestor-p) () boolean
334 (define-foreign widget-set-rc-style () nil
337 (define-foreign widget-ensure-style () nil
340 (define-foreign widget-restore-default-style () nil
343 (define-foreign widget-reset-rc-styles () nil
346 (defun (setf widget-cursor) (cursor-type widget)
347 (let ((cursor (gdk:cursor-new cursor-type))
348 (window (widget-window widget)))
349 (gdk:window-set-cursor window cursor)
350 ;(gdk:cursor-destroy cursor)
353 ;; Push/pop pairs, to change default values upon a widget's creation.
354 ;; This will override the values that got set by the
355 ;; widget-set-default-* functions.
357 (define-foreign widget-push-style () nil
360 (define-foreign widget-push-colormap () nil
361 (colormap gdk:colormap))
363 ; (define-foreign widget-push-visual () nil
364 ; (visual gdk:visual))
366 (define-foreign widget-push-composite-child () nil)
368 (define-foreign widget-pop-style () nil)
370 (define-foreign widget-pop-colormap () nil)
372 ;(define-foreign widget-pop-visual () nil)
374 (define-foreign widget-pop-composite-child () nil)
377 ;; Set certain default values to be used at widget creation time.
379 (define-foreign widget-set-default-style () nil
382 (define-foreign widget-set-default-colormap () nil
383 (colormap gdk:colormap))
385 ; (define-foreign widget-set-default-visual () nil
386 ; (visual gdk:visual))
388 (define-foreign widget-get-default-style () style)
390 (define-foreign widget-get-default-colormap () gdk:colormap)
392 (define-foreign widget-get-default-visual () gdk:visual)
394 (define-foreign widget-shape-combine-mask () nil
396 (shape-mask gdk:bitmap)
400 ;; defined in gtkglue.c
401 (define-foreign widget-mapped-p () boolean