;;;; 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 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 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)
            (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))))
      ;; 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))))))