The Pier Shareware 6/The_Pier_Shareware_Number_6_(The_Pier_Exchange)_(1995).iso/033/atcp40de.zip/MG-MOUSE.EL

Lisp/Scheme | 1994-06-10 | 9KB | 277 lines

;;;
;;; This Emacs lisp mode can be used with Napsaterm 3
;;;                            //ppessi
;;;
;;; mg-mouse.el
;;; Mic Kaczmarczik ([e-mail])
;;; 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)