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)) |