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.10 2005-04-23 16:48:50 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)
68 (defmethod shared-initialize ((class event-class) names &key name type)
69 (let ((class-name (or name (class-name class))))
70 (unless (eq class-name 'event)
71 (register-type-alias class-name 'event)))
73 (setf (slot-value class 'event-type) (first type))
74 (setf (gethash (first type) *event-classes*) class))
76 (let ((reader (reader-function 'event-type)))
77 (defun %event-class (location)
78 (gethash (funcall reader location 0) *event-classes*)))
80 (defmethod ensure-proxy-instance ((class event-class) location)
81 (declare (ignore class))
82 (let ((class (%event-class location)))
83 (make-instance class :location location)))
88 (eval-when (:compile-toplevel :load-toplevel :execute)
89 (defclass event (boxed)
95 :accessor event-window
100 :accessor event-send-event
103 (:metaclass event-class)))
106 (defmethod initialize-instance ((event event) &rest initargs)
107 (declare (ignore initargs))
109 (setf (slot-value event '%type) (event-class-type (class-of event))))
112 (defclass timed-event (event)
117 :type (unsigned 32)))
118 (:metaclass event-class))
120 (defclass delete-event (event)
122 (:metaclass event-class)
126 (defclass destroy-event (event)
128 (:metaclass event-class)
131 (defclass expose-event (event)
144 :accessor event-width
149 :accessor event-height
154 :accessor event-region
159 :accessor event-count
162 (:metaclass event-class)
165 (defclass input-event (timed-event)
180 :type pointer) ;double-float)
183 :accessor event-state
185 :type modifier-type))
186 (:metaclass event-class))
189 (defclass motion-notify-event (input-event)
192 :accessor event-is-hint
194 :type (signed 16) ; should it be (boolean 16)?
199 :accessor event-device
204 :accessor event-root-x
209 :accessor event-root-y
212 (:metaclass event-class)
213 (:type :motion-notify))
215 (defclass button-event (input-event)
218 :accessor event-button
223 :accessor event-device
228 :accessor event-root-x
233 :accessor event-root-y
236 (:metaclass event-class))
238 (defclass button-press-event (button-event)
240 (:metaclass event-class)
241 (:type :button-press))
243 (defclass 2-button-press-event (button-press-event)
245 (:metaclass event-class)
246 (:type :2button-press))
248 (defclass 3-button-press-event (button-press-event)
250 (:metaclass event-class)
251 (:type :3button-press))
253 (defclass button-release-event (button-event)
255 (:metaclass event-class)
256 (:type :button-release))
259 (defclass key-event (timed-event)
262 :accessor event-state
267 :accessor event-keyval
272 :accessor event-length
277 :accessor event-string
282 :accessor event-hardware-keycode
283 :initarg :hardware-keycode
287 :accessor event-group
290 (:metaclass event-class))
292 (defclass key-press-event (key-event)
294 (:metaclass event-class)
297 (defclass key-release-event (key-event)
299 (:metaclass event-class)
300 (:type :key-release))
303 (defclass crossing-event (event)
306 :accessor event-subwindow
326 :accessor event-root-x
331 :accessor event-root-y
341 :accessor event-detail
346 :accessor event-focus
351 :accessor event-state
354 (:metaclass event-class))
357 (defclass enter-notify-event (crossing-event)
359 (:metaclass event-class)
360 (:type :enter-notify))
362 (defclass leave-notify-event (crossing-event)
364 (:metaclass event-class)
365 (:type :leave-notify))
367 (defclass focus-change-event (event)
373 (:metaclass event-class)
374 (:type :focus-change))
376 (defclass configure-event (event)
389 :accessor event-width
394 :accessor event-height
397 (:metaclass event-class)
400 (defclass map-event (event)
402 (:metaclass event-class)
405 (defclass unmap-event (event)
407 (:metaclass event-class)
410 (defclass property-notify-event (event)
412 (:metaclass event-class)
413 (:type :property-notify))
415 (defclass selection-clear-event (event)
417 (:metaclass event-class)
418 (:type :selection-clear))
420 (defclass selection-request-event (event)
422 (:metaclass event-class)
423 (:type :selection-request))
425 (defclass selection-notify-event (event)
427 (:metaclass event-class)
428 (:type :selection-notify))
430 (defclass dnd-event (event)
433 :accessor event-contex
443 :accessor event-x-root
448 :accessor event-y-root
451 (:metaclass event-class))
453 (defclass drag-enter-event (dnd-event)
455 (:metaclass event-class)
458 (defclass drag-leave-event (dnd-event)
460 (:metaclass event-class)
463 (defclass drag-motion-event (dnd-event)
465 (:metaclass event-class)
466 (:type :drag-motion))
468 (defclass drag-status-event (dnd-event)
470 (:metaclass event-class)
471 (:type :drag-status))
473 (defclass drot-start-event (dnd-event)
475 (:metaclass event-class)
478 (defclass drop-finished-event (dnd-event)
480 (:metaclass event-class)
481 (:type :drop-finished))
483 (defclass client-event (event)
485 (:metaclass event-class)
486 (:type :client-event))
488 (defclass visibility-notify-event (event)
491 :accessor event-state
493 :type visibility-state))
494 (:metaclass event-class)
495 (:type :visibility-notify))
497 (defclass no-expose-event (event)
499 (:metaclass event-class)
502 (defclass scroll-event (timed-event)
515 :accessor event-state
520 :accessor event-direction
522 :type scroll-direction)
525 :accessor event-root-x
530 :accessor event-root-y
533 (:metaclass event-class)
536 (defclass setting-event (event)
539 :accessor event-action
541 :type setting-action)
547 (:metaclass event-class)
550 (defclass proximity-event (timed-event)
553 :accessor event-device
556 (:metaclass event-class))
558 (defclass proximity-in-event (proximity-event)
560 (:metaclass event-class)
561 (:type :proximity-in))
563 (defclass proximity-out-event (proximity-event)
565 (:metaclass event-class)
566 (:type :proximity-out))
568 (defclass window-state-event (event)
571 :accessor event-change-mask
572 :initarg :change-mask
576 :accessor event-new-window-state
577 :initarg :new-window-state
579 (:metaclass event-class)
580 (:type :window-state))
582 (defclass owner-change-event (event)
584 (:metaclass event-class)
585 (:type :owner-change))