--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/shared/motion.el	Mon Feb 08 11:44:37 2021 +0000
@@ -0,0 +1,319 @@
+;;; Copyright (C) 1990  Alan M. Carroll
+;;;
+;;; This file is for use with Epoch, a modified version of GNU Emacs.
+;;; Requires Epoch 3.2 or later.
+;;;
+;;; This code is distributed in the hope that it will be useful,
+;;; bute WITHOUT ANY WARRANTY. No author or distributor accepts
+;;; responsibility to anyone for the consequences of using this code
+;;; or for whether it serves any particular purpose or works at all,
+;;; unless explicitly stated in a written agreement.
+;;;
+;;; Everyone is granted permission to copy, modify and redistribute
+;;; this code, but only under the conditions described in the
+;;; GNU Emacs General Public License, except the original author nor his
+;;; agents are bound by the License in their use of this code.
+;;; (These special rights for the author in no way restrict the rights of
+;;;  others given in the License or this prologue)
+;;; A copy of this license is supposed to have been given to you along
+;;; with Epoch so you can know your rights and responsibilities. 
+;;; It should be in a file named COPYING.  Among other things, the
+;;; copyright notice and this notice must be preserved on all copies. 
+;;;
+(provide 'motion)
+(require 'button)
+(require 'mouse)
+;;;
+;;; version tohandle mouse stuff
+;;;
+;;; [cjl] now use primitive epoch::move-button when possible.
+;;;
+(defvar horizontal-drag-inc 5 "Number of columns to scroll when the pointer is to the left or right of the window")
+(defvar vertical-drag-inc 2 "Number of lines to scroll when the pointer is above or below the edge of the window")
+
+(defvar mouse::downp nil "State variable for mouse dragging internals")
+(defvar mouse::last-point -1 "Last location of a motion event")
+
+(make-variable-buffer-local 'drag-button)
+(make-variable-buffer-local 'mouse-down-marker)
+
+(defvar motion::attribute (reserve-attribute) "Attribute for drag buttons")
+(setq epoch::buttons-modify-buffer nil)
+
+(defvar motion::style nil "style used by drag buttons")
+
+;;
+;; Set window-setup-hook to call motion::init(), which sets default
+;; style for button dragging
+;;
+(epoch-add-setup-hook 'motion::init)
+(defun motion::init ()
+  (and (not motion::style) (setq motion::style (make-style)))
+  (set-style-foreground motion::style (foreground))
+  (set-style-background motion::style (background))
+  (set-style-underline motion::style (foreground))
+  (set-attribute-style motion::attribute motion::style)
+  ;; enable the handler
+  (push-event 'motion 'motion::handler)
+  ;; set up hints on all the current screens
+  (dolist (s (screen-list t)) (epoch::set-motion-hints t s))
+  ;; enable hints on future screens
+  (push '(motion-hints t) epoch::screen-properties)
+  )
+
+(setq-default drag-button nil)
+(setq-default mouse-down-marker nil)
+
+;;; ------------------------------------------------------------------------
+(defun set-mouse-marker (&optional location)
+  (if (null mouse-down-marker)
+    (setq mouse-down-marker (make-marker))
+  )
+  (set-marker mouse-down-marker (or location (point)))
+)
+;;; --------------------------------------------------------------------------
+;;; generic arg is a list of ( POINT BUFFER WINDOW SCREEN )
+;;;
+(defun end-mouse-drag (arg)
+  (setq mouse::last-point -1)		;always do this cleanup
+  (when mouse::downp
+    (setq mouse::downp nil)
+    (mouse::copy-button drag-button)
+    (if (buttonp drag-button)
+      (if (<= (point) (button-start drag-button))
+	(progn
+	  (push-mark (button-end drag-button) t)
+	  (goto-char (button-start drag-button))
+	)
+	;; ELSE point is past drag button start
+	(progn
+	  (push-mark (button-start drag-button) t)
+	  (goto-char (button-end drag-button))
+	)
+      )
+    )
+  )
+)
+
+(defun start-mouse-drag (arg)
+  (when arg
+    (setq mouse::downp 'start)
+    (mouse::set-point arg)
+    (set-mouse-marker)
+    (setq mouse::last-point (point))
+    (if drag-button
+      (progn (delete-button drag-button) (setq drag-button nil) )
+    )
+  )
+)
+
+(defun extend-mouse-drag (arg)
+  (setq mouse::downp 'extend)
+  (let
+    (
+      (m1 (and drag-button (button-start drag-button)))
+      (m2 (and drag-button (button-end drag-button)))
+      (spot (car arg))			;point of the mouse click.
+    )
+    (if (null m1) (setq m1 0))
+    (if (null m2) (setq m2 0))
+    (cond
+      ((or (null drag-button) (null mouse-down-marker))
+	(setq drag-button (add-button (point) spot motion::attribute) )
+	(set-mouse-marker)
+      )
+      ((<= spot m1)
+	(setq drag-button (move-button drag-button spot m2) )
+	(set-mouse-marker m2)
+      )
+      ((>= spot m2)
+	(setq drag-button (move-button drag-button m1 spot) )
+	(set-mouse-marker m1)
+      )
+      ((<= mouse-down-marker spot)
+	(setq drag-button (move-button drag-button m1 spot) )
+	(set-mouse-marker m1)
+      )
+      (t
+	(setq drag-button (move-button drag-button spot m2) )
+	(set-mouse-marker m2)
+      )
+    )
+    (epoch::redisplay-screen)
+    (setq mouse::last-point (point))
+  )
+)
+
+;;; ------------------------------------------------------------------------
+;;; Define the handler
+;;;
+(defun motion::handler (type value scr)
+  (if (null mouse-down-marker) (set-mouse-marker))
+  (if (and (boundp 'mouse::downp) mouse::downp)
+    (mouse-sweep-update)
+  )
+)
+;;;
+(defun mouse-sweep-update()
+  (let*
+    (x y pos drag-m1 drag-m2 pnt orig-m1 orig-m2
+      (out-of-bounds t)
+      (epoch::event-handler-abort nil)
+      (w (selected-window))
+      (w-edges (window-edges w))
+      (left (car w-edges))
+      (top (elt w-edges 1))
+      (right (- (elt w-edges 2) (+ 2 left)))
+      (bottom (- (elt w-edges 3) (+ 2 top)))
+      ever
+    )
+    (if drag-button
+	(progn (setq orig-m1 (or (button-start drag-button) -1))
+	       (setq orig-m2 (or (button-end drag-button) -1)))
+      (progn (setq orig-m1 mouse-down-marker)
+	     (setq orig-m2 (point))))
+    (while
+      (and
+	out-of-bounds
+	(setq pos (query-mouse))
+	(/= 0 (logand mouse-any-mask (elt pos 2)))
+      )
+      ;;convert to window relative co-ordinates
+      (setq x (- (car pos) left))
+      (setq y (- (elt pos 1) top))
+      (setq out-of-bounds
+	(not (and (<= 0 y) (<= y bottom) (<= 0 x) (<= x right)))
+      )
+
+      ;; scrolling conditions
+      (condition-case errno
+	(progn
+	  (if (< y 0) (scroll-down vertical-drag-inc))
+	  (if (> y bottom) (scroll-up vertical-drag-inc))
+	)
+	(error )			;nothing, just catch it
+      )
+      (if (< x 0) (scroll-right horizontal-drag-inc))
+      (if (> x right) (scroll-left horizontal-drag-inc))
+      (setq y (max 0 (min bottom y)))
+      (setq x (max 0 (min right x)))
+
+      (setq pnt (car (epoch::coords-to-point (+ x left) (+ y top))))
+      (when (/= mouse::last-point pnt)
+	    (if (> mouse-down-marker pnt)
+		(progn
+		  (setq drag-m1 pnt)
+		  (setq drag-m2 (marker-position mouse-down-marker))
+		  )
+	      (progn
+		(setq drag-m1 (marker-position mouse-down-marker))
+		(setq drag-m2 pnt)
+		)
+	      )
+	    ;; don't move for trivial reasons
+	    (when (or ever (/= drag-m1 orig-m1) (/= drag-m2 orig-m2))
+		  (setq ever t)
+		  (if (not drag-button)
+		      (setq drag-button
+			    (add-button mouse-down-marker
+					(point) motion::attribute )
+			    )
+		    )
+		  (move-button drag-button drag-m1 drag-m2)
+		  (epoch::redisplay-screen)
+		  )
+	    )
+      (setq mouse::last-point pnt)
+    )
+  )
+)
+;;; ------------------------------------------------------------------------
+;;; Code for selecting lines using motion events. Assumes that the line is
+;;; left unmarked on button up
+;;;
+(defvar mouse::line-button nil "Button for selected line")
+;;;
+(defun mouse-select-line-start (arg)
+  (mouse::set-point arg)		;go there
+  (setq mouse::last-point (point))
+  (let ( bol )
+    (save-excursion
+      (beginning-of-line)
+      (setq bol (point))
+      (end-of-line)
+      (setq mouse::line-button (add-button bol (point) motion::attribute))
+    )
+  )
+  (push-event 'motion 'mouse-select-line-update)
+)
+;;;
+(defun mouse-select-line-end (arg)
+  (setq mouse::last-point -1)
+  (when mouse::line-button (delete-button mouse::line-button))
+  (pop-event 'motion)
+)
+;;;
+(defun mouse-select-line-update (type value scr)
+  (let*
+    (
+      y
+      pos
+      bol
+      (out-of-bounds t)
+      (epoch::event-handler-abort nil)
+      (w-edges (window-edges (selected-window)))
+      (top (elt w-edges 1))
+      (bottom (- (elt w-edges 3) (+ 2 top)))
+      max-vscroll
+    )
+    (while
+      (and
+	out-of-bounds
+	(setq pos (query-mouse))
+	(/= 0 (logand mouse-any-mask (elt pos 2)))
+      )
+      ;;convert to window relative co-ordinates
+      (setq y (- (elt pos 1) top))
+      (setq out-of-bounds (not (and (<= 0 y) (<= y bottom))))
+
+      ;; Scrolling hard, because of possibly shrink-wrapped windows.
+      ;; set max-vscroll to be the most we could scroll down and not have
+      ;; empty lines at the bottom
+      (save-excursion
+	(move-to-window-line bottom)	;go to the last line in the window
+	(setq max-vscroll
+	  (- vertical-drag-inc (forward-line vertical-drag-inc))
+	)
+	(if (and (> max-vscroll 0) (eobp) (= 0 (current-column)))
+	  (decf max-vscroll)
+	)
+      )
+      (condition-case errno
+	(progn
+	  (if (< y 0) (scroll-down vertical-drag-inc))
+	  (if (> y bottom) (scroll-up (min max-vscroll vertical-drag-inc)))
+	)
+	;; CONDITIONS
+	(error)				;nothing, just want to catch it
+      )
+      (setq y (max 0 (min bottom y)))
+
+      ;;move to the new point
+      (move-to-window-line y)
+      (beginning-of-line) (setq bol (point))
+      (end-of-line)
+      (when (/= mouse::last-point (point))
+	(move-button mouse::line-button bol (point))
+	(epoch::redisplay-screen)
+      )
+      (setq mouse::last-point (point))
+    )
+  )
+)
+;;; --------------------------------------------------------------------------
+;;; install all our variouse handlers
+(global-set-mouse mouse-left mouse-down 'start-mouse-drag)
+(global-set-mouse mouse-left mouse-up 'end-mouse-drag)
+(global-set-mouse mouse-right mouse-down 'extend-mouse-drag)
+(global-set-mouse mouse-right mouse-up 'end-mouse-drag)
+(global-set-mouse mouse-middle mouse-down 'mouse::paste-cut-buffer)