CLIM 2 Specification — 29.5 Defining New Pane Types

29.5 Defining New Pane Types

This section describes how to define new pane classes. The first section shows a new kind of leaf pane (an odd kind of push-button). The second section shows a new composite pane that draws a dashed border around its contents. [annotate]

29.5.1 Defining a New Leaf Pane

To define a gadget pane implementation, first define the appearance and layout behavior of the gadget, then define the callbacks, then define the specific user interactions that trigger the callbacks. [annotate]

For example, to define an odd new kind of button that displays itself as a circle, and activates whenever the mouse is moved over it, proceed as follows: [annotate]

;; A new kind of button.
(defclass sample-button-pane
          (action-gadget
           space-requirement-mixin
           leaf-pane)
    ())

;; An arbitrary size parameter.
(defparameter *sample-button-radius* 10)

;; Define the sheet's repaint method to draw the button.
(defmethod handle-repaint ((button sample-button-pane) region)
  (with-sheet-medium (medium button)
    (let ((radius *sample-button-radius*)
          (half (round  *sample-button-radius* 2)))
      ;; Larger circle with small one in the center
      (draw-circle* medium radius radius radius
                    :filled nil)
      (draw-circle* medium radius radius half
                    :filled t)))

;; Define the pane's compose-space method to always request the
;; fixed size of the pane.
(defmethod compose-space ((pane sample-button-pane) &key width height)
  (declare (ignore width height))
  (make-space-requirement :width  (* 2 *sample-button-radius*)
                          :height (* 2 *sample-button-radius*)))

The above code is enough to allow you to instantiate the button pane in an application frame. It will fit in with the space composition protocol of, for example, an hbox-pane. It will display itself as two nested circles. [annotate]

The next step is to define the callbacks supported by this gadget, and the user interaction that triggers them. [annotate]

;; This default method is defined so that the callback can be invoked
;; on an arbitrary client without error.
(defmethod activate-callback
           ((button sample-button-pane) client id)
  (declare (ignore client id value)))

;; This event processing method defines the rather odd interaction
;; style of this button, to wit, it triggers the activate callback
;; whenever the mouse moves into it.
(defmethod handle-event ((pane sample-button-pane) (event pointer-enter-event))
  (activate-callback pane (gadget-client pane) (gadget-id pane)))

29.5.2 Defining a New Composite Pane

To define a new layout pane implementation, the programmer must define how the much space the pane takes, where its children go, and what the pane looks like. [annotate]

For example, to define a new kind of border pane that draws a dashed border around its child pane, proceed as follows: [annotate]

Note: The LAYOUT-PANE class refered to below in nowhere described in this specification. But: By experimentation we found out that it in fact needed in "real" CLIM. In Lispworks it hides as CLIM-SILICA::LAYOUT-PANE. In real CLIM the example below would not work by inheriting from say BASIC-PANE; allocate-space would never be called. [edit]-- Gilbert Baumann 2003-05-30 00:19Z

;; The new layout pane class.
(defclass dashed-border-pane (layout-pane)
    ((thickness :initform 1 :initarg :thickness))
  (:default-initargs :background +black+))

;; The specified contents are the sole child of the pane.
(defmethod initialize-instance :after ((pane dashed-border-pane) &key contents)
  (sheet-adopt-child pane contents))

;; The composite pane takes up all of the space of the child, plus
;; the space required for the border.
(defmethod compose-space ((pane dashed-border-pane) &key width height)
  (let ((thickness (slot-value pane 'thickness))
        (child (sheet-child pane)))
    (space-requirement+
      (compose-space child :width width :height height)
      (make-space-requirement 
        :width (* 2 thickness)
        :height (* 2 thickness)))))

;; The child pane is positioned just inside the borders.
(defmethod allocate-space ((pane dashed-border-pane) width height)
  (let ((thickness (slot-value pane 'thickness)))
    (move-and-resize-sheet
      (sheet-child pane)
      thickness thickness
      (- width (* 2 thickness)) (- height (* 2 thickness)))))
  
(defmethod handle-repaint ((pane dashed-border-pane) region)
  (declare (ignore region))                     ;not worth checking
  (with-sheet-medium (medium pane)
    (with-bounding-rectangle* (left top right bottom) (sheet-region pane)
      (let ((thickness (slot-value pane 'thickness)))
        (decf right (ceiling thickness 2))
        (decf bottom (ceiling thickness 2))
        (draw-rectangle* medium left top right bottom
                         :line-thickness thickness :filled nil
                         :ink (pane-background pane))))))

(defmacro dashed-border ((&rest options &key thickness &allow-other-keys)
                         &body contents)
  (declare (ignore thickness))
  `(make-pane 'dashed-border-pane
     :contents ,@contents
     ,@options))