dra

(in-package :clim-demo)

(define-application-frame dragndrop ()
  ()
  (:pointer-documentation t)
  (:panes
   (interactor :interactor)
   (scratchpad :application :display-time nil :height 600 :scroll-bars nil)
   (scratchpad2 :application :display-time nil :height 600 :scroll-bars nil))
  (:layouts
    (default
      (vertically ()
        scratchpad
        scratchpad2
	interactor))))

(defclass shape ()
  ((x :accessor x :initarg :x)
   (y :accessor y :initarg :y)))

(defclass circle (shape)
  ((radius :accessor radius :initarg :radius))
  (:default-initargs :radius 50))

(define-dragndrop-command (com-add-circle)
    ((x real :prompt "x")
     (y real :prompt "y")
     (radius real :prompt "radius"))
  (with-output-as-presentation
      (t (make-instance 'circle :x x :y y :radius radius) 'circle)
    (draw-circle* *standard-output* x y radius )))

(define-dragndrop-command (com-quit-dragndrop :name "Quit")
    ()
  (frame-exit *application-frame*))

(define-presentation-to-command-translator translator-draw-circle
    (blank-area com-add-circle dragndrop
                :documentation "Add a circle")
    (object x y)
  (list x y 50))

(define-dragndrop-command (com-clone-circle)
    ((original circle)
     (start-x real)
     (start-y real))
  ;; Track the pointer offset from the center of the original object
  (let ((x-offset (- (x original) start-x))
	(y-offset (- (y original) start-y)))
    (multiple-value-bind (final-x final-y)
	(dragging-output (t :finish-on-release t)
	  (draw-circle* *standard-output* (x original) (y original)
			(radius original)
			:filled nil ))
      (com-add-circle (+ final-x x-offset)
		      (+ final-y y-offset)
		      (radius original)))))

(define-presentation-to-command-translator translator-clone-circle
    (circle com-clone-circle dragndrop)
    (object x y)
  `(,object ,x ,y))

(defun drag-circles ()
  (run-frame-top-level (make-application-frame 'dragndrop)))

there is a bug with a pointer position which revelas itself randomly (I haven't narrowed it yet). that said, check out the following example (C-s for XXX) on how to limit dnd to arbitrary window. dnd between windows is not supported yet.

basically, you always used standard-output, which is bound to the first application-pane created in the application-frame (in your case scratchpad).

(in-package :clim-user)

(define-application-frame dragndrop ()
  ()
  (:pointer-documentation t)
  (:panes
   (interactor :interactor)
   (scratchpad :application :display-time nil :height 800 :width 800 :scroll-bars nil)
   (scratchpad2 :application :display-time nil :height 800 :width 800 :scroll-bars nil)
   )
  (:layouts
    (default
        (vertically ()
          (labelling (:label "scratchpad (*standard-output*)") scratchpad)
          (labelling (:label "scratchpad2") scratchpad2)
          interactor))))

;;; XXX: where dnd should be performed
(defparameter *dnd-pane-name* 'scratchpad2)

(defclass shape ()
  ((x :accessor x :initarg :x)
   (y :accessor y :initarg :y)))

(defclass circle (shape)
  ((radius :accessor radius :initarg :radius))
  (:default-initargs :radius 50))

(define-dragndrop-command (com-add-circle)
    ((x real :prompt "x")
     (y real :prompt "y")
     (radius real :prompt "radius"))
  ;; XXX
  (let ((*standard-output* (find-pane-named *application-frame* *dnd-pane-name*)))
    (with-output-as-presentation
        (*standard-output* (make-instance 'circle :x x :y y :radius radius) 'circle)
      (draw-circle* *standard-output* x y radius ))))

(define-dragndrop-command (com-quit-dragndrop :name "Quit")
    ()
  (frame-exit *application-frame*))

;;; XXX
(defun pane-tester (obj &rest args &key window &allow-other-keys)
  (declare (ignore obj args))
  (eql window (find-pane-named *application-frame* *dnd-pane-name*)))

(define-presentation-to-command-translator translator-draw-circle
    (blank-area com-add-circle dragndrop :documentation "Add a circle"
                ;; XXX
                :tester pane-tester
                ;; doesn't work - most likely a bug
                ;:tester #'(lambda (obj &key &allow-other-keys) t)
                )
    (object x y)
  (list x y 50))

(define-dragndrop-command (com-clone-circle)
    ((original circle)
     (start-x real)
     (start-y real))
  ;; Track the pointer offset from the center of the original object
  (let (;; XXX
        (*standard-output* (find-pane-named *application-frame* *dnd-pane-name*))
        (x-offset (- (x original) start-x))
	(y-offset (- (y original) start-y)))
    (multiple-value-bind (final-x final-y)
	(dragging-output (*standard-output*
                          :finish-on-release t)
	  (draw-circle* *standard-output*
                        (x original) (y original)
			(radius original)
			:filled nil ))
      (com-add-circle (+ final-x x-offset)
		      (+ final-y y-offset)
		      (radius original)))))

(define-presentation-to-command-translator translator-clone-circle
    (circle com-clone-circle dragndrop)
    (object x y)
  `(,object ,x ,y))

(defun drag-circles ()
  (run-frame-top-level (make-application-frame 'dragndrop)))