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.1 2000-08-14 16:45:02 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 widget-activate () boolean
259 (define-foreign widget-set-scroll-adjustments () boolean
261 (hadjustment adjustment)
262 (vadjustment adjustment))
264 (define-foreign widget-reparent () nil
268 (define-foreign widget-popup () nil
273 (define-foreign widget-grab-focus () nil
276 (define-foreign widget-grab-default () nil
280 (define-foreign widget-allocation () nil
286 (define-foreign widget-set-uposition (widget &key (x t) (y t)) nil
297 (define-foreign widget-add-events () nil
299 (events gdk:event-mask))
301 (define-foreign ("gtk_widget_get_toplevel" widget-toplevel) () widget
304 (define-foreign ("gtk_widget_get_ancestor"
305 widget-ancestor) (widget type) widget
307 ((find-type-number type) type-number))
309 ; (define-foreign ("gtk_widget_get_colormap" widget-colormap) () gdk:colormap
312 ; (define-foreign ("gtk_widget_get_visual" widget-visual) () gdk:visual
315 (define-foreign ("gtk_widget_get_pointer" widget-pointer) () nil
320 (define-foreign ("gtk_widget_is_ancestor" widget-is-ancestor-p) () boolean
324 (define-foreign widget-set-rc-style () nil
327 (define-foreign widget-ensure-style () nil
330 (define-foreign widget-restore-default-style () nil
333 (define-foreign widget-reset-rc-styles () nil
336 (defun (setf widget-cursor) (cursor-type widget)
337 (let ((cursor (gdk:cursor-new cursor-type))
338 (window (widget-window widget)))
339 (gdk:window-set-cursor window cursor)
340 ;(gdk:cursor-destroy cursor)
343 ;; Push/pop pairs, to change default values upon a widget's creation.
344 ;; This will override the values that got set by the
345 ;; widget-set-default-* functions.
347 (define-foreign widget-push-style () nil
350 (define-foreign widget-push-colormap () nil
351 (colormap gdk:colormap))
353 ; (define-foreign widget-push-visual () nil
354 ; (visual gdk:visual))
356 (define-foreign widget-push-composite-child () nil)
358 (define-foreign widget-pop-style () nil)
360 (define-foreign widget-pop-colormap () nil)
362 ;(define-foreign widget-pop-visual () nil)
364 (define-foreign widget-pop-composite-child () nil)
367 ;; Set certain default values to be used at widget creation time.
369 (define-foreign widget-set-default-style () nil
372 (define-foreign widget-set-default-colormap () nil
373 (colormap gdk:colormap))
375 ; (define-foreign widget-set-default-visual () nil
376 ; (visual gdk:visual))
378 (define-foreign widget-get-default-style () style)
380 (define-foreign widget-get-default-colormap () gdk:colormap)
382 (define-foreign widget-get-default-visual () gdk:visual)
384 (define-foreign widget-shape-combine-mask () nil
386 (shape-mask gdk:bitmap)
391 (define-foreign widget-mapped-p () boolean