1 ;; Common Lisp bindings for GTK+ v2.x
2 ;; Copyright 1999-2006 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.12 2006/04/26 09:20:20 espen Exp $
28 ;;;; Metaclass for event classes
30 (eval-when (:compile-toplevel :load-toplevel :execute)
31 (defvar *event-classes* (make-hash-table))
33 (defclass event-class (boxed-class)
34 ((event-type :reader event-class-type :initform nil)))
36 (defmethod validate-superclass ((class event-class) (super standard-class))
37 ;(subtypep (class-name super) 'event)
40 (defmethod shared-initialize ((class event-class) names &key name event-type)
41 (declare (ignore names))
42 (register-type-alias (or name (class-name class)) 'event)
45 (setf (slot-value class 'event-type) (first event-type))
46 (setf (gethash (first event-type) *event-classes*) class))))
48 (let ((reader (reader-function 'event-type)))
49 (defun %event-class (location)
50 (gethash (funcall reader location 0) *event-classes*)))
52 (defmethod make-proxy-instance :around ((class event-class) location
54 (let ((class (%event-class location)))
55 (apply #'call-next-method class location initargs)))
58 ;; The class event is the only class that actually exists in the
59 ;; GObject class hierarchy
61 (eval-when (:compile-toplevel :load-toplevel :execute)
62 (defclass event (boxed)
68 :accessor event-window
73 :accessor event-send-event
76 (:metaclass boxed-class)))
78 (defmethod initialize-instance ((event event) &rest initargs)
79 (declare (ignore initargs))
81 (setf (slot-value event '%type) (event-class-type (class-of event))))
83 (defmethod make-proxy-instance :around ((class (eql (find-class 'event))) location &rest initargs)
84 (let ((class (%event-class location)))
85 (apply #'call-next-method class location initargs)))
88 (defclass timed-event (event)
94 (:metaclass event-class))
96 (defclass delete-event (event)
98 (:metaclass event-class)
99 (:event-type :delete))
102 (defclass destroy-event (event)
104 (:metaclass event-class)
105 (:event-type :destroy))
107 (defclass expose-event (event)
120 :accessor event-width
125 :accessor event-height
130 :accessor event-region
135 :accessor event-count
138 (:metaclass event-class)
139 (:event-type :expose))
141 (defclass input-event (timed-event)
156 :type pointer) ;double-float)
159 :accessor event-state
161 :type modifier-type))
162 (:metaclass event-class))
165 (defclass motion-notify-event (input-event)
168 :accessor event-is-hint
170 :type (signed 16) ; should it be (boolean 16)?
175 :accessor event-device
180 :accessor event-root-x
185 :accessor event-root-y
188 (:metaclass event-class)
189 (:event-type :motion-notify))
191 (defclass button-event (input-event)
194 :accessor event-button
199 :accessor event-device
204 :accessor event-root-x
209 :accessor event-root-y
212 (:metaclass event-class))
214 (defclass button-press-event (button-event)
216 (:metaclass event-class)
217 (:event-type :button-press))
219 (defclass 2-button-press-event (button-press-event)
221 (:metaclass event-class)
222 (:event-type :2button-press))
224 (defclass 3-button-press-event (button-press-event)
226 (:metaclass event-class)
227 (:event-type :3button-press))
229 (defclass button-release-event (button-event)
231 (:metaclass event-class)
232 (:event-type :button-release))
235 (defclass key-event (timed-event)
238 :accessor event-state
243 :accessor event-keyval
248 :accessor event-length
253 :accessor event-string
258 :accessor event-hardware-keycode
259 :initarg :hardware-keycode
263 :accessor event-group
266 (:metaclass event-class))
268 (defclass key-press-event (key-event)
270 (:metaclass event-class)
271 (:event-type :key-press))
273 (defclass key-release-event (key-event)
275 (:metaclass event-class)
276 (:event-type :key-release))
279 (defclass crossing-event (event)
282 :accessor event-subwindow
302 :accessor event-root-x
307 :accessor event-root-y
317 :accessor event-detail
322 :accessor event-focus
327 :accessor event-state
330 (:metaclass event-class))
333 (defclass enter-notify-event (crossing-event)
335 (:metaclass event-class)
336 (:event-type :enter-notify))
338 (defclass leave-notify-event (crossing-event)
340 (:metaclass event-class)
341 (:event-type :leave-notify))
343 (defclass focus-change-event (event)
349 (:metaclass event-class)
350 (:event-type :focus-change))
352 (defclass configure-event (event)
365 :accessor event-width
370 :accessor event-height
373 (:metaclass event-class)
374 (:event-type :configure))
376 (defclass map-event (event)
378 (:metaclass event-class)
381 (defclass unmap-event (event)
383 (:metaclass event-class)
384 (:event-type :unmap))
386 (defclass property-notify-event (event)
388 (:metaclass event-class)
389 (:event-type :property-notify))
391 (defclass selection-clear-event (event)
393 (:metaclass event-class)
394 (:event-type :selection-clear))
396 (defclass selection-request-event (event)
398 (:metaclass event-class)
399 (:event-type :selection-request))
401 (defclass selection-notify-event (event)
403 (:metaclass event-class)
404 (:event-type :selection-notify))
406 (defclass dnd-event (event)
409 :accessor event-contex
419 :accessor event-x-root
424 :accessor event-y-root
427 (:metaclass event-class))
429 (defclass drag-enter-event (dnd-event)
431 (:metaclass event-class)
432 (:event-type :drag-enter))
434 (defclass drag-leave-event (dnd-event)
436 (:metaclass event-class)
437 (:event-type :drag-leave))
439 (defclass drag-motion-event (dnd-event)
441 (:metaclass event-class)
442 (:event-type :drag-motion))
444 (defclass drag-status-event (dnd-event)
446 (:metaclass event-class)
447 (:event-type :drag-status))
449 (defclass drot-start-event (dnd-event)
451 (:metaclass event-class)
452 (:event-type :drop-start))
454 (defclass drop-finished-event (dnd-event)
456 (:metaclass event-class)
457 (:event-type :drop-finished))
459 (defclass client-event (event)
461 (:metaclass event-class)
462 (:event-type :client-event))
464 (defclass visibility-notify-event (event)
467 :accessor event-state
469 :type visibility-state))
470 (:metaclass event-class)
471 (:event-type :visibility-notify))
473 (defclass no-expose-event (event)
475 (:metaclass event-class)
476 (:event-type :no-expose))
478 (defclass scroll-event (timed-event)
491 :accessor event-state
496 :accessor event-direction
498 :type scroll-direction)
501 :accessor event-root-x
506 :accessor event-root-y
509 (:metaclass event-class)
510 (:event-type :scroll))
512 (defclass setting-event (event)
515 :accessor event-action
517 :type setting-action)
523 (:metaclass event-class)
524 (:event-type :setting))
526 (defclass proximity-event (timed-event)
529 :accessor event-device
532 (:metaclass event-class))
534 (defclass proximity-in-event (proximity-event)
536 (:metaclass event-class)
537 (:event-type :proximity-in))
539 (defclass proximity-out-event (proximity-event)
541 (:metaclass event-class)
542 (:event-type :proximity-out))
544 (defclass window-state-event (event)
547 :accessor event-change-mask
548 :initarg :change-mask
552 :accessor event-new-window-state
553 :initarg :new-window-state
555 (:metaclass event-class)
556 (:event-type :window-state))
558 (defclass owner-change-event (event)
560 (:metaclass event-class)
561 (:event-type :owner-change))