home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / interfaces / alt-mouse.el next >
Encoding:
Text File  |  1991-03-30  |  10.2 KB  |  298 lines
  1. ; Path: utkcs2!emory!swrinde!zaphod.mps.ohio-state.edu!tut.cis.ohio-state.edu!ELF.TN.CORNELL.EDU!eirik
  2. ; >From: eirik@ELF.TN.CORNELL.EDU (Eirik Fuller)
  3. ; Newsgroups: gnu.emacs
  4. ; Subject: mouse support
  5. ; Date: 24 Jul 90 03:01:04 GMT
  6. ; Organization: GNUs Not Usenet
  7. ; 
  8. ; The enclosed lisp code provides an alternative to the X11 mouse
  9. ; support provided with GNU emacs.  Comments are welcome.  A companion
  10. ; posting will provide an example of how to use it without X11.
  11. ; 
  12. ; 
  13. ; This mouse support distinguishes clicks and drags.  A click is a pair
  14. ; of button events (down then up) at the same location, while a drag has
  15. ; two different locations.  A "click location" is simply the coordinates
  16. ; of a matched event pair, while a "drag region" is the text between the
  17. ; two locations in an event pair.  A distinction is also made between
  18. ; events that land on mode lines and those that don't.
  19. ; 
  20. ; It is possible to use this mouse support outside of the X environment.
  21. ; For example, the Tektronix 4404 terminal emulator has escape sequences
  22. ; which, with the right elisp file, provide all of the necessary
  23. ; functionality for this mouse support.  For such terminals, replace
  24. ; "the X cut buffer" in what follows with "an emacs lisp variable known
  25. ; only within one emacs process".
  26. ; 
  27. ; Here is a summary of the various bindings:
  28. ; 
  29. ; left click:    move point to the click location
  30. ; middle click:    paste the X cut buffer at the click location
  31. ; right click:    copy the text between point and the click location
  32. ;         into the X cut buffer
  33. ; 
  34. ; left drag:    copy the drag region to the X cut buffer
  35. ; middle drag:    paste the drag region at point
  36. ; right drag:    cut the drag region to the X cut buffer
  37. ; 
  38. ; left & middle mode line drag:    move the mode line
  39. ; right mode line drag:        scroll the indicated window
  40. ; 
  41. ; left mode line click:        select the indicated window
  42. ; middle mode line click:    scroll the indicated window
  43. ; right mode line click:    scroll the indicated window
  44. ; 
  45. ; There are three bindings which scroll the indicated window, each in
  46. ; its own way.  The right mode line drag can scroll in either direction,
  47. ; depending on whether the initial or final point is on a mode line.
  48. ; The middle mode line click treats the mode line as a coordinate axis,
  49. ; with zero at the midpoint and the window height (+/-) at each end.
  50. ; The coordinate tells how far to scroll.  The right mode line click
  51. ; treats the mode line as a coordinate axis from zero to (point-max).
  52. ; The coordinate tells what part of the buffer to scroll to.
  53. ; 
  54. ; It is possible to operate on drag regions larger than a window, if
  55. ; each end of such a region is in its own window (window in the emacs
  56. ; sense, not the X11 sense).  Drags which cross buffer boundaries do
  57. ; nothing; this provides a way to cancel a drag.
  58. ; 
  59. ; These comments are all of the documentation for this mouse support.
  60. ; Feel free to write more; if you do, please send it (or code
  61. ; improvements, bug reports, or suggestions) to eirik@elf.tn.cornell.edu
  62. ; 
  63.  
  64. (provide 'x-mouse)
  65. (provide 'mouse)
  66.  
  67. (fillarray mouse-map 'ignore)
  68.  
  69. (mapcar (function (lambda (s)
  70.             (define-key mouse-map s 'mouse-button-down)))
  71.     '("\000" "\001" "\002"))
  72. (define-key mouse-map "\004" 'mouse-right-up)
  73. (define-key mouse-map "\005" 'mouse-middle-up)
  74. (define-key mouse-map "\006" 'mouse-left-up)
  75.  
  76. (defvar mouse-point nil
  77.   "The mouse location during a down event.  Used by code for up events.")
  78. (defvar mouse-window nil
  79.   "The window corresponding to mouse-point.")
  80. (defvar mouse-modeline nil
  81.   "The window above the modeline pointed at by mouse-point")
  82. (defvar mouse-cut-buffer ""
  83.   "A local substitute for the X cut buffer, for terminals with mice")
  84.  
  85. (defun mouse-get-cut-buffer () 
  86.   (if (eq window-system 'x) (x-get-cut-buffer) mouse-cut-buffer))
  87.  
  88. (defun mouse-store-cut-buffer (string)
  89.   (if (eq window-system 'x) (x-store-cut-buffer string)
  90.     (setq mouse-cut-buffer string)))
  91.  
  92. (global-set-key "\C-x\C-@"
  93.         (function (lambda () 
  94.                 "Process all queued mouse events."
  95.                 (interactive)
  96.                 (while (> (x-mouse-events) 0)
  97.                   (x-proc-mouse-event)))))
  98.  
  99. (defun window-from-x-y (point)
  100.   "The window containing screen coordinates POINT."
  101.   (if (> (nth 1 point)
  102.      (- (1- (screen-height)) (window-height (minibuffer-window))))
  103.       (if (zerop (minibuffer-depth)) nil (minibuffer-window))
  104.     (let* ((start (selected-window)) (w start) (which nil))
  105.       (while (not (or (if (coordinates-in-window-p point w) (setq which w))
  106.               (eq (setq w (next-window w)) start))))
  107.       which)))
  108.  
  109. (defun mouse-button-down (point)
  110.   "Save away the window containing screen coordinates POINT"
  111.   (setq mouse-window (window-from-x-y point))
  112.   (setq mouse-point point)
  113.   (setq mouse-modeline
  114.     (if mouse-window nil
  115.         (window-from-x-y
  116.          (list (car point) (1- (nth 1 point)))))))
  117.  
  118. (defun window-below (window)
  119.   (let ((w (next-window window t)) (which nil))
  120.     (while (and (<= (nth 3 (window-edges w))
  121.             (nth 3 (window-edges window)))
  122.         (if (eq (setq w (next-window w t)) window)
  123.             (setq w nil) t)))
  124.     w))
  125.  
  126. (defun window-min-height ()
  127.   "The value of window-min-height, except for the minibuffer."
  128.   (if (eq (selected-window) (minibuffer-window)) 1 window-min-height))
  129.  
  130. (defun move-bottom (w x)
  131.   "Move the mode line beneath window W by X lines"
  132.     (let ((now (selected-window))
  133.       (below (window-below w)))
  134.       (select-window below)
  135.       (let ((y (max
  136.         (min x (- (window-height w) window-min-height))
  137.         (- (window-min-height) (window-height below)))))
  138.     (if (eq below (minibuffer-window))
  139.         (enlarge-window y)
  140.       (progn
  141.         (select-window w)
  142.         (shrink-window y))))
  143.       (select-window now)))
  144.  
  145. (defun move-side (window delta)
  146.   "Adjust vertical boundary"
  147.   (let ((w (selected-window)))
  148.     (select-window window)
  149.     (enlarge-window (if (> delta 0) delta (- 0 delta)) t)
  150.     (select-window w)))
  151.  
  152. (defun drag-modeline (point)
  153.   "If a button down found a mode line, move it on button up; else return nil"
  154.   (if mouse-modeline
  155.       (let ((y (- (nth 1 mouse-point) (nth 1 point)))
  156.         (up (list (car point) (1- (nth 1 point)))))
  157.     (if (zerop y)
  158.         (if (coordinates-in-window-p up mouse-modeline)
  159.         (select-window mouse-modeline)
  160.           (move-side mouse-modeline (- (car mouse-point) (car point))))
  161.       (move-bottom mouse-modeline y))
  162.     (setq mouse-modeline nil)
  163.     t)))
  164.  
  165. (defun move-to-x-y (point)
  166.   "Move to screen coordinates given by POINT; return resulting location"
  167.   (if point
  168.       (let ((rel (coordinates-in-window-p point (selected-window))))
  169.     (if rel (progn
  170.           (move-to-window-line (nth 1 rel))
  171.           (move-to-column (+ (car rel) (current-column)
  172.                      (max 0 (1- (window-hscroll)))))))))
  173.   (point))
  174.  
  175. (defun mouse-same-buffer-p (point)
  176.   "Use this to discard irrelevent button up events"
  177.   (let ((w (window-from-x-y point)))
  178.     (and mouse-window w
  179.      (eq (window-buffer mouse-window)
  180.          (window-buffer w)))))
  181.  
  182. (defun mouse-region (point)
  183.   "The string surrounded by two mouse events; nil if not within one buffer"
  184.   (if (mouse-same-buffer-p point)
  185.       (let ((region "") (w (selected-window)))
  186.     (select-window mouse-window)
  187.     (setq region (buffer-substring
  188.               (save-excursion
  189.             (move-to-x-y mouse-point))
  190.               (progn
  191.             (select-window (window-from-x-y point))
  192.             (save-excursion
  193.               (move-to-x-y point)))))
  194.     (select-window w)
  195.     region)))
  196.  
  197. (defun mouse-scroll-to (point abs)
  198.   "Treat the mode line as a sideways scroll bar"
  199.   (let ((w (selected-window))
  200.     (edges (window-edges mouse-modeline)))
  201.     (select-window mouse-modeline)
  202.       (unwind-protect
  203.       (if abs
  204.           (let ((x (- (nth 2 edges) (car edges))))
  205.         (goto-char (/ (* 
  206.                    (- (car point) (car edges))
  207.                    (point-max)) x))
  208.         (recenter (/ (window-height) 2)))
  209.         (let ((x (/ (+ (car edges) (nth 2 edges)) 2)))
  210.           (scroll-up (/ (* (- (car point) x)
  211.                    (window-height))
  212.                 (- x (car edges))))))
  213.     (select-window w))))
  214.  
  215. (defun mouse-insert-cut-buffer (point)
  216.   "Insert the mouse cut buffer where the mouse is pointing"
  217.   (let ((w (selected-window)))
  218.     (select-window (window-from-x-y point))
  219.     (save-excursion
  220.       (move-to-x-y point)
  221.       (insert (mouse-get-cut-buffer)))
  222.     (select-window w)))
  223.  
  224. (defun mouse-extend-selection (point)
  225.   "If in buffer of selected window, set mouse cut buffer"
  226.   (let ((w (selected-window)))
  227.     (and w mouse-window (eq (window-buffer mouse-window) (window-buffer w))
  228.      (mouse-store-cut-buffer
  229.       (let ((string
  230.          (buffer-substring
  231.           (point)
  232.           (progn (select-window mouse-window)
  233.              (save-excursion (move-to-x-y point))))))
  234.         (select-window w)
  235.         string)))))
  236.  
  237. (defun mouse-kill-region (point)
  238.   "Store region bounded by mouse events in cut buffer and delete it"
  239.   (if (mouse-same-buffer-p point)
  240.       (let ((w (selected-window)) beg end)
  241.     (select-window mouse-window)
  242.     (save-excursion
  243.       (setq beg (move-to-x-y mouse-point)))
  244.     (select-window (window-from-x-y point))
  245.     (save-excursion
  246.       (setq end (move-to-x-y point)))
  247.     (mouse-store-cut-buffer (buffer-substring beg end))
  248.     (delete-region beg end)
  249.     (select-window w)
  250.     t)))
  251.  
  252. (defun mouse-left-up (point)
  253.   "Copy dragged text to cut buffer, or position cursor, or drag mode line"
  254.   (or (drag-modeline point)
  255.       (let ((region (mouse-region point)))
  256.     (and region
  257.          (if (zerop (length region))
  258.          (progn (select-window mouse-window)
  259.             (move-to-x-y point))
  260.            (mouse-store-cut-buffer region))))))
  261.  
  262. (defun mouse-middle-up (point)
  263.   "Insert dragged text, or cut buffer, or drag mode line"
  264.   (if mouse-modeline
  265.       (if (equal point mouse-point)
  266.       (mouse-scroll-to point nil)
  267.     (drag-modeline point))
  268.     (let ((region (mouse-region point)))
  269.       (and region
  270.        (if (zerop (length region))
  271.            (mouse-insert-cut-buffer point)
  272.          (insert region))))))
  273.  
  274. (defun mouse-scroll-window (point window delta)
  275.   (and (eq window (window-from-x-y point))
  276.        (let ((w (selected-window)))
  277.      (select-window window)
  278.      (unwind-protect
  279.          (scroll-up delta))
  280.      (select-window w))))
  281.  
  282. (defun mouse-right-up (point)
  283.   "Extend the selection if no drag, or delete what's dragged"
  284.   (let ((delta (- (nth 1 mouse-point) (nth 1 point))))
  285.     (if mouse-modeline
  286.     (if (zerop delta)
  287.         (mouse-scroll-to point t)
  288.       (mouse-scroll-window point mouse-modeline delta))
  289.       (if mouse-window
  290.       (if (equal point mouse-point)
  291.           (mouse-extend-selection point)
  292.         (or (mouse-kill-region point)
  293.         (window-from-x-y point)
  294.         (mouse-scroll-window (list (car point) (1- (nth 1 point)))
  295.                    mouse-window delta)))))))
  296.  
  297.  
  298.