From 2bf554b6b349bc640287d41a43e89806386a41c8 Mon Sep 17 00:00:00 2001
From: Colin Okay <okay@toyful.space>
Date: Sat, 23 Jul 2022 15:01:13 -0500
Subject: [refactor] event-handlers to include a tag

---
 src/interactive/interactive.lisp | 35 ++++++++++++++++++++---------------
 1 file changed, 20 insertions(+), 15 deletions(-)

(limited to 'src/interactive/interactive.lisp')

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))))))
-- 
cgit v1.2.3