chiark / gitweb /
Hopefully allow (require :glib) again.
[clg] / gdk / gdkevents.lisp
CommitLineData
112ac1d3 1;; Common Lisp bindings for GTK+ v2.x
57e4839d 2;; Copyright 1999-2006 Espen S. Johnsen <espen@users.sf.net>
5d462688 3;;
112ac1d3 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:
5d462688 11;;
112ac1d3 12;; The above copyright notice and this permission notice shall be
13;; included in all copies or substantial portions of the Software.
5d462688 14;;
112ac1d3 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.
5d462688 22
c1df82a9 23;; $Id: gdkevents.lisp,v 1.15 2008-03-18 15:08:08 espen Exp $
5d462688 24
25(in-package "GDK")
26
27
5d462688 28;;;; Metaclass for event classes
29
30(eval-when (:compile-toplevel :load-toplevel :execute)
57e4839d 31 (defvar *event-classes* (make-hash-table))
32
9adccb27 33 (defclass event-class (boxed-class)
57e4839d 34 ((event-type :reader event-class-type :initform nil)))
5d462688 35
9adccb27 36 (defmethod validate-superclass ((class event-class) (super standard-class))
c07660b3 37 ;(subtypep (class-name super) 'event)
57e4839d 38 t)
39
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)
43 (call-next-method)
44 (when event-type
45 (setf (slot-value class 'event-type) (first event-type))
46 (setf (gethash (first event-type) *event-classes*) class))))
e2696f46 47
9adccb27 48(let ((reader (reader-function 'event-type)))
49 (defun %event-class (location)
953030a3 50 (or
51 (gethash (funcall reader location 0) *event-classes*)
52 (error "No class defined for event type: ~S" (funcall reader location 0)))))
5d462688 53
57e4839d 54(defmethod make-proxy-instance :around ((class event-class) location
55 &rest initargs)
9adccb27 56 (let ((class (%event-class location)))
8958fa4a 57 (apply #'call-next-method class location initargs)))
5d462688 58
59
57e4839d 60;; The class event is the only class that actually exists in the
61;; GObject class hierarchy
5d462688 62
c07660b3 63(eval-when (:compile-toplevel :load-toplevel :execute)
64 (defclass event (boxed)
65 ((%type
66 :allocation :alien
67 :type event-type)
68 (window
69 :allocation :alien
70 :accessor event-window
71 :initarg :window
72 :type window)
73 (send-event
74 :allocation :alien
75 :accessor event-send-event
76 :initarg :send-event
57e4839d 77 :type (bool 8)))
78 (:metaclass boxed-class)))
c07660b3 79
5421c488 80(defmethod initialize-instance :after ((event event) &rest initargs)
c07660b3 81 (declare (ignore initargs))
c07660b3 82 (setf (slot-value event '%type) (event-class-type (class-of event))))
83
5421c488 84(defmethod make-proxy-instance ((class (eql (find-class 'event))) location &rest initargs)
57e4839d 85 (let ((class (%event-class location)))
5421c488 86 (apply #'make-proxy-instance class location initargs)))
57e4839d 87
c07660b3 88
5d462688 89(defclass timed-event (event)
90 ((time
91 :allocation :alien
92 :accessor event-time
93 :initarg :time
94 :type (unsigned 32)))
9adccb27 95 (:metaclass event-class))
5d462688 96
97(defclass delete-event (event)
98 ()
99 (:metaclass event-class)
57e4839d 100 (:event-type :delete))
5d462688 101
9adccb27 102
5d462688 103(defclass destroy-event (event)
104 ()
105 (:metaclass event-class)
57e4839d 106 (:event-type :destroy))
5d462688 107
108(defclass expose-event (event)
109 ((x
110 :allocation :alien
111 :accessor event-x
112 :initarg :x
113 :type int)
114 (y
115 :allocation :alien
116 :accessor event-y
117 :initarg :y
118 :type int)
119 (width
120 :allocation :alien
121 :accessor event-width
122 :initarg :width
123 :type int)
124 (height
125 :allocation :alien
126 :accessor event-height
127 :initarg :height
128 :type int)
c07660b3 129 (region
130 :allocation :alien
131 :accessor event-region
132 :initarg :region
133 :type pointer)
5d462688 134 (count
135 :allocation :alien
136 :accessor event-count
137 :initarg :count
138 :type int))
139 (:metaclass event-class)
57e4839d 140 (:event-type :expose))
5d462688 141
c07660b3 142(defclass input-event (timed-event)
5d462688 143 ((x
144 :allocation :alien
145 :accessor event-x
146 :initarg :x
147 :type double-float)
148 (y
149 :allocation :alien
150 :accessor event-y
151 :initarg :y
152 :type double-float)
c07660b3 153 (axes
154 :allocation :alien
155 :accessor event-axes
156 :initarg :axes
157 :type pointer) ;double-float)
5d462688 158 (state
159 :allocation :alien
5d462688 160 :accessor event-state
161 :initarg :state
c07660b3 162 :type modifier-type))
163 (:metaclass event-class))
164
165
166(defclass motion-notify-event (input-event)
167 ((is-hint
5d462688 168 :allocation :alien
169 :accessor event-is-hint
170 :initarg :is-hint
171 :type (signed 16) ; should it be (boolean 16)?
172 )
173 (device
174 :allocation :alien
175 :offset 2
176 :accessor event-device
177 :initarg :device
178 :type device)
179 (root-x
180 :allocation :alien
181 :accessor event-root-x
182 :initarg :root-x
183 :type double-float)
184 (root-y
185 :allocation :alien
186 :accessor event-root-y
187 :initarg :root-y
188 :type double-float))
189 (:metaclass event-class)
57e4839d 190 (:event-type :motion-notify))
5d462688 191
c07660b3 192(defclass button-event (input-event)
193 ((button
5d462688 194 :allocation :alien
195 :accessor event-button
196 :initarg :button
197 :type unsigned-int)
198 (device
199 :allocation :alien
200 :accessor event-device
201 :initarg :device
202 :type device)
203 (root-x
204 :allocation :alien
205 :accessor event-root-x
206 :initarg :root-x
207 :type double-float)
208 (root-y
209 :allocation :alien
210 :accessor event-root-y
211 :initarg :root-y
212 :type double-float))
c07660b3 213 (:metaclass event-class))
214
215(defclass button-press-event (button-event)
216 ()
5d462688 217 (:metaclass event-class)
57e4839d 218 (:event-type :button-press))
5d462688 219
220(defclass 2-button-press-event (button-press-event)
221 ()
222 (:metaclass event-class)
57e4839d 223 (:event-type :2button-press))
5d462688 224
225(defclass 3-button-press-event (button-press-event)
226 ()
227 (:metaclass event-class)
57e4839d 228 (:event-type :3button-press))
5d462688 229
c07660b3 230(defclass button-release-event (button-event)
5d462688 231 ()
232 (:metaclass event-class)
57e4839d 233 (:event-type :button-release))
5d462688 234
c07660b3 235
236(defclass key-event (timed-event)
237 ((state
238 :allocation :alien
239 :accessor event-state
240 :initarg :state
241 :type modifier-type)
242 (keyval
243 :allocation :alien
244 :accessor event-keyval
245 :initarg :keyval
246 :type unsigned-int)
247 (length
248 :allocation :alien
249 :accessor event-length
250 :initarg :length
251 :type unsigned-int)
252 (string
253 :allocation :alien
254 :accessor event-string
255 :initarg :string
256 :type string)
257 (hardware-keycode
258 :allocation :alien
259 :accessor event-hardware-keycode
260 :initarg :hardware-keycode
261 :type (unsigned 16))
262 (group
263 :allocation :alien
264 :accessor event-group
265 :initarg :group
266 :type (unsigned 8)))
267 (:metaclass event-class))
268
269(defclass key-press-event (key-event)
5d462688 270 ()
271 (:metaclass event-class)
57e4839d 272 (:event-type :key-press))
5d462688 273
c07660b3 274(defclass key-release-event (key-event)
5d462688 275 ()
276 (:metaclass event-class)
57e4839d 277 (:event-type :key-release))
5d462688 278
c07660b3 279
280(defclass crossing-event (event)
281 ((subwindow
282 :allocation :alien
283 :accessor event-subwindow
284 :initarg :subwindow
285 :type window)
286 (time
287 :allocation :alien
288 :accessor event-time
289 :initarg :time
290 :type (unsigned 32))
291 (x
292 :allocation :alien
293 :accessor event-x
294 :initarg :x
295 :type double-float)
296 (y
297 :allocation :alien
298 :accessor event-y
299 :initarg :y
300 :type double-float)
301 (root-x
302 :allocation :alien
303 :accessor event-root-x
304 :initarg :root-x
305 :type double-float)
306 (root-y
307 :allocation :alien
308 :accessor event-root-y
309 :initarg :root-y
310 :type double-float)
311 (mode
312 :allocation :alien
313 :accessor event-mode
314 :initarg :mode
315 :type crossing-mode)
316 (detail
317 :allocation :alien
318 :accessor event-detail
319 :initarg :detail
320 :type notify-type)
321 (focus
322 :allocation :alien
323 :accessor event-focus
324 :initarg :focus
325 :type boolean)
326 (state
327 :allocation :alien
328 :accessor event-state
329 :initarg :state
330 :type unsigned-int))
331 (:metaclass event-class))
332
333
334(defclass enter-notify-event (crossing-event)
5d462688 335 ()
336 (:metaclass event-class)
57e4839d 337 (:event-type :enter-notify))
5d462688 338
c07660b3 339(defclass leave-notify-event (crossing-event)
5d462688 340 ()
341 (:metaclass event-class)
57e4839d 342 (:event-type :leave-notify))
5d462688 343
344(defclass focus-change-event (event)
c07660b3 345 ((in
346 :allocation :alien
347 :accessor event-in
348 :initarg :in
57e4839d 349 :type (bool 16)))
5d462688 350 (:metaclass event-class)
57e4839d 351 (:event-type :focus-change))
5d462688 352
353(defclass configure-event (event)
354 ((x
355 :allocation :alien
356 :accessor event-x
357 :initarg :x
358 :type int)
359 (y
360 :allocation :alien
361 :accessor event-y
362 :initarg :y
363 :type int)
364 (width
365 :allocation :alien
366 :accessor event-width
367 :initarg :width
368 :type int)
369 (height
370 :allocation :alien
371 :accessor event-height
372 :initarg :height
373 :type int))
374 (:metaclass event-class)
57e4839d 375 (:event-type :configure))
5d462688 376
377(defclass map-event (event)
378 ()
379 (:metaclass event-class)
57e4839d 380 (:event-type :map))
5d462688 381
382(defclass unmap-event (event)
383 ()
384 (:metaclass event-class)
57e4839d 385 (:event-type :unmap))
5d462688 386
387(defclass property-notify-event (event)
388 ()
389 (:metaclass event-class)
57e4839d 390 (:event-type :property-notify))
5d462688 391
392(defclass selection-clear-event (event)
393 ()
394 (:metaclass event-class)
57e4839d 395 (:event-type :selection-clear))
5d462688 396
397(defclass selection-request-event (event)
398 ()
399 (:metaclass event-class)
57e4839d 400 (:event-type :selection-request))
5d462688 401
402(defclass selection-notify-event (event)
403 ()
404 (:metaclass event-class)
57e4839d 405 (:event-type :selection-notify))
5d462688 406
c07660b3 407(defclass dnd-event (event)
408 ((context
409 :allocation :alien
410 :accessor event-contex
411 :initarg :context
412 :type drag-context)
413 (time
414 :allocation :alien
415 :accessor event-time
416 :initarg :time
417 :type (unsigned 32))
418 (x-root
419 :allocation :alien
420 :accessor event-x-root
421 :initarg :x-root
422 :type short)
423 (y-root
424 :allocation :alien
425 :accessor event-y-root
426 :initarg :y-root
427 :type short))
428 (:metaclass event-class))
429
430(defclass drag-enter-event (dnd-event)
5d462688 431 ()
432 (:metaclass event-class)
57e4839d 433 (:event-type :drag-enter))
5d462688 434
c07660b3 435(defclass drag-leave-event (dnd-event)
5d462688 436 ()
437 (:metaclass event-class)
57e4839d 438 (:event-type :drag-leave))
5d462688 439
c07660b3 440(defclass drag-motion-event (dnd-event)
5d462688 441 ()
442 (:metaclass event-class)
57e4839d 443 (:event-type :drag-motion))
5d462688 444
c07660b3 445(defclass drag-status-event (dnd-event)
5d462688 446 ()
447 (:metaclass event-class)
57e4839d 448 (:event-type :drag-status))
5d462688 449
c07660b3 450(defclass drot-start-event (dnd-event)
5d462688 451 ()
452 (:metaclass event-class)
57e4839d 453 (:event-type :drop-start))
5d462688 454
c07660b3 455(defclass drop-finished-event (dnd-event)
5d462688 456 ()
457 (:metaclass event-class)
57e4839d 458 (:event-type :drop-finished))
5d462688 459
460(defclass client-event (event)
461 ()
462 (:metaclass event-class)
57e4839d 463 (:event-type :client-event))
5d462688 464
465(defclass visibility-notify-event (event)
466 ((state
467 :allocation :alien
468 :accessor event-state
469 :initarg :state
470 :type visibility-state))
471 (:metaclass event-class)
57e4839d 472 (:event-type :visibility-notify))
5d462688 473
474(defclass no-expose-event (event)
475 ()
476 (:metaclass event-class)
57e4839d 477 (:event-type :no-expose))
5d462688 478
479(defclass scroll-event (timed-event)
c07660b3 480 ((x
481 :allocation :alien
482 :accessor event-x
483 :initarg :x
484 :type double-float)
485 (y
486 :allocation :alien
487 :accessor event-y
488 :initarg :y
489 :type double-float)
490 (state
491 :allocation :alien
492 :accessor event-state
493 :initarg :state
494 :type modifier-type)
495 (direction
496 :allocation :alien
497 :accessor event-direction
498 :initarg :direction
499 :type scroll-direction)
500 (root-x
501 :allocation :alien
502 :accessor event-root-x
503 :initarg :root-x
504 :type double-float)
505 (root-y
506 :allocation :alien
507 :accessor event-root-y
508 :initarg :root-y
509 :type double-float))
5d462688 510 (:metaclass event-class)
57e4839d 511 (:event-type :scroll))
5d462688 512
c07660b3 513(defclass setting-event (event)
514 ((action
515 :allocation :alien
516 :accessor event-action
517 :initarg :action
518 :type setting-action)
519 (name
520 :allocation :alien
521 :accessor event-name
522 :initarg :name
523 :type string))
5d462688 524 (:metaclass event-class)
57e4839d 525 (:event-type :setting))
c07660b3 526
527(defclass proximity-event (timed-event)
528 ((device
529 :allocation :alien
530 :accessor event-device
531 :initarg :device
532 :type device))
533 (:metaclass event-class))
534
535(defclass proximity-in-event (proximity-event)
536 ()
537 (:metaclass event-class)
57e4839d 538 (:event-type :proximity-in))
c07660b3 539
540(defclass proximity-out-event (proximity-event)
541 ()
542 (:metaclass event-class)
57e4839d 543 (:event-type :proximity-out))
c07660b3 544
545(defclass window-state-event (event)
546 ((change-mask
547 :allocation :alien
548 :accessor event-change-mask
549 :initarg :change-mask
550 :type window-state)
551 (new-window-state
552 :allocation :alien
553 :accessor event-new-window-state
554 :initarg :new-window-state
555 :type window-state))
556 (:metaclass event-class)
57e4839d 557 (:event-type :window-state))
c07660b3 558
559(defclass owner-change-event (event)
560 ()
561 (:metaclass event-class)
57e4839d 562 (:event-type :owner-change))
c07660b3 563
953030a3 564(defclass grab-broken-event (event)
565 ((keyboard
566 :allocation :alien
567 :accessor event-keyboard
568 :initarg :keyboard
569 :type boolean)
570 (implicit
571 :allocation :alien
572 :accessor event-implicit
573 :initarg :implicit
c1df82a9 574 :type boolean)
575 (grab-window
576 :allocation :alien
577 :accessor event-grab-window
578 :initarg :grab-window
579 :type window))
953030a3 580 (:metaclass event-class)
581 (:event-type :grab-broken))