1 ;; Common Lisp bindings for GTK+ v2.x
2 ;; Copyright 1999-2005 Espen S. Johnsen <espen@users.sf.net>
4 ;; Permission is hereby granted, free of charge, to any person obtaining
5 ;; a copy of this software and associated documentation files (the
6 ;; "Software"), to deal in the Software without restriction, including
7 ;; without limitation the rights to use, copy, modify, merge, publish,
8 ;; distribute, sublicense, and/or sell copies of the Software, and to
9 ;; permit persons to whom the Software is furnished to do so, subject to
10 ;; the following conditions:
12 ;; The above copyright notice and this permission notice shall be
13 ;; included in all copies or substantial portions of the Software.
15 ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
16 ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
17 ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
18 ;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
19 ;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
20 ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
21 ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
23 ;; $Id: gdkevents.lisp,v 1.11 2006/02/05 15:39:40 espen Exp $
28 (define-flags-type event-mask
50 (:all-events #x3FFFFE))
52 (register-type 'event-mask '|gdk_event_mask_get_type|)
55 ;;;; Metaclass for event classes
57 (defvar *event-classes* (make-hash-table))
59 (eval-when (:compile-toplevel :load-toplevel :execute)
60 (defclass event-class (boxed-class)
61 ((event-type :reader event-class-type)))
63 (defmethod validate-superclass ((class event-class) (super standard-class))
64 ;(subtypep (class-name super) 'event)
67 (defmethod shared-initialize ((class event-class) names &key name type)
68 (let ((class-name (or name (class-name class))))
69 (unless (eq class-name 'event)
70 (register-type-alias class-name 'event)))
72 (setf (slot-value class 'event-type) (first type))
73 (setf (gethash (first type) *event-classes*) class))
75 (let ((reader (reader-function 'event-type)))
76 (defun %event-class (location)
77 (gethash (funcall reader location 0) *event-classes*)))
79 (defmethod make-proxy-instance :around ((class event-class) location &rest initargs)
80 (declare (ignore class))
81 (let ((class (%event-class location)))
82 (apply #'call-next-method class location initargs)))
87 (eval-when (:compile-toplevel :load-toplevel :execute)
88 (defclass event (boxed)
94 :accessor event-window
99 :accessor event-send-event
102 (:metaclass event-class)))
105 (defmethod initialize-instance ((event event) &rest initargs)
106 (declare (ignore initargs))
108 (setf (slot-value event '%type) (event-class-type (class-of event))))
111 (defclass timed-event (event)
116 :type (unsigned 32)))
117 (:metaclass event-class))
119 (defclass delete-event (event)
121 (:metaclass event-class)
125 (defclass destroy-event (event)
127 (:metaclass event-class)
130 (defclass expose-event (event)
143 :accessor event-width
148 :accessor event-height
153 :accessor event-region
158 :accessor event-count
161 (:metaclass event-class)
164 (defclass input-event (timed-event)
179 :type pointer) ;double-float)
182 :accessor event-state
184 :type modifier-type))
185 (:metaclass event-class))
188 (defclass motion-notify-event (input-event)
191 :accessor event-is-hint
193 :type (signed 16) ; should it be (boolean 16)?
198 :accessor event-device
203 :accessor event-root-x
208 :accessor event-root-y
211 (:metaclass event-class)
212 (:type :motion-notify))
214 (defclass button-event (input-event)
217 :accessor event-button
222 :accessor event-device
227 :accessor event-root-x
232 :accessor event-root-y
235 (:metaclass event-class))
237 (defclass button-press-event (button-event)
239 (:metaclass event-class)
240 (:type :button-press))
242 (defclass 2-button-press-event (button-press-event)
244 (:metaclass event-class)
245 (:type :2button-press))
247 (defclass 3-button-press-event (button-press-event)
249 (:metaclass event-class)
250 (:type :3button-press))
252 (defclass button-release-event (button-event)
254 (:metaclass event-class)
255 (:type :button-release))
258 (defclass key-event (timed-event)
261 :accessor event-state
266 :accessor event-keyval
271 :accessor event-length
276 :accessor event-string
281 :accessor event-hardware-keycode
282 :initarg :hardware-keycode
286 :accessor event-group
289 (:metaclass event-class))
291 (defclass key-press-event (key-event)
293 (:metaclass event-class)
296 (defclass key-release-event (key-event)
298 (:metaclass event-class)
299 (:type :key-release))
302 (defclass crossing-event (event)
305 :accessor event-subwindow
325 :accessor event-root-x
330 :accessor event-root-y
340 :accessor event-detail
345 :accessor event-focus
350 :accessor event-state
353 (:metaclass event-class))
356 (defclass enter-notify-event (crossing-event)
358 (:metaclass event-class)
359 (:type :enter-notify))
361 (defclass leave-notify-event (crossing-event)
363 (:metaclass event-class)
364 (:type :leave-notify))
366 (defclass focus-change-event (event)
372 (:metaclass event-class)
373 (:type :focus-change))
375 (defclass configure-event (event)
388 :accessor event-width
393 :accessor event-height
396 (:metaclass event-class)
399 (defclass map-event (event)
401 (:metaclass event-class)
404 (defclass unmap-event (event)
406 (:metaclass event-class)
409 (defclass property-notify-event (event)
411 (:metaclass event-class)
412 (:type :property-notify))
414 (defclass selection-clear-event (event)
416 (:metaclass event-class)
417 (:type :selection-clear))
419 (defclass selection-request-event (event)
421 (:metaclass event-class)
422 (:type :selection-request))
424 (defclass selection-notify-event (event)
426 (:metaclass event-class)
427 (:type :selection-notify))
429 (defclass dnd-event (event)
432 :accessor event-contex
442 :accessor event-x-root
447 :accessor event-y-root
450 (:metaclass event-class))
452 (defclass drag-enter-event (dnd-event)
454 (:metaclass event-class)
457 (defclass drag-leave-event (dnd-event)
459 (:metaclass event-class)
462 (defclass drag-motion-event (dnd-event)
464 (:metaclass event-class)
465 (:type :drag-motion))
467 (defclass drag-status-event (dnd-event)
469 (:metaclass event-class)
470 (:type :drag-status))
472 (defclass drot-start-event (dnd-event)
474 (:metaclass event-class)
477 (defclass drop-finished-event (dnd-event)
479 (:metaclass event-class)
480 (:type :drop-finished))
482 (defclass client-event (event)
484 (:metaclass event-class)
485 (:type :client-event))
487 (defclass visibility-notify-event (event)
490 :accessor event-state
492 :type visibility-state))
493 (:metaclass event-class)
494 (:type :visibility-notify))
496 (defclass no-expose-event (event)
498 (:metaclass event-class)
501 (defclass scroll-event (timed-event)
514 :accessor event-state
519 :accessor event-direction
521 :type scroll-direction)
524 :accessor event-root-x
529 :accessor event-root-y
532 (:metaclass event-class)
535 (defclass setting-event (event)
538 :accessor event-action
540 :type setting-action)
546 (:metaclass event-class)
549 (defclass proximity-event (timed-event)
552 :accessor event-device
555 (:metaclass event-class))
557 (defclass proximity-in-event (proximity-event)
559 (:metaclass event-class)
560 (:type :proximity-in))
562 (defclass proximity-out-event (proximity-event)
564 (:metaclass event-class)
565 (:type :proximity-out))
567 (defclass window-state-event (event)
570 :accessor event-change-mask
571 :initarg :change-mask
575 :accessor event-new-window-state
576 :initarg :new-window-state
578 (:metaclass event-class)
579 (:type :window-state))
581 (defclass owner-change-event (event)
583 (:metaclass event-class)
584 (:type :owner-change))