anchor.diff:  ;; SLIDER gadget
   ;;
   
  -(defclass slider-gadget (value-gadget oriented-gadget-mixin range-gadget-mixin labelled-gadget-mixin) ()
  +(defgeneric drag-callback (slider client gadget-id value))
  +
  +(defclass slider-gadget (value-gadget oriented-gadget-mixin range-gadget-mixin
  +				      labelled-gadget-mixin gadget-color-mixin) ()
     (:documentation "The value is a real number"))
     
  -(defclass slider-pane (slider-gadget clim-stream-pane)
  -  ((drag-callback :initarg :drag-callback
  +(defclass slider-pane (slider-gadget)
  +  ((drag-callback :initform nil
  +		  :initarg :drag-callback
   		  :reader slider-drag-callback)
  -   (show-value-p :type (member '(t nil)) ; don't have understood where is to use ?
  +   (show-value-p :type boolean
  +		 :initform nil
   		 :initarg :show-value-p
  -		 :reader gadget-show-value-p)))
  +		 :accessor gadget-show-value-p)))
   
   (defclass clx-slider-pane (slider-pane) ())
   
   (defmethod drag-callback ((pane slider-pane) client gadget-id value)
     (declare (ignore client gadget-id))
  -  (funcall (slider-drag-callback pane) pane value))
  -
  -(defmethod drag-callback :after ((pane slider-pane) client gadget-id value)
  -  (declare (ignore client gadget-id))
  -  (setf (gadget-value pane :invoke-callback t) value))
  +  (when (slider-drag-callback pane)
  +    (funcall (slider-drag-callback pane) pane value)))
  +
  +(defmethod handle-event ((pane slider-pane) (event pointer-enter-event))
  +  (setf (gadget-current-color pane) (gadget-highlighted-color pane)))
  +
  +(defmethod handle-event ((pane slider-pane) (event pointer-exit-event))
  +  (with-slots (armed) pane
  +    (when armed
  +      (setf armed nil)
  +      (when (gadget-show-value-p pane)
  +	(setf (gadget-show-value-p pane) nil)))
  +    (setf (gadget-current-color pane) (gadget-normal-color pane))))
  +
  +(defmethod handle-event ((pane slider-pane) (event pointer-button-press-event))
  +  (with-slots (armed) pane
  +     (unless armed
  +       (setf armed t)
  +       (when (gadget-show-value-p pane)
  +	 (setf (gadget-show-value-p pane) nil)))))
  +       
  +
  +(defmethod handle-event ((pane slider-pane) (event pointer-motion-event))
  +  (with-slots (armed) pane
  +    (when armed
  +      (let ((value (convert-position-to-value pane (pointer-event-y event))))
  +	(setf (gadget-value pane :invoke-callback nil) value)
  +	(drag-callback pane (gadget-client pane) (gadget-id pane) value)
  +	(dispatch-repaint pane (sheet-region pane))))))
  +
  +(defmethod handle-event ((pane slider-pane) (event pointer-button-release-event))
  +  (with-slots (armed) pane
  +    (when armed
  +      (setf armed nil
  +	    (gadget-show-value-p pane) t
  +	    (gadget-value pane :invoke-callback t) (convert-position-to-value pane (pointer-event-y event)))
  +      (dispatch-repaint pane (sheet-region pane)))))
  +
  +(defmethod handle-event ((pane slider-pane) (event window-repaint-event))
  +  (dispatch-repaint pane (sheet-region pane)))
  +
  +(defmethod convert-position-to-value ((pane slider-pane) y)
  +  (multiple-value-bind (x1 y1 x2 y2) (bounding-rectangle* (sheet-region pane))
  +    (declare (ignore x1 x2))
  +    (round (+ (gadget-min-value pane) (/ (* (gadget-range pane) (- y2 y)) (- y2 y1))))))
  +
  +(defmethod repaint-sheet ((pane slider-pane) region)
  +  (declare (ignore region))
  +  (let ((region (sheet-region pane))
  +	(position (convert-value-to-position pane)))
  +    (multiple-value-bind (x1 y1 x2 y2) (bounding-rectangle* region)
  +      (let ((middle-x (round (- x2 x1) 2)))
  +	(display-gadget-background pane 0 0 (- x2 x1) (- y2 y1))
  +	(draw-line* pane middle-x y1 middle-x y2 :ink +black+)
  +	(draw-rectangle* pane (- middle-x 15) (- position 5)
  +		       (+ middle-x 15) (+ position 5)
  +		       :ink +grey75+ :filled t)
  +	(draw-edges-lines* pane (- middle-x 15) (- position 5) (+ middle-x 15) (+ position 5))
  +	(when (gadget-show-value-p pane)
  +	  (draw-text* pane (princ-to-string (gadget-value pane))
  +		      (+ middle-x 20) position))))))
  +
  +(defmethod convert-value-to-position ((pane slider-pane))
  +  (multiple-value-bind (x1 y1 x2 y2) (bounding-rectangle* (sheet-region pane))
  +    (declare (ignore x1 x2))
  +    (- y2 (/ (* (- (gadget-value pane) (gadget-min-value pane)) (- y2 y1)) (gadget-range pane)))))
   
   
   ;;
  
positive.code: 
  (defmethod (setf gadget-value) 
    (value (gadget value-gadget) &key invoke-callback)
    (setf (slot-value gadget 'value)
          value)
    (when invoke-callback
      (value-changed-callback gadget 
                              (gadget-client gadget) 
  
negative.code: 
  (defmethod initialize-instance :after ((gadget gadget-color-mixin) &rest args)
    (declare (ignore args))
    (setf (slot-value gadget 'current-color) (gadget-normal-color gadget)))
  
  (defmethod display-gadget-background ((gadget gadget-color-mixin) x1 y1 x2 y2)
    (draw-rectangle* gadget x1 y1 x2 y2 :ink (gadget-current-color gadget) :filled t))
  
  (defmethod (setf gadget-current-color) :after (color (gadget gadget-color-mixin))
    (declare (ignore color))
    (dispatch-repaint gadget (sheet-region gadget)))
    
  
  ;;;
  ;;; gadgets look
  ;;;
  
  (defun draw-edges-lines* (pane x1 y1 x2 y2)
    (draw-line* pane x1 y1 x2 y1 :ink +white+)
    (draw-line* pane x1 y1 x1 y2 :ink +white+)
    (draw-line* pane x1 y2 x2 y2 :ink +black+)
    (draw-line* pane x2 y1 x2 y2 :ink +black+))
  
  
  ;;
  ;; gadget sub-classes
  ;;
  
  (defclass basic-gadget (gadget gadget-color-mixin sheet-parent-mixin sheet-leaf-mixin mirrored-sheet)
    ;; Half-baked attempt to be compatible with Lispworks.
    ())
  
  