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.15 2008-03-18 15:08:08 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)
51 (gethash (funcall reader location 0) *event-classes*)
52 (error "No class defined for event type: ~S" (funcall reader location 0)))))
54 (defmethod make-proxy-instance :around ((class event-class) location
56 (let ((class (%event-class location)))
57 (apply #'call-next-method class location initargs)))
60 ;; The class event is the only class that actually exists in the
61 ;; GObject class hierarchy
63 (eval-when (:compile-toplevel :load-toplevel :execute)
64 (defclass event (boxed)
70 :accessor event-window
75 :accessor event-send-event
78 (:metaclass boxed-class)))
80 (defmethod initialize-instance :after ((event event) &rest initargs)
81 (declare (ignore initargs))
82 (setf (slot-value event '%type) (event-class-type (class-of event))))
84 (defmethod make-proxy-instance ((class (eql (find-class 'event))) location &rest initargs)
85 (let ((class (%event-class location)))
86 (apply #'make-proxy-instance class location initargs)))
89 (defclass timed-event (event)
95 (:metaclass event-class))
97 (defclass delete-event (event)
99 (:metaclass event-class)
100 (:event-type :delete))
103 (defclass destroy-event (event)
105 (:metaclass event-class)
106 (:event-type :destroy))
108 (defclass expose-event (event)
121 :accessor event-width
126 :accessor event-height
131 :accessor event-region
136 :accessor event-count
139 (:metaclass event-class)
140 (:event-type :expose))
142 (defclass input-event (timed-event)
157 :type pointer) ;double-float)
160 :accessor event-state
162 :type modifier-type))
163 (:metaclass event-class))
166 (defclass motion-notify-event (input-event)
169 :accessor event-is-hint
171 :type (signed 16) ; should it be (boolean 16)?
176 :accessor event-device
181 :accessor event-root-x
186 :accessor event-root-y
189 (:metaclass event-class)
190 (:event-type :motion-notify))
192 (defclass button-event (input-event)
195 :accessor event-button
200 :accessor event-device
205 :accessor event-root-x
210 :accessor event-root-y
213 (:metaclass event-class))
215 (defclass button-press-event (button-event)
217 (:metaclass event-class)
218 (:event-type :button-press))
220 (defclass 2-button-press-event (button-press-event)
222 (:metaclass event-class)
223 (:event-type :2button-press))
225 (defclass 3-button-press-event (button-press-event)
227 (:metaclass event-class)
228 (:event-type :3button-press))
230 (defclass button-release-event (button-event)
232 (:metaclass event-class)
233 (:event-type :button-release))
236 (defclass key-event (timed-event)
239 :accessor event-state
244 :accessor event-keyval
249 :accessor event-length
254 :accessor event-string
259 :accessor event-hardware-keycode
260 :initarg :hardware-keycode
264 :accessor event-group
267 (:metaclass event-class))
269 (defclass key-press-event (key-event)
271 (:metaclass event-class)
272 (:event-type :key-press))
274 (defclass key-release-event (key-event)
276 (:metaclass event-class)
277 (:event-type :key-release))
280 (defclass crossing-event (event)
283 :accessor event-subwindow
303 :accessor event-root-x
308 :accessor event-root-y
318 :accessor event-detail
323 :accessor event-focus
328 :accessor event-state
331 (:metaclass event-class))
334 (defclass enter-notify-event (crossing-event)
336 (:metaclass event-class)
337 (:event-type :enter-notify))
339 (defclass leave-notify-event (crossing-event)
341 (:metaclass event-class)
342 (:event-type :leave-notify))
344 (defclass focus-change-event (event)
350 (:metaclass event-class)
351 (:event-type :focus-change))
353 (defclass configure-event (event)
366 :accessor event-width
371 :accessor event-height
374 (:metaclass event-class)
375 (:event-type :configure))
377 (defclass map-event (event)
379 (:metaclass event-class)
382 (defclass unmap-event (event)
384 (:metaclass event-class)
385 (:event-type :unmap))
387 (defclass property-notify-event (event)
389 (:metaclass event-class)
390 (:event-type :property-notify))
392 (defclass selection-clear-event (event)
394 (:metaclass event-class)
395 (:event-type :selection-clear))
397 (defclass selection-request-event (event)
399 (:metaclass event-class)
400 (:event-type :selection-request))
402 (defclass selection-notify-event (event)
404 (:metaclass event-class)
405 (:event-type :selection-notify))
407 (defclass dnd-event (event)
410 :accessor event-contex
420 :accessor event-x-root
425 :accessor event-y-root
428 (:metaclass event-class))
430 (defclass drag-enter-event (dnd-event)
432 (:metaclass event-class)
433 (:event-type :drag-enter))
435 (defclass drag-leave-event (dnd-event)
437 (:metaclass event-class)
438 (:event-type :drag-leave))
440 (defclass drag-motion-event (dnd-event)
442 (:metaclass event-class)
443 (:event-type :drag-motion))
445 (defclass drag-status-event (dnd-event)
447 (:metaclass event-class)
448 (:event-type :drag-status))
450 (defclass drot-start-event (dnd-event)
452 (:metaclass event-class)
453 (:event-type :drop-start))
455 (defclass drop-finished-event (dnd-event)
457 (:metaclass event-class)
458 (:event-type :drop-finished))
460 (defclass client-event (event)
462 (:metaclass event-class)
463 (:event-type :client-event))
465 (defclass visibility-notify-event (event)
468 :accessor event-state
470 :type visibility-state))
471 (:metaclass event-class)
472 (:event-type :visibility-notify))
474 (defclass no-expose-event (event)
476 (:metaclass event-class)
477 (:event-type :no-expose))
479 (defclass scroll-event (timed-event)
492 :accessor event-state
497 :accessor event-direction
499 :type scroll-direction)
502 :accessor event-root-x
507 :accessor event-root-y
510 (:metaclass event-class)
511 (:event-type :scroll))
513 (defclass setting-event (event)
516 :accessor event-action
518 :type setting-action)
524 (:metaclass event-class)
525 (:event-type :setting))
527 (defclass proximity-event (timed-event)
530 :accessor event-device
533 (:metaclass event-class))
535 (defclass proximity-in-event (proximity-event)
537 (:metaclass event-class)
538 (:event-type :proximity-in))
540 (defclass proximity-out-event (proximity-event)
542 (:metaclass event-class)
543 (:event-type :proximity-out))
545 (defclass window-state-event (event)
548 :accessor event-change-mask
549 :initarg :change-mask
553 :accessor event-new-window-state
554 :initarg :new-window-state
556 (:metaclass event-class)
557 (:event-type :window-state))
559 (defclass owner-change-event (event)
561 (:metaclass event-class)
562 (:event-type :owner-change))
564 (defclass grab-broken-event (event)
567 :accessor event-keyboard
572 :accessor event-implicit
577 :accessor event-grab-window
578 :initarg :grab-window
580 (:metaclass event-class)
581 (:event-type :grab-broken))