From e3df05b7ad1c61211655ba21148f9bd9c864d467 Mon Sep 17 00:00:00 2001
From: cer <cer>
Date: Thu, 19 Nov 1992 14:17:30 +0000
Subject: [PATCH] SWM random hacking.

---
 clim/dragging-output.lisp | 41 ++++++++++++++++++++++++++-------------
 1 file changed, 27 insertions(+), 14 deletions(-)

diff --git a/clim/dragging-output.lisp b/clim/dragging-output.lisp
index be5ba99d..9c1b0ca9 100644
--- a/clim/dragging-output.lisp
+++ b/clim/dragging-output.lisp
@@ -1,27 +1,30 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: dragging-output.lisp,v 1.8 92/08/18 17:24:50 cer Exp $
+;; $fiHeader: dragging-output.lisp,v 1.9 92/11/06 18:59:29 cer Exp $
 
 (in-package :clim-internals)
 
 "Copyright (c) 1990, 1991, 1992 Symbolics, Inc.  All rights reserved.
  Portions copyright (c) 1989, 1990 International Lisp Associates."
 
+(defparameter *dragging-output-finish-on-release* nil)
+
 ;;; Yay!
-(defmacro dragging-output ((&optional stream (repaint t) (finish-on-release nil))
+(defmacro dragging-output ((&optional stream 
+			    &key (repaint t) multiple-window
+				 (finish-on-release *dragging-output-finish-on-release*))
 			   &body body)
   (default-output-stream stream dragging-output)
   (let ((output-record '#:output-record))
     `(let ((,output-record
 	    (with-output-to-output-record (,stream) ,@body)))
        (drag-output-record ,stream ,output-record
-			   :repaint ,repaint
+			   :repaint ,repaint :multiple-window ,multiple-window
 			   :finish-on-release ,finish-on-release))))
 
-(defparameter *dragging-output-finish-on-release* nil)
-
 (defun drag-output-record (stream output-record
-			   &key (repaint t) (erase #'erase-output-record) feedback
+			   &key (repaint t) multiple-window
+				(erase #'erase-output-record) feedback
 				(finish-on-release *dragging-output-finish-on-release*))
   (declare (values final-x final-y delta-x delta-y))
   (let (last-x last-y
@@ -43,7 +46,9 @@
 	  ;; system of the record
 	  (setq delta-x (- initial-x record-x)
 		delta-y (- initial-y record-y)))
-	(flet ((finish (x y)
+	(incf initial-x x-offset)
+	(incf initial-y y-offset)
+	(flet ((finish (window x y)
 		 (when last-x
 		   (if feedback
 		       (funcall feedback output-record stream
@@ -54,7 +59,16 @@
 		   ;; because the user can be moving the pointer really fast,
 		   ;; causing FINISH to be called on coordinates which are
 		   ;; "before" the values of LAST-X/Y.
-		   (output-record-set-position output-record (- x delta-x) (- y delta-y))
+		   (unless (or multiple-window
+			       (eq window stream))
+		     ;; If the user didn't ask for multiple windows, and 
+		     ;; he moved into another window, set things back
+		     (setq x (- initial-x x-offset)
+			   y (- initial-y y-offset)
+			   delta-x 0
+			   delta-y 0))
+		   (output-record-set-position 
+		     output-record (- x delta-x) (- y delta-y))
 		   (when parent
 		     (add-output-record output-record parent)
 		     (tree-recompute-extent output-record))
@@ -68,7 +82,7 @@
 	      (funcall feedback output-record stream
 		       initial-x initial-y initial-x initial-y :draw)
 	      (setq last-x initial-x last-y initial-y))
-	    (tracking-pointer (stream)
+	    (tracking-pointer (stream :multiple-window multiple-window)
 	      (:pointer-motion (window x y)
 	       (when (eq window stream)
 		 (when (or (not (eq x last-x))
@@ -93,10 +107,9 @@
 		       (funcall feedback output-record stream
 				initial-x initial-y x y :draw)
 		       (replay-output-record output-record stream nil x-offset y-offset)))))
-	      (:pointer-button-press (x y)
+	      (:pointer-button-press (event x y)
 	       (unless finish-on-release
-		 (finish x y)))
-	      (:pointer-button-release (x y)
+		 (finish (event-sheet event) x y)))
+	      (:pointer-button-release (event x y)
 	       (when finish-on-release
-		 (finish x y))))))))))
-
+		 (finish (event-sheet event) x y))))))))))
-- 
GitLab