diff options
Diffstat (limited to 'src/interactive/interactive.lisp')
| -rw-r--r-- | src/interactive/interactive.lisp | 35 |
1 files changed, 20 insertions, 15 deletions
diff --git a/src/interactive/interactive.lisp b/src/interactive/interactive.lisp index 6152c3e..ceacf1b 100644 --- a/src/interactive/interactive.lisp +++ b/src/interactive/interactive.lisp @@ -19,24 +19,29 @@ ON-* Macros." 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." +(defun remove-handler (interactive thing &key tag) + "THING 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, and if TAG is NIL, then all + events of that type name are removed from the object. Otherwise, + just the event with the provided TAG is removed. If no such tag is + found, none are removed." (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))))) + (let ((event-type (etypecase thing + (keyword (intern (symbol-name thing) :wheelwork)) + (symbol (intern (symbol-name thing) :wheelwork)) + (event-handler (event-type thing))))) (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 + (cond + ((and (symbolp thing) tag) + (delete-if (lambda (h) (equal (tag h) tag)) + (slot-value (listener interactive) event-type))) + ((symbolp thing) + nil) + (t + (delete thing (slot-value (listener interactive) event-type) - :test #'eq))) + :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)))))) |