;;;
;;; This Emacs lisp mode can be used with Napsaterm 3 
;;;                            //ppessi
;;;
;;; mg-mouse.el
;;; Mic Kaczmarczik (mic@emx.cc.utexas.edu)
;;; 07-Sep-1987
;;;
;;; Modifications:
;;;	11-Sep-1987 MPK		Remember last mouse click in order to set
;;;				the mark if you click twice on same spot.
;;;				Implement mg-mouse-set-mark-and-kill to be
;;;				more intuitive (thanks, Mike)
;;;
;;;	20-Sep-1987 MPK		Put gadgets in left hand side of mode line
;;;	19-Jun-1989 MWM		Take gadgets out of mode line
;;;
;;; Makes Emacs respond to mouse click input, based on Mike Meyer's hack
;;; to VT100 2.6 and x-mouse.el.  Things work like the hot mouse in mg
;;; (formerly known as MicroGNUEmacs) -- you get different results,
;;; depending on whether you click on the text in a window, a mode line,
;;; or the minibuffer down at the bottom of the screen.  See the
;;; documentation string for mg-mouse-command for the default bindings.
;;;
;;; This code doesn't need the GNU X-windows code to work, which Mike's
;;; original amiga-mouse code did.  Thanks to Mike for the inspiration
;;; and his documentation (which I have shamelessly quoted from in places).
;;;
;;; I'm looking for an easier way for users to rebind what happens when
;;; they click in a particular area.  Right now you have to manually
;;; change an a-list, but there's *got* to be a better way.  Oh well, at
;;; least it works :-)
;;;
;;; VT100 mouse hack format:
;;; 
;;;	<ESC> M (yes, a real capital M) quals column line
;;;
;;; column and line are bytes that just hold the column/line number,
;;; zero-based and offset by 32. quals is like so:
;;;
;;;	bit 0	control key
;;;	bit 1	shift key
;;;	bit 2	meta (alt) key
;;;	bit 3	caps lock
;;;	bit 4	mouse down event
;;;	bit 5	mouse up event
;;;
;;; Quals is offset by 64, so a shifted downward mouse click on row 1,
;;; column 1 results in the escape sequence
;;;	<ESC> M R <SPC> <SPC>
;;;

;;; 
;;; Qualifier bit definitions
;;;

(defconst mg-mouse-vanilla 0)
(defconst mg-mouse-ctrl 1)
(defconst mg-mouse-shift 2)
(defconst mg-mouse-ctrl-shift 3)
(defconst mg-mouse-alt 4)
(defconst mg-mouse-ctrl-alt 5)
(defconst mg-mouse-shift-alt 6)
(defconst mg-mouse-ctrl-shift-alt 7)
(defconst mg-mouse-qual-mask 15)

(defconst mg-mouse-capslock 8)
(defconst mg-mouse-select-down 16)
(defconst mg-mouse-select-up 32)

;;;
;;; Actions to take when the mouse is clicked.  When you click in
;;; the window, mg-mouse-command moves point to where you clicked,
;;; then calls the action routine as an interactive command.  You can
;;; rebind these functions by prepending items to the a-list. (Is
;;; there a better way to do this?)
;;;

(defvar mg-mouse-previous-click nil
  "(x, y) position of next-to-last mouse click")

(defvar mg-mouse-click nil
  "(x, y) position of last mouse click")

(defvar mg-mouse-last-point nil
  "Position of point just before mg-mouse-set-point moved it.")

;;;
;;; Things to do...
;;;

(defvar mg-mouse-window-actions nil
   "A-list of functions to call when the mouse is clicked in an Emacs window.")

(setq mg-mouse-window-actions
      (list
       (cons mg-mouse-vanilla		'mg-mouse-maybe-set-mark)
       (cons mg-mouse-shift		'top-and-redisplay)
       (cons mg-mouse-ctrl		'delete-char)
       (cons mg-mouse-ctrl-shift	'delete-horizontal-space)
       (cons mg-mouse-alt		'kill-word)
       (cons mg-mouse-shift-alt		'kill-line)
       (cons mg-mouse-ctrl-alt		'mg-mouse-set-mark-and-kill)
       (cons mg-mouse-ctrl-shift-alt	'yank)))

;;;
;;; Things to do when you click on the mode line of a window.  The
;;; window is selected, then the function is called interactively.
;;;

(defvar mg-mouse-mode-actions nil
   "A-list of functions to call when the mouse is clicked in a mode line.")

(setq mg-mouse-mode-actions
      (list
       (cons mg-mouse-vanilla		'mg-mouse-vanilla-mode-line)
       (cons mg-mouse-shift		'mg-mouse-shift-mode-line)
       (cons mg-mouse-ctrl		'beginning-of-buffer)
       (cons mg-mouse-ctrl-shift	'end-of-buffer)
       (cons mg-mouse-alt		'split-window)
       (cons mg-mouse-shift-alt		'delete-window)
       (cons mg-mouse-ctrl-alt		'enlarge-window)
       (cons mg-mouse-ctrl-shift-alt	'shrink-window)))

;;;
;;; Things to do when you click in the echo line.
;;;

(defvar mg-mouse-echo-actions nil
   "A-list of functions to call when the mouse is clicked in the minibuffer")

(setq mg-mouse-echo-actions
      (list
       (cons mg-mouse-vanilla		'save-buffer)
       (cons mg-mouse-shift		'kill-buffer)
       (cons mg-mouse-ctrl		'suspend-emacs)
       (cons mg-mouse-ctrl-shift	'save-buffers-kill-emacs)
       (cons mg-mouse-alt		'describe-key)
       (cons mg-mouse-shift-alt		'describe-bindings)
       (cons mg-mouse-ctrl-alt		'list-buffers)
       (cons mg-mouse-ctrl-shift-alt	'buffer-menu)))

;;;
;;; Handle the user's mouse click.  We only pay attention to when
;;; the mouse button is pressed, not when it is released.
;;;

(defun mg-mouse-command ()
"Interpret Amiga mouse clicks from the VT100 program.  The bindings are:

 Qualifiers  |			Area clicked
             |
C  A  Shift  |	Text window		Mode line	Echo line
-------------+---------------------------------------------------------
	     |	dot to mouse		forward page	switch to buffer 
      X	     |	recenter		back page	kill buffer
   X	     |	delete word		split window	describe key
   X  X	     |	kill line		delete window	describe bindings
X	     |	delete char		goto bob	suspend emacs
X     X      |	delete whitespace	goto eob	save buffers kill emacs
X  X	     |	kill region		enlarge window	list buffers
X  X  X	     |	yank			shrink window	buffer menu

Notice that the Status and Echo groups come in pairs; the shifted
version of a key is in some sense the opposite of the unshifted version.

There is no opposite for display buffers, so that key is bound to
buffer-menu (it's bound to an Amiga-specific function in Amiga mg).
"
  (interactive)
  (let* ((qual (- (read-char) 64))		;; read the qualifier,
	 (x (- (read-char) 32))			;; x & y sequentially
	 (y (- (read-char ) 32))
	 (click nil)
	 (actions nil)
	 (action-routine nil))

    (if (not (zerop (logand qual mg-mouse-select-down)))
	(progn
	  (setq click (mg-mouse-select-and-examine (list x y)))
	  (setq qual (logand qual mg-mouse-qual-mask))

	  ;; get a-list of action routines based on where the click was
	  (if (not click)
	      (setq actions mg-mouse-echo-actions)	;; no window
	    (if (eq (car click) 'mode-line)
		(setq actions mg-mouse-mode-actions)	;; mode line
	      (progn
		(mg-mouse-set-point (cdr click))	;; in text area
		(setq actions mg-mouse-window-actions))))

	  (setq mg-mouse-previous-click mg-mouse-click)
	  (setq mg-mouse-click (cdr click))

	  ;; function to call? do it.
	  (if (setq action-routine (cdr (assoc qual actions)))
	      (call-interactively action-routine))))))
      
(defun mg-mouse-set-point (arg)
  "Select Emacs window mouse is on, and move point to mouse position."
  (let* ((rel-x (car arg))
	 (rel-y (car (cdr arg))))

    (setq mg-mouse-last-point (point))
    (move-to-window-line rel-y)
    (move-to-column (+ rel-x (current-column)))))

(defun mg-mouse-select-and-examine (arg)
  "Select Emacs window the mouse is on, returning a triplet signifying
   information about where exactly the click took place."
  (let ((start-w (selected-window))
	(done nil)
	(where nil)
	(w (selected-window))
	(mouse-click-data nil))
    (while (and (not done)
		(null (setq mouse-click-data
			    (mg-coordinates-in-window-p arg w))))
      (setq w (next-window w))
      (if (eq w start-w)
	  (setq done t)))
    (select-window w)
    mouse-click-data))

(defun mg-coordinates-in-window-p (pos w)
  "Checks coordinate pair POS to see if it falls within window W.
If the pair is inside the window, returns a list in the format
(WHERE REL-X REL-Y), where WHERE is either 'mode-line or
'inside-window, and REL-X and REL-Y denote the click's coordinates
relative to the window's origin."

  (let* ((edges (window-edges w))
	 (wl (nth 0 edges)) (wt (nth 1 edges))
	 (wr (nth 2 edges)) (wb (nth 3 edges))
	 (x (nth 0 pos))    (y (nth 1 pos)))
    (if (and (and (>= x wl) (< x wr))
	     (and (>= y wt) (< y wb)))
	(list (if (= y (1- wb))
		  'mode-line 'inside)
	      (- x wl) (- y wt))
      nil)))

;;;
;;; Command functions for special things.  These are commands so we can
;;; use call-interactively uniformly.
;;;

(defun mg-mouse-vanilla-mode-line nil
  "Do a vanilla mode line click: scroll up one page"
  (interactive)
  (scroll-up))

(defun mg-mouse-shift-mode-line nil
  "Do a shifted mode line click: scroll down one page"
  (interactive)
  (scroll-down))

(defun mg-mouse-maybe-set-mark nil
  "Set point if the current and previous clicks in a window were in the
same spot.  This is somewhat naive but usually sufficient :-)."
  (interactive)
  (if (equal mg-mouse-previous-click mg-mouse-click)
      (call-interactively 'set-mark-command)))

(defun mg-mouse-set-mark-and-kill nil
  "Set mark at old point, set point at where you clicked, then kill the region"
  (interactive)
  (set-mark mg-mouse-last-point)
  (kill-region mg-mouse-last-point (point)))

;;;
;;; Set up to react to the mouse "key"
;;;

(global-set-key "\eM" 'mg-mouse-command)

(provide 'mg-mouse)