Sun Jan 10 09:52:49 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Split up in qt.gui & cleanup name prefix.

--- old-qt.gui/src/signal-slot/slot.lisp 2014-10-30 07:42:42.000000000 +0100

+++ new-qt.gui/src/signal-slot/slot.lisp 1970-01-01 01:00:00.000000000 +0100

@@ -1,63 +0,0 @@

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

-

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

-