1 ;; Common Lisp bindings for GTK+ v2.0
2 ;; Copyright (C) 1999-2001 Espen S. Johnsen <esj@stud.cs.uit.no>
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.
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.
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
18 ;; $Id: gdkevents.lisp,v 1.3 2001-10-21 23:02:40 espen Exp $
23 (defvar *event-classes* (make-hash-table))
25 (defun %type-of-event (location)
28 (funcall (intern-reader-function 'event-type) location 0)
31 (eval-when (:compile-toplevel :load-toplevel :execute)
32 (defclass event (boxed)
38 :accessor event-window
43 :accessor event-send-event
46 (%align :allocation :alien :offset 2 :type (unsigned 8)))
47 (:metaclass boxed-class)))
50 (defmethod initialize-instance ((event event) &rest initargs)
51 (declare (ignore initargs))
53 (setf (slot-value event '%type) (event-class-type (class-of event))))
55 (deftype-method translate-from-alien
56 event (type-spec location &optional weak-ref)
57 (declare (ignore type-spec))
58 `(let ((location ,location))
59 (unless (null-pointer-p location)
60 (ensure-proxy-instance (%type-of-event location) location ,weak-ref))))
63 ;;;; Metaclass for event classes
65 (eval-when (:compile-toplevel :load-toplevel :execute)
66 (defclass event-class (proxy-class)
67 ((event-type :reader event-class-type)))
70 (defmethod shared-initialize ((class event-class) names
71 &rest initargs &key type)
72 (declare (ignore initargs names))
74 (setf (slot-value class 'event-type) (first type))
75 (setf (gethash (first type) *event-classes*) class))
78 (defmethod validate-superclass
79 ((class event-class) (super pcl::standard-class))
80 (subtypep (class-name super) 'event)))
85 (defclass timed-event (event)
91 (:metaclass proxy-class))
93 (defclass delete-event (event)
95 (:metaclass event-class)
98 (defclass destroy-event (event)
100 (:metaclass event-class)
103 (defclass expose-event (event)
116 :accessor event-width
121 :accessor event-height
126 :accessor event-count
129 (:metaclass event-class)
132 (defclass motion-notify-event (timed-event)
145 :offset #.(size-of 'pointer)
146 :accessor event-state
151 :accessor event-is-hint
153 :type (signed 16) ; should it be (boolean 16)?
158 :accessor event-device
163 :accessor event-root-x
168 :accessor event-root-y
171 (:metaclass event-class)
172 (:type :motion-notify))
174 (defclass button-press-event (timed-event)
187 :offset #.(size-of 'pointer)
188 :accessor event-state
193 :accessor event-button
198 :accessor event-device
203 :accessor event-root-x
208 :accessor event-root-y
211 (:metaclass event-class)
212 (:type :button-press))
214 (defclass 2-button-press-event (button-press-event)
216 (:metaclass event-class)
217 (:type :2button-press))
219 (defclass 3-button-press-event (button-press-event)
221 (:metaclass event-class)
222 (:type :3button-press))
224 (defclass button-release-event (button-press-event)
226 (:metaclass event-class)
227 (:type :button-release))
229 (defclass key-press-event (event)
231 (:metaclass event-class)
234 (defclass key-release-event (event)
236 (:metaclass event-class)
237 (:type :key-release))
239 (defclass enter-notify-event (event)
241 (:metaclass event-class)
242 (:type :enter-notify))
244 (defclass leave-notify-event (event)
246 (:metaclass event-class)
247 (:type :leave-notify))
249 (defclass focus-change-event (event)
251 (:metaclass event-class)
252 (:type :focus-change))
254 (defclass configure-event (event)
267 :accessor event-width
272 :accessor event-height
275 (:metaclass event-class)
278 (defclass map-event (event)
280 (:metaclass event-class)
283 (defclass unmap-event (event)
285 (:metaclass event-class)
288 (defclass property-notify-event (event)
290 (:metaclass event-class)
291 (:type :property-notify))
293 (defclass selection-clear-event (event)
295 (:metaclass event-class)
296 (:type :selection-clear))
298 (defclass selection-request-event (event)
300 (:metaclass event-class)
301 (:type :selection-request))
303 (defclass selection-notify-event (event)
305 (:metaclass event-class)
306 (:type :selection-notify))
308 (defclass drag-enter-event (event)
310 (:metaclass event-class)
313 (defclass drag-leave-event (event)
315 (:metaclass event-class)
318 (defclass drag-motion-event (event)
320 (:metaclass event-class)
321 (:type :drag-motion))
323 (defclass drag-status-event (event)
325 (:metaclass event-class)
326 (:type :drag-status))
328 (defclass drag-start-event (event)
330 (:metaclass event-class)
333 (defclass drag-finished-event (event)
335 (:metaclass event-class)
336 (:type :drag-finished))
338 (defclass client-event (event)
340 (:metaclass event-class)
341 ;(:type :client-event)
344 (defclass visibility-notify-event (event)
347 :accessor event-state
349 :type visibility-state))
350 (:metaclass event-class)
351 (:type :visibility-notify))
353 (defclass no-expose-event (event)
355 (:metaclass event-class)
358 (defclass scroll-event (timed-event)
360 (:metaclass event-class)
363 (defclass setting-event (timed-event)
365 (:metaclass event-class)