5d462688 |
1 | ;; Common Lisp bindings for GTK+ v2.0 |
2 | ;; Copyright (C) 1999-2001 Espen S. Johnsen <esj@stud.cs.uit.no> |
3 | ;; |
4 | ;; This library is free software; you can redistribute it and/or |
5 | ;; modify it under the terms of the GNU Lesser General Public |
6 | ;; License as published by the Free Software Foundation; either |
7 | ;; version 2 of the License, or (at your option) any later version. |
8 | ;; |
9 | ;; This library is distributed in the hope that it will be useful, |
10 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
11 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
12 | ;; Lesser General Public License for more details. |
13 | ;; |
14 | ;; You should have received a copy of the GNU Lesser General Public |
15 | ;; License along with this library; if not, write to the Free Software |
16 | ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
17 | |
18 | ;; $Id: gdkevents.lisp,v 1.1 2001-05-11 16:20:20 espen Exp $ |
19 | |
20 | (in-package "GDK") |
21 | |
22 | |
23 | (defvar *event-classes* (make-hash-table)) |
24 | |
25 | (defun %type-of-event (location) |
26 | (class-name |
27 | (gethash |
28 | (funcall (intern-reader-function 'event-type) location 0) |
29 | *event-classes*))) |
30 | |
31 | (eval-when (:compile-toplevel :load-toplevel :execute) |
32 | (defclass event (boxed) |
33 | ((%type |
34 | :allocation :alien |
35 | :type event-type) |
36 | (window |
37 | :allocation :alien |
38 | :accessor event-window |
39 | :initarg :window |
40 | :type window) |
41 | (send-event |
42 | :allocation :alien |
43 | :accessor event-send-event |
44 | :initarg :send-event |
45 | :type (boolean 8)) |
46 | (%align :allocation :alien :offset 2 :type (unsigned 8))) |
47 | (:metaclass boxed-class))) |
48 | |
49 | |
50 | (defmethod initialize-instance ((event event) &rest initargs) |
51 | (declare (ignore initargs)) |
52 | (with-slots (location %type) event |
53 | (setf location (%event-new)) |
54 | (setf %type (event-class-type (class-of event)))) |
55 | (call-next-method)) |
56 | |
57 | (deftype-method translate-from-alien |
58 | event (type-spec location &optional weak-ref) |
59 | (declare (ignore type-spec)) |
60 | `(let ((location ,location)) |
61 | (unless (null-pointer-p location) |
62 | (ensure-proxy-instance (%type-of-event location) location ,weak-ref)))) |
63 | |
64 | (defbinding %event-new () pointer) |
65 | |
66 | |
67 | ;;;; Metaclass for event classes |
68 | |
69 | (eval-when (:compile-toplevel :load-toplevel :execute) |
70 | (defclass event-class (proxy-class) |
71 | ((event-type :reader event-class-type)))) |
72 | |
73 | |
74 | (defmethod shared-initialize ((class event-class) names |
75 | &rest initargs &key type) |
76 | (declare (ignore initargs names)) |
77 | (call-next-method) |
78 | (setf (slot-value class 'event-type) (first type)) |
79 | (setf (gethash (first type) *event-classes*) class)) |
80 | |
81 | |
82 | (defmethod validate-superclass |
83 | ((class event-class) (super pcl::standard-class)) |
84 | (subtypep (class-name super) 'event)) |
85 | |
86 | |
87 | ;;;; |
88 | |
89 | (defclass timed-event (event) |
90 | ((time |
91 | :allocation :alien |
92 | :accessor event-time |
93 | :initarg :time |
94 | :type (unsigned 32))) |
95 | (:metaclass proxy-class)) |
96 | |
97 | (defclass delete-event (event) |
98 | () |
99 | (:metaclass event-class) |
100 | (:type :delete)) |
101 | |
102 | (defclass destroy-event (event) |
103 | () |
104 | (:metaclass event-class) |
105 | (:type :destroy)) |
106 | |
107 | (defclass expose-event (event) |
108 | ((x |
109 | :allocation :alien |
110 | :accessor event-x |
111 | :initarg :x |
112 | :type int) |
113 | (y |
114 | :allocation :alien |
115 | :accessor event-y |
116 | :initarg :y |
117 | :type int) |
118 | (width |
119 | :allocation :alien |
120 | :accessor event-width |
121 | :initarg :width |
122 | :type int) |
123 | (height |
124 | :allocation :alien |
125 | :accessor event-height |
126 | :initarg :height |
127 | :type int) |
128 | (count |
129 | :allocation :alien |
130 | :accessor event-count |
131 | :initarg :count |
132 | :type int)) |
133 | (:metaclass event-class) |
134 | (:type :expose)) |
135 | |
136 | (defclass motion-notify-event (timed-event) |
137 | ((x |
138 | :allocation :alien |
139 | :accessor event-x |
140 | :initarg :x |
141 | :type double-float) |
142 | (y |
143 | :allocation :alien |
144 | :accessor event-y |
145 | :initarg :y |
146 | :type double-float) |
147 | (state |
148 | :allocation :alien |
149 | :offset #.(size-of 'pointer) |
150 | :accessor event-state |
151 | :initarg :state |
152 | :type unsigned-int) |
153 | (is-hint |
154 | :allocation :alien |
155 | :accessor event-is-hint |
156 | :initarg :is-hint |
157 | :type (signed 16) ; should it be (boolean 16)? |
158 | ) |
159 | (device |
160 | :allocation :alien |
161 | :offset 2 |
162 | :accessor event-device |
163 | :initarg :device |
164 | :type device) |
165 | (root-x |
166 | :allocation :alien |
167 | :accessor event-root-x |
168 | :initarg :root-x |
169 | :type double-float) |
170 | (root-y |
171 | :allocation :alien |
172 | :accessor event-root-y |
173 | :initarg :root-y |
174 | :type double-float)) |
175 | (:metaclass event-class) |
176 | (:type :motion-notify)) |
177 | |
178 | (defclass button-press-event (timed-event) |
179 | ((x |
180 | :allocation :alien |
181 | :accessor event-x |
182 | :initarg :x |
183 | :type double-float) |
184 | (y |
185 | :allocation :alien |
186 | :accessor event-y |
187 | :initarg :y |
188 | :type double-float) |
189 | (state |
190 | :allocation :alien |
191 | :offset #.(size-of 'pointer) |
192 | :accessor event-state |
193 | :initarg :state |
194 | :type modifier-type) |
195 | (button |
196 | :allocation :alien |
197 | :accessor event-button |
198 | :initarg :button |
199 | :type unsigned-int) |
200 | (device |
201 | :allocation :alien |
202 | :accessor event-device |
203 | :initarg :device |
204 | :type device) |
205 | (root-x |
206 | :allocation :alien |
207 | :accessor event-root-x |
208 | :initarg :root-x |
209 | :type double-float) |
210 | (root-y |
211 | :allocation :alien |
212 | :accessor event-root-y |
213 | :initarg :root-y |
214 | :type double-float)) |
215 | (:metaclass event-class) |
216 | (:type :button-press)) |
217 | |
218 | (defclass 2-button-press-event (button-press-event) |
219 | () |
220 | (:metaclass event-class) |
221 | (:type :2button-press)) |
222 | |
223 | (defclass 3-button-press-event (button-press-event) |
224 | () |
225 | (:metaclass event-class) |
226 | (:type :3button-press)) |
227 | |
228 | (defclass button-release-event (button-press-event) |
229 | () |
230 | (:metaclass event-class) |
231 | (:type :button-release)) |
232 | |
233 | (defclass key-press-event (event) |
234 | () |
235 | (:metaclass event-class) |
236 | (:type :key-press)) |
237 | |
238 | (defclass key-release-event (event) |
239 | () |
240 | (:metaclass event-class) |
241 | (:type :key-release)) |
242 | |
243 | (defclass enter-notify-event (event) |
244 | () |
245 | (:metaclass event-class) |
246 | (:type :enter-notify)) |
247 | |
248 | (defclass leave-notify-event (event) |
249 | () |
250 | (:metaclass event-class) |
251 | (:type :leave-notify)) |
252 | |
253 | (defclass focus-change-event (event) |
254 | () |
255 | (:metaclass event-class) |
256 | (:type :focus-change)) |
257 | |
258 | (defclass configure-event (event) |
259 | ((x |
260 | :allocation :alien |
261 | :accessor event-x |
262 | :initarg :x |
263 | :type int) |
264 | (y |
265 | :allocation :alien |
266 | :accessor event-y |
267 | :initarg :y |
268 | :type int) |
269 | (width |
270 | :allocation :alien |
271 | :accessor event-width |
272 | :initarg :width |
273 | :type int) |
274 | (height |
275 | :allocation :alien |
276 | :accessor event-height |
277 | :initarg :height |
278 | :type int)) |
279 | (:metaclass event-class) |
280 | (:type :configure)) |
281 | |
282 | (defclass map-event (event) |
283 | () |
284 | (:metaclass event-class) |
285 | (:type :map)) |
286 | |
287 | (defclass unmap-event (event) |
288 | () |
289 | (:metaclass event-class) |
290 | (:type :unmap)) |
291 | |
292 | (defclass property-notify-event (event) |
293 | () |
294 | (:metaclass event-class) |
295 | (:type :property-notify)) |
296 | |
297 | (defclass selection-clear-event (event) |
298 | () |
299 | (:metaclass event-class) |
300 | (:type :selection-clear)) |
301 | |
302 | (defclass selection-request-event (event) |
303 | () |
304 | (:metaclass event-class) |
305 | (:type :selection-request)) |
306 | |
307 | (defclass selection-notify-event (event) |
308 | () |
309 | (:metaclass event-class) |
310 | (:type :selection-notify)) |
311 | |
312 | (defclass drag-enter-event (event) |
313 | () |
314 | (:metaclass event-class) |
315 | (:type :drag-enter)) |
316 | |
317 | (defclass drag-leave-event (event) |
318 | () |
319 | (:metaclass event-class) |
320 | (:type :drag-leave)) |
321 | |
322 | (defclass drag-motion-event (event) |
323 | () |
324 | (:metaclass event-class) |
325 | (:type :drag-motion)) |
326 | |
327 | (defclass drag-status-event (event) |
328 | () |
329 | (:metaclass event-class) |
330 | (:type :drag-status)) |
331 | |
332 | (defclass drag-start-event (event) |
333 | () |
334 | (:metaclass event-class) |
335 | (:type :drag-start)) |
336 | |
337 | (defclass drag-finished-event (event) |
338 | () |
339 | (:metaclass event-class) |
340 | (:type :drag-finished)) |
341 | |
342 | (defclass client-event (event) |
343 | () |
344 | (:metaclass event-class) |
345 | ;(:type :client-event) |
346 | ) |
347 | |
348 | (defclass visibility-notify-event (event) |
349 | ((state |
350 | :allocation :alien |
351 | :accessor event-state |
352 | :initarg :state |
353 | :type visibility-state)) |
354 | (:metaclass event-class) |
355 | (:type :visibility-notify)) |
356 | |
357 | (defclass no-expose-event (event) |
358 | () |
359 | (:metaclass event-class) |
360 | (:type :no-expose)) |
361 | |
362 | (defclass scroll-event (timed-event) |
363 | () |
364 | (:metaclass event-class) |
365 | (:type :scroll)) |
366 | |
367 | (defclass setting-event (timed-event) |
368 | () |
369 | (:metaclass event-class) |
370 | (:type :setting)) |