home *** CD-ROM | disk | FTP | other *** search
/ The Fred Fish Collection 1.5 / ffcollection-1-5-1992-11.iso / ff_disks / 300-399 / ff330.lzh / Vt100 / GNU-Emacs / amiga.el
Lisp/Scheme  |  1990-03-02  |  9KB  |  273 lines
  1. ;;;
  2. ;;; mg-mouse.el
  3. ;;; Mic Kaczmarczik (mic@emx.cc.utexas.edu)
  4. ;;; 07-Sep-1987
  5. ;;;
  6. ;;; Modifications:
  7. ;;;    11-Sep-1987 MPK        Remember last mouse click in order to set
  8. ;;;                the mark if you click twice on same spot.
  9. ;;;                Implement mg-mouse-set-mark-and-kill to be
  10. ;;;                more intuitive (thanks, Mike)
  11. ;;;
  12. ;;;    20-Sep-1987 MPK        Put gadgets in left hand side of mode line
  13. ;;;    19-Jun-1989 MWM        Take gadgets out of mode line
  14. ;;;
  15. ;;; Makes Emacs respond to mouse click input, based on Mike Meyer's hack
  16. ;;; to VT100 2.6 and x-mouse.el.  Things work like the hot mouse in mg
  17. ;;; (formerly known as MicroGNUEmacs) -- you get different results,
  18. ;;; depending on whether you click on the text in a window, a mode line,
  19. ;;; or the minibuffer down at the bottom of the screen.  See the
  20. ;;; documentation string for mg-mouse-command for the default bindings.
  21. ;;;
  22. ;;; This code doesn't need the GNU X-windows code to work, which Mike's
  23. ;;; original amiga-mouse code did.  Thanks to Mike for the inspiration
  24. ;;; and his documentation (which I have shamelessly quoted from in places).
  25. ;;;
  26. ;;; I'm looking for an easier way for users to rebind what happens when
  27. ;;; they click in a particular area.  Right now you have to manually
  28. ;;; change an a-list, but there's *got* to be a better way.  Oh well, at
  29. ;;; least it works :-)
  30. ;;;
  31. ;;; VT100 mouse hack format:
  32. ;;; 
  33. ;;;    <ESC> M (yes, a real capital M) quals column line
  34. ;;;
  35. ;;; column and line are bytes that just hold the column/line number,
  36. ;;; zero-based and offset by 32. quals is like so:
  37. ;;;
  38. ;;;    bit 0    control key
  39. ;;;    bit 1    shift key
  40. ;;;    bit 2    meta (alt) key
  41. ;;;    bit 3    caps lock
  42. ;;;    bit 4    mouse down event
  43. ;;;    bit 5    mouse up event
  44. ;;;
  45. ;;; Quals is offset by 64, so a shifted downward mouse click on row 1,
  46. ;;; column 1 results in the escape sequence
  47. ;;;    <ESC> M R <SPC> <SPC>
  48. ;;;
  49.  
  50. ;;; 
  51. ;;; Qualifier bit definitions
  52. ;;;
  53.  
  54. (defconst mg-mouse-vanilla 0)
  55. (defconst mg-mouse-ctrl 1)
  56. (defconst mg-mouse-shift 2)
  57. (defconst mg-mouse-ctrl-shift 3)
  58. (defconst mg-mouse-alt 4)
  59. (defconst mg-mouse-ctrl-alt 5)
  60. (defconst mg-mouse-shift-alt 6)
  61. (defconst mg-mouse-ctrl-shift-alt 7)
  62. (defconst mg-mouse-qual-mask 15)
  63.  
  64. (defconst mg-mouse-capslock 8)
  65. (defconst mg-mouse-select-down 16)
  66. (defconst mg-mouse-select-up 32)
  67.  
  68. ;;;
  69. ;;; Actions to take when the mouse is clicked.  When you click in
  70. ;;; the window, mg-mouse-command moves point to where you clicked,
  71. ;;; then calls the action routine as an interactive command.  You can
  72. ;;; rebind these functions by prepending items to the a-list. (Is
  73. ;;; there a better way to do this?)
  74. ;;;
  75.  
  76. (defvar mg-mouse-previous-click nil
  77.   "(x, y) position of next-to-last mouse click")
  78.  
  79. (defvar mg-mouse-click nil
  80.   "(x, y) position of last mouse click")
  81.  
  82. (defvar mg-mouse-last-point nil
  83.   "Position of point just before mg-mouse-set-point moved it.")
  84.  
  85. ;;;
  86. ;;; Things to do...
  87. ;;;
  88.  
  89. (defvar mg-mouse-window-actions nil
  90.    "A-list of functions to call when the mouse is clicked in an Emacs window.")
  91.  
  92. (setq mg-mouse-window-actions
  93.       (list
  94.        (cons mg-mouse-vanilla        'mg-mouse-maybe-set-mark)
  95.        (cons mg-mouse-shift        'top-and-redisplay)
  96.        (cons mg-mouse-ctrl        'delete-char)
  97.        (cons mg-mouse-ctrl-shift    'delete-horizontal-space)
  98.        (cons mg-mouse-alt        'kill-word)
  99.        (cons mg-mouse-shift-alt        'kill-line)
  100.        (cons mg-mouse-ctrl-alt        'mg-mouse-set-mark-and-kill)
  101.        (cons mg-mouse-ctrl-shift-alt    'yank)))
  102.  
  103. ;;;
  104. ;;; Things to do when you click on the mode line of a window.  The
  105. ;;; window is selected, then the function is called interactively.
  106. ;;;
  107.  
  108. (defvar mg-mouse-mode-actions nil
  109.    "A-list of functions to call when the mouse is clicked in a mode line.")
  110.  
  111. (setq mg-mouse-mode-actions
  112.       (list
  113.        (cons mg-mouse-vanilla        'mg-mouse-vanilla-mode-line)
  114.        (cons mg-mouse-shift        'mg-mouse-shift-mode-line)
  115.        (cons mg-mouse-ctrl        'beginning-of-buffer)
  116.        (cons mg-mouse-ctrl-shift    'end-of-buffer)
  117.        (cons mg-mouse-alt        'split-window)
  118.        (cons mg-mouse-shift-alt        'delete-window)
  119.        (cons mg-mouse-ctrl-alt        'enlarge-window)
  120.        (cons mg-mouse-ctrl-shift-alt    'shrink-window)))
  121.  
  122. ;;;
  123. ;;; Things to do when you click in the echo line.
  124. ;;;
  125.  
  126. (defvar mg-mouse-echo-actions nil
  127.    "A-list of functions to call when the mouse is clicked in the minibuffer")
  128.  
  129. (setq mg-mouse-echo-actions
  130.       (list
  131.        (cons mg-mouse-vanilla        'save-buffer)
  132.        (cons mg-mouse-shift        'kill-buffer)
  133.        (cons mg-mouse-ctrl        'suspend-emacs)
  134.        (cons mg-mouse-ctrl-shift    'save-buffers-kill-emacs)
  135.        (cons mg-mouse-alt        'describe-key)
  136.        (cons mg-mouse-shift-alt        'describe-bindings)
  137.        (cons mg-mouse-ctrl-alt        'list-buffers)
  138.        (cons mg-mouse-ctrl-shift-alt    'buffer-menu)))
  139.  
  140. ;;;
  141. ;;; Handle the user's mouse click.  We only pay attention to when
  142. ;;; the mouse button is pressed, not when it is released.
  143. ;;;
  144.  
  145. (defun mg-mouse-command ()
  146. "Interpret Amiga mouse clicks from the VT100 program.  The bindings are:
  147.  
  148.  Qualifiers  |            Area clicked
  149.              |
  150. C  A  Shift  |    Text window        Mode line    Echo line
  151. -------------+---------------------------------------------------------
  152.          |    dot to mouse        forward page    switch to buffer 
  153.       X         |    recenter        back page    kill buffer
  154.    X         |    delete word        split window    describe key
  155.    X  X         |    kill line        delete window    describe bindings
  156. X         |    delete char        goto bob    suspend emacs
  157. X     X      |    delete whitespace    goto eob    save buffers kill emacs
  158. X  X         |    kill region        enlarge window    list buffers
  159. X  X  X         |    yank            shrink window    buffer menu
  160.  
  161. Notice that the Status and Echo groups come in pairs; the shifted
  162. version of a key is in some sense the opposite of the unshifted version.
  163.  
  164. There is no opposite for display buffers, so that key is bound to
  165. buffer-menu (it's bound to an Amiga-specific function in Amiga mg).
  166. "
  167.   (interactive)
  168.   (let* ((qual (- (read-char) 64))        ;; read the qualifier,
  169.      (x (- (read-char) 32))            ;; x & y sequentially
  170.      (y (- (read-char ) 32))
  171.      (click nil)
  172.      (actions nil)
  173.      (action-routine nil))
  174.  
  175.     (if (not (zerop (logand qual mg-mouse-select-down)))
  176.     (progn
  177.       (setq click (mg-mouse-select-and-examine (list x y)))
  178.       (setq qual (logand qual mg-mouse-qual-mask))
  179.  
  180.       ;; get a-list of action routines based on where the click was
  181.       (if (not click)
  182.           (setq actions mg-mouse-echo-actions)    ;; no window
  183.         (if (eq (car click) 'mode-line)
  184.         (setq actions mg-mouse-mode-actions)    ;; mode line
  185.           (progn
  186.         (mg-mouse-set-point (cdr click))    ;; in text area
  187.         (setq actions mg-mouse-window-actions))))
  188.  
  189.       (setq mg-mouse-previous-click mg-mouse-click)
  190.       (setq mg-mouse-click (cdr click))
  191.  
  192.       ;; function to call? do it.
  193.       (if (setq action-routine (cdr (assoc qual actions)))
  194.           (call-interactively action-routine))))))
  195.       
  196. (defun mg-mouse-set-point (arg)
  197.   "Select Emacs window mouse is on, and move point to mouse position."
  198.   (let* ((rel-x (car arg))
  199.      (rel-y (car (cdr arg))))
  200.  
  201.     (setq mg-mouse-last-point (point))
  202.     (move-to-window-line rel-y)
  203.     (move-to-column (+ rel-x (current-column)))))
  204.  
  205. (defun mg-mouse-select-and-examine (arg)
  206.   "Select Emacs window the mouse is on, returning a triplet signifying
  207.    information about where exactly the click took place."
  208.   (let ((start-w (selected-window))
  209.     (done nil)
  210.     (where nil)
  211.     (w (selected-window))
  212.     (mouse-click-data nil))
  213.     (while (and (not done)
  214.         (null (setq mouse-click-data
  215.                 (mg-coordinates-in-window-p arg w))))
  216.       (setq w (next-window w))
  217.       (if (eq w start-w)
  218.       (setq done t)))
  219.     (select-window w)
  220.     mouse-click-data))
  221.  
  222. (defun mg-coordinates-in-window-p (pos w)
  223.   "Checks coordinate pair POS to see if it falls within window W.
  224. If the pair is inside the window, returns a list in the format
  225. (WHERE REL-X REL-Y), where WHERE is either 'mode-line or
  226. 'inside-window, and REL-X and REL-Y denote the click's coordinates
  227. relative to the window's origin."
  228.  
  229.   (let* ((edges (window-edges w))
  230.      (wl (nth 0 edges)) (wt (nth 1 edges))
  231.      (wr (nth 2 edges)) (wb (nth 3 edges))
  232.      (x (nth 0 pos))    (y (nth 1 pos)))
  233.     (if (and (and (>= x wl) (< x wr))
  234.          (and (>= y wt) (< y wb)))
  235.     (list (if (= y (1- wb))
  236.           'mode-line 'inside)
  237.           (- x wl) (- y wt))
  238.       nil)))
  239.  
  240. ;;;
  241. ;;; Command functions for special things.  These are commands so we can
  242. ;;; use call-interactively uniformly.
  243. ;;;
  244.  
  245. (defun mg-mouse-vanilla-mode-line nil
  246.   "Do a vanilla mode line click: scroll up one page"
  247.   (interactive)
  248.   (scroll-up))
  249.  
  250. (defun mg-mouse-shift-mode-line nil
  251.   "Do a shifted mode line click: scroll down one page"
  252.   (interactive)
  253.   (scroll-down))
  254.  
  255. (defun mg-mouse-maybe-set-mark nil
  256.   "Set point if the current and previous clicks in a window were in the
  257. same spot.  This is somewhat naive but usually sufficient :-)."
  258.   (interactive)
  259.   (if (equal mg-mouse-previous-click mg-mouse-click)
  260.       (call-interactively 'set-mark-command)))
  261.  
  262. (defun mg-mouse-set-mark-and-kill nil
  263.   "Set mark at old point, set point at where you clicked, then kill the region"
  264.   (interactive)
  265.   (set-mark mg-mouse-last-point)
  266.   (kill-region mg-mouse-last-point (point)))
  267.  
  268. ;;;
  269. ;;; Set up to react to the mouse "key"
  270. ;;;
  271.  
  272. (global-set-key "\eM" 'mg-mouse-command)
  273.