home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Global Amiga Experience
/
globalamigaexperience.iso
/
comm
/
terminal_network
/
amitcp-4.0
/
extutil
/
mg-mouse.el
next >
Wrap
Lisp/Scheme
|
1995-07-10
|
9KB
|
277 lines
;;;
;;; 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)