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.9 2005-03-06 17:26:22 espen Exp $
23 (define-flags-type event-mask
45 (:all-events #x3FFFFE))
47 (register-type 'event-mask '|gdk_event_mask_get_type|)
50 ;;;; Metaclass for event classes
52 (defvar *event-classes* (make-hash-table))
54 (eval-when (:compile-toplevel :load-toplevel :execute)
55 (defclass event-class (boxed-class)
56 ((event-type :reader event-class-type)))
58 (defmethod validate-superclass ((class event-class) (super standard-class))
59 ;(subtypep (class-name super) 'event)
63 (defmethod shared-initialize ((class event-class) names &key name type)
64 (let ((class-name (or name (class-name class))))
65 (unless (eq class-name 'event)
66 (register-type-alias class-name 'event)))
68 (setf (slot-value class 'event-type) (first type))
69 (setf (gethash (first type) *event-classes*) class))
71 (let ((reader (reader-function 'event-type)))
72 (defun %event-class (location)
73 (gethash (funcall reader location 0) *event-classes*)))
75 (defmethod ensure-proxy-instance ((class event-class) location)
76 (declare (ignore class))
77 (let ((class (%event-class location)))
78 (make-instance class :location location)))
83 (eval-when (:compile-toplevel :load-toplevel :execute)
84 (defclass event (boxed)
90 :accessor event-window
95 :accessor event-send-event
98 (:metaclass event-class)))
101 (defmethod initialize-instance ((event event) &rest initargs)
102 (declare (ignore initargs))
104 (setf (slot-value event '%type) (event-class-type (class-of event))))
107 (defclass timed-event (event)
112 :type (unsigned 32)))
113 (:metaclass event-class))
115 (defclass delete-event (event)
117 (:metaclass event-class)
121 (defclass destroy-event (event)
123 (:metaclass event-class)
126 (defclass expose-event (event)
139 :accessor event-width
144 :accessor event-height
149 :accessor event-region
154 :accessor event-count
157 (:metaclass event-class)
160 (defclass input-event (timed-event)
175 :type pointer) ;double-float)
178 :accessor event-state
180 :type modifier-type))
181 (:metaclass event-class))
184 (defclass motion-notify-event (input-event)
187 :accessor event-is-hint
189 :type (signed 16) ; should it be (boolean 16)?
194 :accessor event-device
199 :accessor event-root-x
204 :accessor event-root-y
207 (:metaclass event-class)
208 (:type :motion-notify))
210 (defclass button-event (input-event)
213 :accessor event-button
218 :accessor event-device
223 :accessor event-root-x
228 :accessor event-root-y
231 (:metaclass event-class))
233 (defclass button-press-event (button-event)
235 (:metaclass event-class)
236 (:type :button-press))
238 (defclass 2-button-press-event (button-press-event)
240 (:metaclass event-class)
241 (:type :2button-press))
243 (defclass 3-button-press-event (button-press-event)
245 (:metaclass event-class)
246 (:type :3button-press))
248 (defclass button-release-event (button-event)
250 (:metaclass event-class)
251 (:type :button-release))
254 (defclass key-event (timed-event)
257 :accessor event-state
262 :accessor event-keyval
267 :accessor event-length
272 :accessor event-string
277 :accessor event-hardware-keycode
278 :initarg :hardware-keycode
282 :accessor event-group
285 (:metaclass event-class))
287 (defclass key-press-event (key-event)
289 (:metaclass event-class)
292 (defclass key-release-event (key-event)
294 (:metaclass event-class)
295 (:type :key-release))
298 (defclass crossing-event (event)
301 :accessor event-subwindow
321 :accessor event-root-x
326 :accessor event-root-y
336 :accessor event-detail
341 :accessor event-focus
346 :accessor event-state
349 (:metaclass event-class))
352 (defclass enter-notify-event (crossing-event)
354 (:metaclass event-class)
355 (:type :enter-notify))
357 (defclass leave-notify-event (crossing-event)
359 (:metaclass event-class)
360 (:type :leave-notify))
362 (defclass focus-change-event (event)
368 (:metaclass event-class)
369 (:type :focus-change))
371 (defclass configure-event (event)
384 :accessor event-width
389 :accessor event-height
392 (:metaclass event-class)
395 (defclass map-event (event)
397 (:metaclass event-class)
400 (defclass unmap-event (event)
402 (:metaclass event-class)
405 (defclass property-notify-event (event)
407 (:metaclass event-class)
408 (:type :property-notify))
410 (defclass selection-clear-event (event)
412 (:metaclass event-class)
413 (:type :selection-clear))
415 (defclass selection-request-event (event)
417 (:metaclass event-class)
418 (:type :selection-request))
420 (defclass selection-notify-event (event)
422 (:metaclass event-class)
423 (:type :selection-notify))
425 (defclass dnd-event (event)
428 :accessor event-contex
438 :accessor event-x-root
443 :accessor event-y-root
446 (:metaclass event-class))
448 (defclass drag-enter-event (dnd-event)
450 (:metaclass event-class)
453 (defclass drag-leave-event (dnd-event)
455 (:metaclass event-class)
458 (defclass drag-motion-event (dnd-event)
460 (:metaclass event-class)
461 (:type :drag-motion))
463 (defclass drag-status-event (dnd-event)
465 (:metaclass event-class)
466 (:type :drag-status))
468 (defclass drot-start-event (dnd-event)
470 (:metaclass event-class)
473 (defclass drop-finished-event (dnd-event)
475 (:metaclass event-class)
476 (:type :drop-finished))
478 (defclass client-event (event)
480 (:metaclass event-class)
481 (:type :client-event))
483 (defclass visibility-notify-event (event)
486 :accessor event-state
488 :type visibility-state))
489 (:metaclass event-class)
490 (:type :visibility-notify))
492 (defclass no-expose-event (event)
494 (:metaclass event-class)
497 (defclass scroll-event (timed-event)
510 :accessor event-state
515 :accessor event-direction
517 :type scroll-direction)
520 :accessor event-root-x
525 :accessor event-root-y
528 (:metaclass event-class)
531 (defclass setting-event (event)
534 :accessor event-action
536 :type setting-action)
542 (:metaclass event-class)
545 (defclass proximity-event (timed-event)
548 :accessor event-device
551 (:metaclass event-class))
553 (defclass proximity-in-event (proximity-event)
555 (:metaclass event-class)
556 (:type :proximity-in))
558 (defclass proximity-out-event (proximity-event)
560 (:metaclass event-class)
561 (:type :proximity-out))
563 (defclass window-state-event (event)
566 :accessor event-change-mask
567 :initarg :change-mask
571 :accessor event-new-window-state
572 :initarg :new-window-state
574 (:metaclass event-class)
575 (:type :window-state))
577 (defclass owner-change-event (event)
579 (:metaclass event-class)
580 (:type :owner-change))