chiark - git - mdw - clg/blob - gdk/gdkevents.lisp

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