anchor.diff:    (handle-event pane event))
   )
   
  +(defun draw-figure (pane x y x1 y1 &key fastp)
  +  (with-slots (line-style current-color fill-mode constrict-mode)
  +      *application-frame*
  +    (let* ((radius-x (- x1 x))
  +           (radius-y (- y1 y))
  +           (line-style (if fastp (medium-line-style pane) line-style))
  +           (fill-mode (if fastp nil fill-mode)))
  +      (when constrict-mode
  +        (case (clim-fig-drawing-mode *application-frame*)
  +          ((:line :arrow)
  +           (if (> (abs radius-x) (abs radius-y))
  +               (setf y1 y)
  +               (setf x1 x)))
  +          ((:rectangle :ellipse)
  +           (let ((radius-max (max (abs radius-x) (abs radius-y))))
  +             (setf radius-x (* (signum-1 radius-x) radius-max)
  +                   radius-y (* (signum-1 radius-y) radius-max)
  +                   x1 (+ x radius-x)
  +                   y1 (+ y radius-y))))))
  +      (case (clim-fig-drawing-mode *application-frame*)
  +        (:line
  +         (draw-line* pane x y x1 y1
  +                     :ink current-color
  +                     :line-style line-style))
  +        (:arrow
  +         (with-new-output-record (pane)
  +           (draw-arrow* pane x y x1 y1
  +                        :ink current-color
  +                        :line-style line-style
  +                        :to-head t :head-width 20 :head-length 20)))
  +        (:rectangle
  +         (draw-rectangle* pane x y x1 y1 :filled fill-mode
  +                          :ink current-color
  +                          :line-style line-style))
  +        (:ellipse
  +         (draw-ellipse* pane x y radius-x 0 0 radius-y
  +                        :filled fill-mode
  +                        :ink current-color :line-style line-style))))))
  +
   (defmethod handle-event ((pane canvas-pane) (event pointer-button-press-event))
     (when (= (pointer-event-button event) +pointer-left-button+)
  -    (with-slots (first-point-x first-point-y canvas-pixmap) pane
  -      (let ((pixmap-width (round (bounding-rectangle-width (sheet-region pane))))
  -	    (pixmap-height (round (bounding-rectangle-height (sheet-region pane)))))
  -	(setq first-point-x (pointer-event-x event))
  -	(setq first-point-y (pointer-event-y event))
  -	(with-slots (clim-demo::line-style clim-demo::current-color clim-demo::drawing-mode) *application-frame*
  -	  (case clim-demo::drawing-mode
  -	    (:point
  -	     (draw-point* pane first-point-x first-point-y
  -			  :ink clim-demo::current-color
  -                          :line-style clim-demo::line-style))))
  -	(setf canvas-pixmap (allocate-pixmap pane pixmap-width pixmap-height))
  -        (copy-to-pixmap pane 0 0 pixmap-width pixmap-height canvas-pixmap))))
  +    (handle-draw-object pane event))
     (when (= (pointer-event-button event) +pointer-right-button+)
       (with-slots (first-point-x first-point-y selected-object) pane
         (setq first-point-x (pointer-event-x event)
               first-point-y (pointer-event-y event))
  -      (setf selected-object (search-selected-object (climi::pane-output-history pane)
  +      (setf selected-object (search-selected-object (stream-output-history pane)
                                                       first-point-x
                                                       first-point-y)))))
   
  
positive.code:               first-point-x nil
                first-point-y nil)))))
  
  (in-package :clim-demo)
  
  (defun clim-fig ()
    (loop for port in climi::*all-ports*
        do (destroy-port port))
    (setq climi::*all-ports* nil)
   ;(run-frame-top-level (make-application-frame 'clim-fig))
    (setq frame (make-application-frame 'clim-fig))
    (setq fm (frame-manager frame))
    (setq port (climi::frame-manager-port fm))
    (setq pane (first (frame-panes frame)))
    (setq medium (sheet-medium pane))
    (setq graft (graft frame))
    (setq vbox (climi::frame-pane frame))
    (run-frame-top-level frame))
  
  (defun make-colored-button (color &key width height)
    (make-pane 'push-button-pane
  
negative.code:          (scrolling (:width 600 :height 400) canvas))
         (horizontally (:height 30) clear undo redo)
         status)))
  ;  #+nil
     (:top-level (clim-fig-frame-top-level)))
  
  (defmethod clim-fig-frame-top-level ((frame application-frame) &key)
  