blob: 6152c3e026f5c4fd0d59957ced859fbf9475fbba (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
|
;;;; interactive.lisp
(in-package #:wheelwork)
(defclass/std interactive ()
((listener :type (or null listener) :std nil :a)
(focusablep :std t :doc "Whether or not this object can receive application focus."))
(:documentation "Supplies an object with a listener slot."))
(defun add-handler (interactive handler)
"Adds HANDLER to INTERACTIVE. HANDLER is an instance of
WHEELWORK::EVENT-HANDLER, as most readily constructed by using the
ON-* Macros."
(when (null (listener interactive))
(setf (listener interactive) (make-instance 'listener)))
(pushnew handler (slot-value (listener interactive) (event-type handler)) :test #'eq)
(setf
(gethash interactive (listener-table-for (listener interactive) (event-type handler)))
t))
(defun remove-handler (interactive handler-or-event-type)
"Handler can be an instance of EVENT-HANDLER or can be a symbol
whose name is an event type. If is an event handler, only that
handler will be removed. If it is an event type, all events of that
type name are removed from the object."
(when (listener interactive)
(let ((event-type (etypecase handler-or-event-type
(keyword (intern (symbol-name handler-or-event-type) :wheelwork))
(symbol (intern (symbol-name handler-or-event-type) :wheelwork))
(event-handler (event-type handler-or-event-type)))))
(setf (slot-value (listener interactive) event-type)
(if (symbolp handler-or-event-type)
;; remove everything if a symbol
nil
;; delete just the handler
(delete handler-or-event-type
(slot-value (listener interactive) event-type)
:test #'eq)))
;; remove from from the global table unless any listeners remain on this event
(unless (slot-value (listener interactive) event-type)
(remhash interactive (listener-table-for (listener interactive) event-type))))))
|
