;;; att-mouse.el
;;; GNU Emacs Lisp code for AT&T UNIXpc (PC7300/3B1) mouse support
;;;
;;; Brant A. Cheikes
;;; University of Pennsylvania
;;; Department of Computer and Information Science
;;; ARPA: brant@manta.pha.pa.us, brant@linc.cis.upenn.edu
;;; UUCP: bpa!manta!brant
;;;
;;; Last Edit: 13 Feb 1990.
;;;
;;; Based on BBN Bitgraph mouse support code (bg-mouse.el) by
;;;  John Robinson (jr@bbn-unix.arpa, bbncca!jr), Oct 1985
;;;
;;; This code requires the following primitive UNIXpc mouse support
;;; routines defined in src/dispnew.c:
;;;
;;; (window-pixel-sizes) ==> returns list of values of uwdata structure.
;;; (select-mouse-reports <um_flags>) ==> activate mouse reports
;;; Documentation for mouse functions is in window(7).
;;;
;;; These routines will be compiled if the symbol UNIXPC_MOUSE is defined
;;; to the C preprocessor.
;;;
;;; Notes:
;;;  1. This code recognizes multi-button mouse click sequences!
;;;  2. kill-emacs in src/emacs.c has been modified so that emacs
;;;     will turn off mouse reporting if necessary before exiting.
;;;  3. This code sets hooks so that suspending emacs temporarily
;;;     stops mouse reporting.
;;;
;;; Usage:
;;;  1. Cause this file to be loaded, e.g., (load "att-mouse")
;;;  2. Eval (activate-att-mouse t).  Mouse handling is now active.
;;;     Eval (activate-att-mouse nil) to turn off the mouse handler.
;;;
;;; MOUSE OPERATIONS PROVIDED
;;;
;;; Within the currently active window:
;;;
;;; L-- move point
;;; --R set mark
;;; -C- move point and yank
;;; -CR kill-region
;;; L-R copy-region-as-kill
;;;
;;; On a window's modeline:
;;;
;;; L-- scroll-up
;;; --R scroll-down
;;; -C- proportional goto-char
;;;
;;; In the minibuffer (the area below the bottom-most modeline):
;;;
;;; L-- execute-extended-command
;;; --R evaluate-expression
;;; -C- suspend-emacs
;;;
;;; In the "Scroll Bar" (the rightmost screen column)
;;;
;;; L-- this line to top
;;; --R this line to bottom
;;; -C- this line to middle
;;;
;;; If the global variable att-mouse-fast-select-window is nil, any mouse
;;; click sequence on a deselected window just selects that window.

(defvar att-mouse-fast-select-window nil
  "If non-nil, mouse clicks on a deselected window just select that window.")

(defvar att-mouse-buttons-down nil
  "Stores code representing which mouse buttons went down during the current
sequence of mouse clicks.")

(defvar att-mouse-click-start-position nil
  "A cons (X . Y) of pixel coordinates (relative to window) at which the
first mouse click of the current click sequence took place.")

(defun activate-att-mouse (flag)
  "If FLAG is non-nil, enable Unix PC mouse reporting and activate the
mouse handler.  If nil, deactivate mouse processing."
  (interactive)
  (if flag
      ;; enable mouse handling
      (progn
	(select-mouse-reports 3)	; both MSDOWN/MSUP are reported

	;; set hooks so suspend-emacs temporarily stops mouse reporting
	(setq suspend-hook '(lambda nil (select-mouse-reports 0))
	      suspend-resume-hook '(lambda nil (select-mouse-reports 3)))

	;; Put the mouse report handler into the global keymap
	(let ((esc-map (lookup-key global-map "\e[")))
	  (if (not (keymapp esc-map))
	      (setq esc-map (make-sparse-keymap)))  ; <ESC>[ map
	  (define-key esc-map "?" 'att-mouse-report)
	  (global-set-key "\e[" esc-map)))

    ;; disable mouse handling
    (progn
      (select-mouse-reports 0)		; turn them off
      (setq suspend-hook nil		; remove suspend hooks
	    suspend-resume-hook nil)
      (let ((esc-map (lookup-key global-map "\e[")))
	(if (keymapp esc-map)
	    (define-key esc-map "?" nil))))))

(defun att-mouse-report ()
  "Read and parse AT&T Unix PC mouse report.
If the report is MSUP and all buttons are up, then perform the requested
function.  This is essentially a fast 'interrupt service routine.'  Only
do serious processing if we find all mouse buttons have gone up."
  (interactive)
  (let* ((x-pos-pixel (get-att-mouse-value ?\;))
	 (y-pos-pixel (get-att-mouse-value ?\;))
	 (buttons (get-att-mouse-value ?\;))
	 (reason (get-att-mouse-value ?M)))
    (cond ((= reason 1)			; MSDOWN
	   ;;
	   ;; A mouse button went down.
	   ;; Store the code away representing which buttons are down.
	   ;; We won't act on the request until all buttons are up.  This
	   ;; is so we can distinguish multi-button mouse clicks.
	   ;;
	   (if att-mouse-buttons-down
	       (setq att-mouse-buttons-down (logior att-mouse-buttons-down
						    buttons))
	     (progn
	       ;; initialize the buttons-down value and save
	       ;; the pixel coordinates of this (initial) mouse click.
	       ;; the idea is that if the mouse moves between the time
	       ;; that the initial button goes down and the last button
	       ;; goes up, only the first mouse position is used.
	       (setq att-mouse-buttons-down buttons)
	       (setq att-mouse-click-start-position (cons x-pos-pixel
							  y-pos-pixel)))))
	  ((= reason 2)			; MSUP
	   ;;
	   ;; A mouse button went up.  If all buttons are now up, act
	   ;; on the button click stored in att-mouse-buttons-down.
	   ;;
	   (cond ((and att-mouse-buttons-down
		       (numberp buttons)
		       (zerop buttons))
		  ;; ok, all buttons are up, let's act
		  ;; unwind-protect keeps lower level errors from
		  ;; leaving the mouse status variables in a funny state
		  (unwind-protect
		      (do-att-mouse-function
			att-mouse-buttons-down
			att-mouse-click-start-position)
		    (setq att-mouse-buttons-down nil
			  att-mouse-click-start-position nil))))))))

(defun do-att-mouse-function (buttons x-y-pos)
  "Execute the mouse function indexed by BUTTONS depending upon the location
of the mouse click.  X-Y-POS should be a cons (X . Y) of the (x,y)
coordinates (in pixels) of the mouse cursor."
  (let* ((pixel-sizes (window-pixel-sizes)) ; need to determine size of chars
	 (char-pixel-width (nth 5 pixel-sizes))
	 (char-pixel-height (nth 6 pixel-sizes))
	 (x-pos-char (min (1- (screen-width))
			  (/ (car x-y-pos) char-pixel-width)))
	 (y-pos-char (/ (cdr x-y-pos) char-pixel-height))
	 (window (mouse-pos-to-window x-pos-char y-pos-char))
	 (edges (window-edges window))
	 (old-window (selected-window))
         (in-minibuf-p (= y-pos-char (1- (screen-height))))
	 (same-window-p (and (not in-minibuf-p) (eq window old-window)))
	 (in-scrollbar-p (>= x-pos-char (1- (nth 2 edges))))
	 (in-modeline-p (= y-pos-char (1- (nth 3 edges)))))
    (setq x-pos-char (- x-pos-char (nth 0 edges)))
    (setq y-pos-char (- y-pos-char (nth 1 edges)))
    (cond (in-modeline-p		; mouse clicks on a window's modeline
	    (select-window window)
	    (cond ((= buttons 4)	; L-- scroll up
		   (scroll-up))
		  ((= buttons 1)	; --R scroll down
		   (scroll-down))
		  ((= buttons 2)	; -C- proportional goto char
		   (goto-char (/ (* x-pos-char (- (point-max) (point-min)))
				 (1- (window-width))))
		   (beginning-of-line)
		   (what-cursor-position)))
	    (select-window old-window))
	  (in-scrollbar-p		; mouse clicks in the "Scroll Bar"
	   (select-window window)
	   (scroll-up
	    (cond ((= buttons 4)	; L-- this line to top
		   y-pos-char)
		 ((= buttons 1)		; --R this line to bottom
		   (+ y-pos-char (- 2 (window-height))))
		 ((= buttons 2)		; -C- this line to middle
		   (/ (+ 2 y-pos-char y-pos-char (- (window-height))) 2))
		 (t 0)))
	   (select-window old-window))
	  (same-window-p		; mouse clicks in the current window
	   (cond ((= buttons 4)		; L-- move point
		  (mouse-move-point-to-x-y x-pos-char y-pos-char))
		 ((= buttons 1)		; --R set-mark
		  (push-mark)
		  (mouse-move-point-to-x-y x-pos-char y-pos-char)
		  (exchange-point-and-mark))
		 ((= buttons 2)		; -C- move to point and yank
		  (mouse-move-point-to-x-y x-pos-char y-pos-char)
		  (setq this-command 'yank)
		  (yank))
		 ((= buttons 3)		; -CR kill region
		  ;; set mark at mouse position
		  (push-mark)
		  (mouse-move-point-to-x-y x-pos-char y-pos-char)
		  (exchange-point-and-mark)
		  ;; delete region between point and mark
		  (setq this-command 'kill-region)
		  (kill-region (point) (mark)))
		 ((= buttons 5)		; L-R copy region into kill buffer
		  ;; set mark at mouse position
		  (push-mark)
		  (mouse-move-point-to-x-y x-pos-char y-pos-char)
		  (exchange-point-and-mark)
		  ;; copy region between point and mark
		  (setq this-command 'copy-region-as-kill)
		  (copy-region-as-kill (point) (mark)))))
	  (in-minibuf-p			; mouse clicks in the minibuffer
	   (cond ((= buttons 1)		; --L eval expression
		  (call-interactively 'eval-expression))
		 ((= buttons 4)		; R-- execute extended command
		  (call-interactively 'execute-extended-command))
		 ((= buttons 2)		; -C- suspend emacs
		  (suspend-emacs))))
	  (t				; mouse clicks in another window
	    (select-window window)
	    (cond ((not att-mouse-fast-select-window))
		  ((= buttons 4)	; L-- move point
		   (mouse-move-point-to-x-y x-pos-char y-pos-char))
		  ((= buttons 1)	; --R set mark
		   (push-mark)
		   (mouse-move-point-to-x-y x-pos-char y-pos-char)
		   (exchange-point-and-mark))
		  ((= buttons 2)	; -C- move point and yank
		   (mouse-move-point-to-x-y x-pos-char y-pos-char)
		   (setq this-command 'yank)
		   (yank)))))))

(defun get-att-mouse-value (term-char)
  "Read from terminal until TERM-CHAR is read, and return intervening number.
Upon non-numeric not matching TERM-CHAR, signal an error."
  (let ((num 0)
	(char (- (read-char) 48)))
    (while (and (>= char 0) (<= char 9))
      (setq num (+ (* num 10) char))
      (setq char (- (read-char) 48)))
    (or (eq term-char (+ char 48))
	(error "Invalid data in mouse report"))
    num))

(defun mouse-move-point-to-x-y (x y)
  "Position cursor in window coordinates.
X and Y are 0-based character positions in the window."
  (move-to-window-line y)
  (move-to-column x))

(defun mouse-pos-to-window (x y)
  "Return window corresponding to given screen coordinates.
X and Y are 0-based character positions on the screen."
  (let ((edges (window-edges))
	(window nil))
    (while (and (not (eq window (selected-window)))
		(or (<  y (nth 1 edges))
		    (>= y (nth 3 edges))
		    (<  x (nth 0 edges))
		    (>= x (nth 2 edges))))
      (setq window (next-window window))
      (setq edges (window-edges window)))
    (or window (selected-window))))