The push button and slider gadgets alluded to above are abstract gadgets. The callback interface to all of the various implementations of the gadget is defined by the abstract class. In the :panes clause of define-application-frame, the abbreviation for a gadget is the name of the abstract gadget class. [annotate]
At pane creation time (that is, make-pane), the frame manager resolves the abstract class into a specific implementation class; the implementation classes specify the detailed look and feel of the gadget. Each frame manager will keep a mapping from abstract gadgets to an implementation class; if the frame manager does not implement its own gadget for the abstract gadget classes in the following sections, it should use the portable class provided by CLIM. Since every implementation of an abstract gadget class is a subclass of the abstract class, they all share the same programmer interface. [annotate]
Every gadget has a client that is specified when the gadget is created. The client is notified via the callback mechanism when any important user interaction takes place. Typically, a gadget's client will be an application frame or a composite pane. Each callback generic function is invoked on the gadget, its client, the gadget id (described below), and other arguments that vary depending on the callback. [annotate]
For example, the argument list for activate-callback looks like (gadget client gadget-id). Assuming the programmer has defined an application frame called button-test that has a CLIM stream pane in the slot output-pane, he could write the following method: [annotate]
(defmethod activate-callback
((button push-button) (client button-test) gadget-id)
(with-slots (output-pane) client
(format output-pane "The button ~S was pressed, client ~S, id ~S."
button client gadget-id)))
One problem with this example is that it differentiates on the class of the gadget, not on the particular gadget instance. That is, the same method will run for every push button that has the button-test frame as its client. [annotate]
One way to distinguish between the various gadgets is via the gadget id, which is also specified when the gadget is created. The value of the gadget id is passed as the third argument to each callback generic function. In this case, if we have two buttons, we might install start and stop as the respective gadget ids and then use eql specializers on the gadget ids. We could then refine the above as: [annotate]
(defmethod activate-callback
((button push-button) (client button-test) (gadget-id (eql 'start)))
(start-test client))
(defmethod activate-callback
((button push-button) (client button-test) (gadget-id (eql 'stop)))
(stop-test client))
;; Create the start and stop push buttons
(make-pane 'push-button
:label "Start"
:client frame :id 'start)
(make-pane 'push-button
:label "Stop"
:client frame :id 'stop)
Another way to distinguish between gadgets is to explicitly specify what function should be called when the callback is invoked. This is specified when the gadget is created by supplying an appropriate initarg. The above example could then be written as follows: [annotate]
;; No callback methods needed, just create the push buttons
(make-pane 'push-button
:label "Start"
:client frame :id 'start
:activate-callback
#'(lambda (gadget)
(start-test (gadget-client gadget))))
(make-pane 'push-button
:label "Stop"
:client frame :id 'stop
:activate-callback
#'(lambda (gadget)
(stop-test (gadget-client gadget))))
The following shows how a push button gadget might be implemented. [annotate]
;; Here is a concrete implementation of a CLIM PUSH-BUTTON.
;; The "null" frame manager create a pane of type PUSH-BUTTON-PANE when
;; asked to create a PUSH-BUTTON.
(defclass push-button-pane
(push-button
leaf-pane
space-requirement-mixin)
((show-as-default :initarg :show-as-default
:accessor push-button-show-as-default)
(armed :initform nil)))
;; General highlight-by-inverting method.
(defmethod highlight-button ((pane push-button-pane) medium)
(with-bounding-rectangle* (left top right bottom) (sheet-region pane)
(draw-rectangle* medium left top right bottom
:ink +flipping-ink+ :filled t)
(medium-force-output medium)))
;; Compute the amount of space required by a PUSH-BUTTON-PANE.
(defmethod compose-space ((pane push-button-pane) &key width height)
(let ((x-margin 4)
(y-margin 2))
(multiple-value-bind (width height)
(compute-gadget-label-size pane)
(make-space-requirement :width (+ width (* x-margin 2))
:height (+ height (* y-margin 2))))
;; This gets invoked to draw the push button.
(defmethod handle-repaint ((pane push-button-pane) region)
(declare (ignore region))
(with-sheet-medium (medium pane)
(let ((text (gadget-label pane))
(text-style (slot-value pane 'text-style))
(armed (slot-value pane 'armed))
(region (sheet-region pane)))
(multiple-value-call #'draw-rectangle*
medium (bounding-rectangle* (sheet-region pane))
:filled nil)
(draw-text medium text (bounding-rectangle-center region)
:text-style text-style
:align-x ':center :align-y ':center)
(when (eql armed ':button-press)
(highlight-button pane medium)))))
(defmethod handle-event :around ((pane push-button-pane) (event pointer-event))
(when (gadget-active-p pane)
(call-next-method)))
;; When we enter the push button's region, arm it. If there is a pointer
;; button down, make the button active as well.
(defmethod handle-event ((pane push-button-pane) (event pointer-enter-event))
(with-slots (armed) pane
(unless armed
(cond ((let ((pointer (pointer-event-pointer event)))
(and (pointer-button-state pointer)
(not (zerop (pointer-button-state pointer)))))
(setf armed :active)
(with-sheet-medium (medium pane)
(highlight-button pane medium)))
(t (setf armed t)))
(armed-callback pane (gadget-client pane) (gadget-id pane)))))
;; When we leave the push button's region, disarm it.
(defmethod handle-event ((pane push-button-pane) (event pointer-exit-event))
(with-slots (armed) pane
(when armed
(when (prog1 (eq armed :active) (setf armed nil))
(with-sheet-medium (medium pane)
(highlight-button pane medium)))
(disarmed-callback pane (gadget-client pane) (gadget-id pane)))))
;; When the user presses a pointer button, ensure that the button
;; is armed, and highlight it.
(defmethod handle-event ((pane push-button-pane) (event pointer-button-press-event))
(with-slots (armed) pane
(when armed
(setf armed :active)
(with-sheet-medium (medium pane)
(highlight-button pane medium)))))
;; When the user releases the button and the button is still armed,
;; call the activate callback.
(defmethod handle-event ((pane push-button-pane) (event pointer-button-release-event))
(with-slots (armed) pane
(when (eq armed :active)
(setf armed t)
(with-sheet-medium (medium pane)
(highlight-button pane medium))
(activate-callback pane (gadget-client pane) (gadget-id pane)))))