1 ;; Common Lisp bindings for GTK+ v2.0
2 ;; Copyright (C) 1999-2001 Espen S. Johnsen <esj@stud.cs.uit.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: gdkevents.lisp,v 1.6 2004/12/20 00:09:57 espen Exp $
23 (defvar *event-classes* (make-hash-table))
26 ;;;; Metaclass for event classes
28 (eval-when (:compile-toplevel :load-toplevel :execute)
29 (defclass event-class (boxed-class)
30 ((event-type :reader event-class-type)))
32 (defmethod validate-superclass ((class event-class) (super standard-class))
33 ;(subtypep (class-name super) 'event)
37 (defmethod shared-initialize ((class event-class) names &key name type)
39 (setf (slot-value class 'event-type) (first type))
40 (setf (gethash (first type) *event-classes*) class)
41 (let ((class-name (or name (class-name class))))
42 (register-type class-name 'event)))
44 (let ((reader (reader-function 'event-type)))
45 (defun %event-class (location)
46 (gethash (funcall reader location 0) *event-classes*)))
48 (defmethod ensure-proxy-instance ((class event-class) location)
49 (declare (ignore class))
50 (let ((class (%event-class location)))
51 (make-instance class :location location)))
56 (eval-when (:compile-toplevel :load-toplevel :execute)
57 (defclass event (boxed)
63 :accessor event-window
68 :accessor event-send-event
71 (:metaclass event-class)))
74 (defmethod initialize-instance ((event event) &rest initargs)
75 (declare (ignore initargs))
77 (setf (slot-value event '%type) (event-class-type (class-of event))))
80 (defclass timed-event (event)
86 (:metaclass event-class))
88 (defclass delete-event (event)
90 (:metaclass event-class)
94 (defclass destroy-event (event)
96 (:metaclass event-class)
99 (defclass expose-event (event)
112 :accessor event-width
117 :accessor event-height
122 :accessor event-region
127 :accessor event-count
130 (:metaclass event-class)
133 (defclass input-event (timed-event)
148 :type pointer) ;double-float)
151 :accessor event-state
153 :type modifier-type))
154 (:metaclass event-class))
157 (defclass motion-notify-event (input-event)
160 :accessor event-is-hint
162 :type (signed 16) ; should it be (boolean 16)?
167 :accessor event-device
172 :accessor event-root-x
177 :accessor event-root-y
180 (:metaclass event-class)
181 (:type :motion-notify))
183 (defclass button-event (input-event)
186 :accessor event-button
191 :accessor event-device
196 :accessor event-root-x
201 :accessor event-root-y
204 (:metaclass event-class))
206 (defclass button-press-event (button-event)
208 (:metaclass event-class)
209 (:type :button-press))
211 (defclass 2-button-press-event (button-press-event)
213 (:metaclass event-class)
214 (:type :2button-press))
216 (defclass 3-button-press-event (button-press-event)
218 (:metaclass event-class)
219 (:type :3button-press))
221 (defclass button-release-event (button-event)
223 (:metaclass event-class)
224 (:type :button-release))
227 (defclass key-event (timed-event)
230 :accessor event-state
235 :accessor event-keyval
240 :accessor event-length
245 :accessor event-string
250 :accessor event-hardware-keycode
251 :initarg :hardware-keycode
255 :accessor event-group
258 (:metaclass event-class))
260 (defclass key-press-event (key-event)
262 (:metaclass event-class)
265 (defclass key-release-event (key-event)
267 (:metaclass event-class)
268 (:type :key-release))
271 (defclass crossing-event (event)
274 :accessor event-subwindow
294 :accessor event-root-x
299 :accessor event-root-y
309 :accessor event-detail
314 :accessor event-focus
319 :accessor event-state
322 (:metaclass event-class))
325 (defclass enter-notify-event (crossing-event)
327 (:metaclass event-class)
328 (:type :enter-notify))
330 (defclass leave-notify-event (crossing-event)
332 (:metaclass event-class)
333 (:type :leave-notify))
335 (defclass focus-change-event (event)
341 (:metaclass event-class)
342 (:type :focus-change))
344 (defclass configure-event (event)
357 :accessor event-width
362 :accessor event-height
365 (:metaclass event-class)
368 (defclass map-event (event)
370 (:metaclass event-class)
373 (defclass unmap-event (event)
375 (:metaclass event-class)
378 (defclass property-notify-event (event)
380 (:metaclass event-class)
381 (:type :property-notify))
383 (defclass selection-clear-event (event)
385 (:metaclass event-class)
386 (:type :selection-clear))
388 (defclass selection-request-event (event)
390 (:metaclass event-class)
391 (:type :selection-request))
393 (defclass selection-notify-event (event)
395 (:metaclass event-class)
396 (:type :selection-notify))
398 (defclass dnd-event (event)
401 :accessor event-contex
411 :accessor event-x-root
416 :accessor event-y-root
419 (:metaclass event-class))
421 (defclass drag-enter-event (dnd-event)
423 (:metaclass event-class)
426 (defclass drag-leave-event (dnd-event)
428 (:metaclass event-class)
431 (defclass drag-motion-event (dnd-event)
433 (:metaclass event-class)
434 (:type :drag-motion))
436 (defclass drag-status-event (dnd-event)
438 (:metaclass event-class)
439 (:type :drag-status))
441 (defclass drot-start-event (dnd-event)
443 (:metaclass event-class)
446 (defclass drop-finished-event (dnd-event)
448 (:metaclass event-class)
449 (:type :drop-finished))
451 (defclass client-event (event)
453 (:metaclass event-class)
454 (:type :client-event))
456 (defclass visibility-notify-event (event)
459 :accessor event-state
461 :type visibility-state))
462 (:metaclass event-class)
463 (:type :visibility-notify))
465 (defclass no-expose-event (event)
467 (:metaclass event-class)
470 (defclass scroll-event (timed-event)
483 :accessor event-state
488 :accessor event-direction
490 :type scroll-direction)
493 :accessor event-root-x
498 :accessor event-root-y
501 (:metaclass event-class)
504 (defclass setting-event (event)
507 :accessor event-action
509 :type setting-action)
515 (:metaclass event-class)
518 (defclass proximity-event (timed-event)
521 :accessor event-device
524 (:metaclass event-class))
526 (defclass proximity-in-event (proximity-event)
528 (:metaclass event-class)
529 (:type :proximity-in))
531 (defclass proximity-out-event (proximity-event)
533 (:metaclass event-class)
534 (:type :proximity-out))
536 (defclass window-state-event (event)
539 :accessor event-change-mask
540 :initarg :change-mask
544 :accessor event-new-window-state
545 :initarg :new-window-state
547 (:metaclass event-class)
548 (:type :window-state))
550 (defclass owner-change-event (event)
552 (:metaclass event-class)
553 (:type :owner-change))