(in-package :cl-smoke.qt.core)

(defclass qslot (qt:object)
  ((arguments :reader arguments :initarg :argument-types
              :documentation "List of the argument types for the slot.")
   (function :reader slot-function :initarg :slot-function
             :initform (error "no slot function specified")
             :documentation "The function called when the slot is invoked."))
  (:metaclass cxx:class)
  (:documentation "A Qt slot that calls its associated function"))

(defun qt:make-slot (function &optional (arguments nil arguments-p))
  "Returns a slot that calls FUNCTION when it receives a signal."
  (if arguments-p
      (make-instance 'qslot
                     :slot-function function
                     :argument-types arguments)
      (make-instance 'qslot
                     :slot-function function)))

(defmethod id ((slot qslot))
 (cxx:method-count (cxx:meta-object slot)))

(defparameter *sender* nil "The sender of the signal.")
(defparameter *this* nil "The slot that is invoked.")
(defmacro qt:sender ()
  "Returns the sender that invoked the slot."
  `*sender*)

(defmethod cxx:qt-metacall ((slot qslot) call id arguments)
  "Invoke the slots function when it is called. The return value
of the invoked slot function is ignored."
  (declare (ignore id))
  (let ((id (call-next-method)))
    (if (< id 0)
        id
        (if (enum= call qt:meta-object.+invoke-meta-method+)
            (progn
              (ccase id
                (0 (let ((*sender* (cxx:sender slot))
                         (*this* slot))
                     (with-simple-restart
                         (continue "Skip the function ~A of slot ~A."
                                   (slot-function slot) slot)
                       (apply (slot-function slot)
                              (arguments-to-lisp arguments (arguments slot)))))))
              (1- id))
            id))))

(defun find-signal-id (sender signal)
  "Returns the ID of SIGNAL from SENDER."
  ;; For efficiency assume that SIGNAL is normalized and fallback to
  ;; normalizing when not. (Just like Qt does.)
  (let ((id (cxx:index-of-signal (cxx:meta-object sender)
                                 signal)))
    (when (< id 0)
      (setf id (cxx:index-of-signal (cxx:meta-object sender)
                                    (qt:meta-object.normalized-signature signal))))
    (when (< id 0)
      (error "No signal ~S for class ~S."
             signal (class-of sender)))
    id))