anchor.diff:       (when armed
          (setf armed nil)
          (disarmed-callback sb (gadget-client sb) (gadget-id sb)))))
  -
  -(defun get-orientation-dependant-informations (scroll-bar-pane)
  -  (if (eq (gadget-orientation scroll-bar-pane) :vertical)
  -      (values (- (bounding-rectangle-height (sheet-region scroll-bar-pane))
  -		 (* 2 *scrollbar-thickness*))
  -              #'pointer-event-y)
  -      (values (- (bounding-rectangle-width (sheet-region scroll-bar-pane))
  -		 (* 2 *scrollbar-thickness*))
  -              #'pointer-event-x)))
  -
  -(defmethod dispatch-callbacks ((sb scroll-bar-pane) event)
  -  (multiple-value-bind (sb-length pos-func)
  -      (get-orientation-dependant-informations sb)
  -    (with-slots (value min-value max-value) sb
  -      (let* ((position (funcall pos-func event))
  -	     (value-clicked (/ (- position *scrollbar-thickness*) sb-length)))
  -        (cond
  -	 ((< position *scrollbar-thickness*)
  -	  (scroll-up-line-callback sb (gadget-client sb) (gadget-id sb)))
  -	 ((> position (+ sb-length *scrollbar-thickness*))
  -	  (scroll-down-line-callback sb (gadget-client sb) (gadget-id sb)))
  -	 ((< value-clicked (/ (- value min-value)
  -			 (- max-value min-value)))
  -	  (scroll-up-page-callback sb (gadget-client sb) (gadget-id sb)))
  -	 ((< (+ (/ (- value min-value)
  -			 (- max-value min-value))
  -		 (/ sb-length
  -			  (gadget-range sb)))
  -	      value-clicked)
  -	  (scroll-down-page-callback sb (gadget-client sb) (gadget-id sb))))))))
  +||#
   
   (defmethod handle-event ((sb scroll-bar-pane) (event pointer-button-press-event))
  -  (with-slots (armed) sb
  -    (unless armed
  -      (armed-callback sb (gadget-client sb) (gadget-id sb)))
  -    (setf armed ':button-press))
  -  (dispatch-callbacks sb event))
  +  (multiple-value-bind (x y) (transform-position (scroll-bar-transformation sb)
  +                                                 (pointer-event-x event) (pointer-event-y event))
  +    (with-slots (event-state drag-dy) sb
  +      (cond ((region-contains-position-p (scroll-bar-up-region sb) x y)
  +             (scroll-up-line-callback sb (gadget-client sb) (gadget-id sb))
  +             (setf event-state :up-armed)
  +             (repaint-sheet sb +everywhere+))
  +            ((region-contains-position-p (scroll-bar-down-region sb) x y)
  +             (scroll-down-line-callback sb (gadget-client sb) (gadget-id sb))
  +             (setf event-state :dn-armed)
  +             (repaint-sheet sb +everywhere+))
  +            ((region-contains-position-p (scroll-bar-thumb-region sb) x y)
  +             (setf event-state :dragging
  +                   drag-dy (- y (bounding-rectangle-min-y (scroll-bar-thumb-region sb)))))
  +            ((region-contains-position-p (scroll-bar-thumb-bed-region sb) x y)
  +             (if (< y (bounding-rectangle-min-y (scroll-bar-thumb-bed-region sb)))
  +                 (scroll-up-page-callback sb (gadget-client sb) (gadget-id sb))
  +                 (scroll-down-page-callback sb (gadget-client sb) (gadget-id sb))))
  +            (t
  +             nil)))))
  +
  +(defmethod handle-event ((sb scroll-bar-pane) (event pointer-button-release-event))
  +  (with-slots (event-state) sb
  +    (case event-state
  +      (:up-armed (setf event-state nil))
  +      (:dn-armed (setf event-state nil))
  +      (otherwise
  +       (setf event-state nil) )))
  +  (repaint-sheet sb +everywhere+) )
   
   (defmethod handle-event ((sb scroll-bar-pane) (event pointer-motion-event))
  -  (with-slots (armed dragged) sb
  -    (when (eq armed ':button-press)
  -      (multiple-value-bind (sb-length pos-func)
  -          (get-orientation-dependant-informations sb)
  -        (drag-callback sb (gadget-client sb) (gadget-id sb)
  -                       (min (max (+ (gadget-min-value sb)
  -				    (* (gadget-range sb)
  -				       (/ (- (funcall pos-func event) *scrollbar-thickness*)
  -					  sb-length)))
  -				 0)
  -			    (gadget-max-value sb))))
  -      (unless dragged
  -        (setf dragged t)))))
  -
  -(defmethod handle-event ((sb scroll-bar-pane) (event pointer-button-release-event))
  -  (declare (ignorable event))
  -  (with-slots (armed dragged) sb
  -     (when (eq armed ':button-press)
  -       (setf armed t)
  -       (when dragged
  -         (setf dragged nil)
  -         (multiple-value-bind (sb-length pos-func)
  -             (get-orientation-dependant-informations sb)
  -           (value-changed-callback sb (gadget-client sb) (gadget-id sb)
  -                                   (/ (funcall pos-func event) sb-length)))
  -         (disarmed-callback sb (gadget-client sb) (gadget-id sb))))))
  -
  +  (multiple-value-bind (x y) (transform-position (scroll-bar-transformation sb)
  +                                                 (pointer-event-x event) (pointer-event-y event))
  +    (declare (ignore x))
  +    (with-slots (event-state drag-dy) sb
  +      (case event-state
  +        (:dragging
  +         (let* ((y-new-thumb-top (- y drag-dy))
  +                (ts (* 1/3 (- (gadget-max-value sb) (gadget-min-value sb))))
  +                (new-value (translate-range-value y-new-thumb-top
  +                                                  (bounding-rectangle-min-y (scroll-bar-thumb-bed-region sb))
  +                                                  (bounding-rectangle-max-y (scroll-bar-thumb-bed-region sb))
  +                                                  (gadget-min-value sb)
  +                                                  (+ (gadget-max-value sb) ts))))
  +           (drag-callback sb (gadget-client sb) (gadget-id sb)
  +                          (min (gadget-max-value sb)
  +                               (max (gadget-min-value sb)
  +                                    new-value))) ))))))
  +
  +;;; Repaint
  +
  +(defmethod repaint-sheet ((sb scroll-bar-pane) region)
  +  (declare (ignore region))
  +  (with-special-choices (sb)
  +    (let ((tr (scroll-bar-transformation sb)))
  +      (with-bounding-rectangle* (minx miny maxx maxy) (transform-region tr (sheet-region sb))
  +        (with-drawing-options (sb :transformation tr)
  +          (draw-rectangle* sb minx miny maxx maxy :filled t
  +                           :ink *3d-normal-color*)
  +          ;; draw up arrow
  +          (with-bounding-rectangle* (x1 y1 x2 y2) (scroll-bar-up-region sb)
  +            (let ((pg (list (make-point (/ (+ x1 x2) 2) y1)
  +                            (make-point x1 y2)
  +                            (make-point x2 y2))))
  +              (case (slot-value sb  'event-state)
  +                (:up-armed
  +                 (draw-polygon sb pg :ink *3d-inner-color*)
  +                 (draw-bordered-polygon sb pg :style :inset :border-width 2))
  +                (otherwise
  +                 (draw-polygon sb pg :ink *3d-normal-color*)
  +                 (draw-bordered-polygon sb pg :style :outset :border-width 2) ))))
  +
  +          ;; draw down arrow
  +          (with-bounding-rectangle* (x1 y1 x2 y2) (scroll-bar-down-region sb)
  +            (let ((pg (list (make-point (/ (+ x1 x2) 2) y2)
  +                            (make-point x1 y1)
  +                            (make-point x2 y1))))
  +              (case (slot-value sb 'event-state)
  +                (:dn-armed
  +                 (draw-polygon sb pg :ink *3d-inner-color*)
  +                 (draw-bordered-polygon sb pg :style :inset :border-width 2))
  +                (otherwise
  +                 (draw-polygon sb pg :ink *3d-normal-color*)
  +                 (draw-bordered-polygon sb pg :style :outset :border-width 2)))))
  +
  +          ;; draw thumb
  +          (with-bounding-rectangle* (x1 y1 x2 y2) (scroll-bar-thumb-region sb)
  +            (draw-rectangle* sb x1 y1 x2 y2 :ink *3d-normal-color*)
  +            (draw-bordered-polygon sb
  +                                   (polygon-points (make-rectangle* x1 y1 x2 y2))
  +                                   :style :outset
  +                                   :border-width 2)
  +            (let ((y (/ (+ y1 y2) 2)))
  +              (draw-bordered-polygon sb
  +                                     (polygon-points (make-rectangle* (+ x1 3) (- y 1) (- x2 3) (+ y 1)))
  +                                     :style :inset
  +                                     :border-width 1)
  +              (draw-bordered-polygon sb
  +                                     (polygon-points (make-rectangle* (+ x1 3) (- y 4) (- x2 3) (- y 2)))
  +                                     :style :inset
  +                                     :border-width 1)
  +              (draw-bordered-polygon sb
  +                                     (polygon-points (make-rectangle* (+ x1 3) (+ y 4) (- x2 3) (+ y 2)))
  +                                     :style :inset
  +                                     :border-width 1))) )))))
   
   ;;
   ;; SLIDER gadget
  
positive.code: 	  (draw-label pane (gadget-label pane) (round w 2) (round h 2)))))))
  
  
  ;;
  ;; SCROLL-BAR gadget
  ;;
  
  (defgeneric drag-callback (pane client gadget-id value))
  (defgeneric scroll-to-top-callback (scroll-bar client gadget-id))
  
negative.code: 			      :height *scrollbar-thickness*
  			      :min-width (* 3 *scrollbar-thickness*)
  			      :width (* 4 *scrollbar-thickness*))))
  ;;; Utilities
  
  ;; We think all scroll bars as vertically oriented, therefore we have
  ;; SCROLL-BAR-TRANSFORMATION, which should make every scroll bar
  ;; look like being vertically oriented -- simplifies much code.
  
  (defmethod scroll-bar-transformation ((sb scroll-bar))
    (ecase (gadget-orientation sb)
      (:vertical   +identity-transformation+)
      (:horizontal (make-transformation 0 1 1 0 0 0))))
  
  (defun translate-range-value (a mina maxa mino maxo)
    "When \arg{a} is some value in the range from \arg{mina} to \arg{maxa},
     proportionally translate the value into the range \arg{mino} to \arg{maxo}."
    (+ mino (* (/ (- a mina) (- maxa mina)) (- maxo mino))))
  
  ;;; Scroll-bar's sub-regions
  
  (defmethod scroll-bar-up-region ((sb scroll-bar-pane))
    (with-bounding-rectangle* (minx miny maxx maxy) (transform-region (scroll-bar-transformation sb)
                                                                      (pane-inner-region sb))
      (declare (ignore maxy))
      (make-rectangle* minx miny
                       maxx (+ miny (- maxx minx)))))
  
  (defmethod scroll-bar-down-region ((sb scroll-bar-pane))
    (with-bounding-rectangle* (minx miny maxx maxy) (transform-region (scroll-bar-transformation sb)
                                                                      (pane-inner-region sb))
      (declare (ignore miny))
      (make-rectangle* minx (- maxy (- maxx minx))
                       maxx maxy)))
  
  (defmethod scroll-bar-thumb-bed-region ((sb scroll-bar-pane))
    (with-bounding-rectangle* (minx miny maxx maxy) (transform-region (scroll-bar-transformation sb)
                                                                      (pane-inner-region sb))
      (make-rectangle* minx (+ miny (- maxx minx) 1)
                       maxx (- maxy (- maxx minx) 1))))
  
  (defmethod scroll-bar-thumb-region ((sb scroll-bar-pane))
    (with-bounding-rectangle* (x1 y1 x2 y2) (scroll-bar-thumb-bed-region sb)
      (multiple-value-bind (minv maxv) (gadget-range* sb)
        (multiple-value-bind (v) (gadget-value sb)
          (let ((ts (* 1/3 (- maxv minv))))
            (let ((ya (translate-range-value v minv (+ maxv ts) y1 y2))
                  (yb (translate-range-value (+ v ts) minv (+ maxv ts) y1 y2)))
              (make-rectangle* x1 ya x2 yb)))))))
  
  #||
  ;; alternative:
  
  (defmethod scroll-bar-up-region ((sb scroll-bar-pane))
    (with-bounding-rectangle* (minx miny maxx maxy) (transform-region (scroll-bar-transformation sb)
                                                                      (sheet-region sb))
      (make-rectangle* (+ minx 2) (- (- maxy (* 2 (- maxx minx))) 2)
                       (- maxx 2) (- (- maxy (- maxx minx)) 2))))
  
  (defmethod scroll-bar-down-region ((sb scroll-bar-pane))
    (with-bounding-rectangle* (minx miny maxx maxy) (transform-region (scroll-bar-transformation sb)
                                                                      (sheet-region sb))
      (make-rectangle* (+ minx 2) (+ (- maxy (- maxx minx)) 2)
                       (- maxx 2) (-  maxy 2))))
  
  (defmethod scroll-bar-thumb-bed-region ((sb scroll-bar-pane))
    (with-bounding-rectangle* (minx miny maxx maxy) (transform-region (scroll-bar-transformation sb)
                                                                      (sheet-region sb))
      (make-rectangle* (+ minx 2) (+ miny 2 )
                       (- maxx 2) (- maxy 2 (* 2 (- maxx minx)) 2))))
  
  (defmethod scroll-bar-thumb-region ((sb scroll-bar-pane))
    (with-bounding-rectangle* (x1 y1 x2 y2) (scroll-bar-thumb-bed-region sb)
      (multiple-value-bind (minv maxv) (gadget-range* sb)
        (multiple-value-bind (v) (gadget-value sb)
          (let ((ts (* 1/3 (- maxv minv))))
            (let ((ya (translate-range-value v minv (+ maxv ts) y1 y2))
                  (yb (translate-range-value (+ v ts) minv (+ maxv ts) y1 y2)))
              (make-rectangle* x1 ya x2 yb)))))))
  ||#
  
  
  ;;; Event handlers
  
  (defmethod handle-event ((sb scroll-bar-pane) (event window-repaint-event))
    (dispatch-repaint sb (sheet-region sb)))
  
  #||
  (defmethod handle-event ((sb scroll-bar-pane) (event pointer-enter-event))
    (declare (ignorable event))
    (with-slots (armed) sb
  