home *** CD-ROM | disk | FTP | other *** search
/ Education Sampler 1992 [NeXTSTEP] / Education_1992_Sampler.iso / NeXT / GnuSource / emacs-15.0.3 / lisp / x-mouse.el < prev    next >
Lisp/Scheme  |  1990-07-19  |  11KB  |  280 lines
  1. ;; Mouse support for X window system.
  2. ;; Copyright (C) 1985, 1987 Free Software Foundation, Inc.
  3.  
  4. ;; This file is part of GNU Emacs.
  5.  
  6. ;; GNU Emacs is distributed in the hope that it will be useful,
  7. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  8. ;; accepts responsibility to anyone for the consequences of using it
  9. ;; or for whether it serves any particular purpose or works at all,
  10. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  11. ;; License for full details.
  12.  
  13. ;; Everyone is granted permission to copy, modify and redistribute
  14. ;; GNU Emacs, but only under the conditions described in the
  15. ;; GNU Emacs General Public License.   A copy of this license is
  16. ;; supposed to have been given to you along with GNU Emacs so you
  17. ;; can know your rights and responsibilities.  It should be in a
  18. ;; file named COPYING.  Among other things, the copyright notice
  19. ;; and this notice must be preserved on all copies.
  20.  
  21.  
  22. (provide 'x-mouse)
  23.  
  24. (defconst x-button-right (char-to-string 0))
  25. (defconst x-button-middle (char-to-string 1))
  26. (defconst x-button-left (char-to-string 2))
  27.  
  28. (defconst x-button-right-up (char-to-string 4))
  29. (defconst x-button-middle-up (char-to-string 5))
  30. (defconst x-button-left-up (char-to-string 6))
  31.  
  32. (defconst x-button-s-right (char-to-string 16))
  33. (defconst x-button-s-middle (char-to-string 17))
  34. (defconst x-button-s-left (char-to-string 18))
  35.  
  36. (defconst x-button-s-right-up (char-to-string 20))
  37. (defconst x-button-s-middle-up (char-to-string 21))
  38. (defconst x-button-s-left-up (char-to-string 22))
  39.  
  40. (defconst x-button-m-right (char-to-string 32))
  41. (defconst x-button-m-middle (char-to-string 33))
  42. (defconst x-button-m-left (char-to-string 34))
  43.  
  44. (defconst x-button-m-right-up (char-to-string 36))
  45. (defconst x-button-m-middle-up (char-to-string 37))
  46. (defconst x-button-m-left-up (char-to-string 38))
  47.  
  48. (defconst x-button-c-right (char-to-string 64))
  49. (defconst x-button-c-middle (char-to-string 65))
  50. (defconst x-button-c-left (char-to-string 66))
  51.  
  52. (defconst x-button-c-right-up (char-to-string 68))
  53. (defconst x-button-c-middle-up (char-to-string 69))
  54. (defconst x-button-c-left-up (char-to-string 70))
  55.  
  56. (defconst x-button-m-s-right (char-to-string 48))
  57. (defconst x-button-m-s-middle (char-to-string 49))
  58. (defconst x-button-m-s-left (char-to-string 50))
  59.  
  60. (defconst x-button-m-s-right-up (char-to-string 52))
  61. (defconst x-button-m-s-middle-up (char-to-string 53))
  62. (defconst x-button-m-s-left-up (char-to-string 54))
  63.  
  64. (defconst x-button-c-s-right (char-to-string 80))
  65. (defconst x-button-c-s-middle (char-to-string 81))
  66. (defconst x-button-c-s-left (char-to-string 82))
  67.  
  68. (defconst x-button-c-s-right-up (char-to-string 84))
  69. (defconst x-button-c-s-middle-up (char-to-string 85))
  70. (defconst x-button-c-s-left-up (char-to-string 86))
  71.  
  72. (defconst x-button-c-m-right (char-to-string 96))
  73. (defconst x-button-c-m-middle (char-to-string 97))
  74. (defconst x-button-c-m-left (char-to-string 98))
  75.  
  76. (defconst x-button-c-m-right-up (char-to-string 100))
  77. (defconst x-button-c-m-middle-up (char-to-string 101))
  78. (defconst x-button-c-m-left-up (char-to-string 102))
  79.  
  80. (defconst x-button-c-m-s-right (char-to-string 112))
  81. (defconst x-button-c-m-s-middle (char-to-string 113))
  82. (defconst x-button-c-m-s-left (char-to-string 114))
  83.  
  84. (defconst x-button-c-m-s-right-up (char-to-string 116))
  85. (defconst x-button-c-m-s-middle-up (char-to-string 117))
  86. (defconst x-button-c-m-s-left-up (char-to-string 118))
  87.  
  88. (defvar x-process-mouse-hook nil
  89.   "Hook to run after each mouse event is processed.  Should take two
  90. arguments; the first being a list (XPOS YPOS) corresponding to character
  91. offset from top left of screen and the second being a specifier for the
  92. buttons/keys.
  93.  
  94. This will normally be set on a per-buffer basis.")
  95.  
  96. (defun x-flush-mouse-queue () 
  97.   "Process all queued mouse events."
  98.   ;; A mouse event causes a special character sequence to be given
  99.   ;; as keyboard input.  That runs this function, which process all
  100.   ;; queued mouse events and returns.
  101.   (interactive)
  102.   (while (> (x-mouse-events) 0)
  103.     (x-proc-mouse-event)
  104.     (and (boundp 'x-process-mouse-hook)
  105.      (symbol-value 'x-process-mouse-hook)
  106.      (funcall x-process-mouse-hook x-mouse-pos x-mouse-item))))
  107.  
  108. (define-key global-map "\C-c\C-m" 'x-flush-mouse-queue)
  109. (define-key global-map "\C-x\C-@" 'x-flush-mouse-queue)
  110.  
  111. (defun x-mouse-select (arg)
  112.   "Select Emacs window the mouse is on."
  113.   (let ((start-w (selected-window))
  114.     (done nil)
  115.     (w (selected-window))
  116.     (rel-coordinate nil))
  117.     (while (and (not done)
  118.         (null (setq rel-coordinate
  119.                 (coordinates-in-window-p arg w))))
  120.       (setq w (next-window w))
  121.       (if (eq w start-w)
  122.       (setq done t)))
  123.     (select-window w)
  124.     rel-coordinate))
  125.  
  126. (defun x-mouse-keep-one-window (arg)
  127.   "Select Emacs window mouse is on, then kill all other Emacs windows."
  128.   (if (x-mouse-select arg)
  129.       (delete-other-windows)))
  130.  
  131. (defun x-mouse-select-and-split (arg)
  132.   "Select Emacs window mouse is on, then split it vertically in half."
  133.   (if (x-mouse-select arg)
  134.       (split-window-vertically nil)))
  135.  
  136. (defun x-mouse-set-point (arg)
  137.   "Select Emacs window mouse is on, and move point to mouse position."
  138.   (let* ((relative-coordinate (x-mouse-select arg))
  139.      (rel-x (car relative-coordinate))
  140.      (rel-y (car (cdr relative-coordinate))))
  141.     (if relative-coordinate
  142.     (progn
  143.       (move-to-window-line rel-y)
  144.       (move-to-column (+ rel-x (current-column)))))))
  145.  
  146. (defun x-mouse-set-mark (arg)
  147.   "Select Emacs window mouse is on, and set mark at mouse position.
  148. Display cursor at that position for a second."
  149.   (if (x-mouse-select arg)
  150.       (let ((point-save (point)))
  151.     (unwind-protect
  152.         (progn (x-mouse-set-point arg)
  153.            (push-mark nil t)
  154.            (sit-for 1))
  155.       (goto-char point-save)))))
  156.  
  157. (defun x-cut-text (arg &optional kill)
  158.   "Copy text between point and mouse position into window system cut buffer.
  159. Save in Emacs kill ring also."
  160.   (if (coordinates-in-window-p arg (selected-window))
  161.       (save-excursion
  162.     (let ((opoint (point))
  163.           beg end)
  164.       (x-mouse-set-point arg)
  165.       (setq beg (min opoint (point))
  166.         end (max opoint (point)))
  167.       (x-store-cut-buffer (buffer-substring beg end))
  168.       (copy-region-as-kill beg end)
  169.       (if kill (delete-region beg end))))
  170.     (message "Mouse not in selected window")))
  171.  
  172. (defun x-paste-text (arg)
  173.   "Move point to mouse position and insert window system cut buffer contents."
  174.   (x-mouse-set-point arg)
  175.   (insert (x-get-cut-buffer)))
  176.  
  177. (defun x-cut-and-wipe-text (arg)
  178.   "Kill text between point and mouse; also copy to window system cut buffer."
  179.   (x-cut-text arg t))
  180.  
  181. (defun x-mouse-ignore (arg)
  182.   "Don't do anything.")
  183.  
  184. (defun x-buffer-menu (arg)
  185.   "Pop up a menu of buffers for selection with the mouse."
  186.   (let ((menu
  187.      (list "Buffer Menu"
  188.            (cons "Select Buffer"
  189.              (let ((tail (buffer-list))
  190.                head)
  191.                (while tail
  192.              (let ((elt (car tail)))
  193.                (if (not (string-match "^ "
  194.                           (buffer-name elt)))
  195.                    (setq head (cons
  196.                        (cons
  197.                         (format
  198.                          "%14s   %s"
  199.                          (buffer-name elt)
  200.                          (or (buffer-file-name elt) ""))
  201.                         elt)
  202.                        head))))
  203.              (setq tail (cdr tail)))
  204.                (reverse head))))))
  205.     (switch-to-buffer (or (x-popup-menu arg menu) (current-buffer)))))
  206.  
  207. (defun x-help (arg)
  208.   "Enter a menu-based help system."
  209.   (let ((selection
  210.      (x-popup-menu
  211.       arg
  212.       '("Help" ("Is there a command that..."
  213.             ("Command apropos" . command-apropos)
  214.             ("Apropos" . apropos))
  215.            ("Key Commands <==> Functions"
  216.             ("List all keystroke commands" . describe-bindings)
  217.             ("Describe key briefly" . describe-key-briefly)
  218.             ("Describe key verbose" . describe-key)
  219.             ("Describe Lisp function" . describe-function)
  220.             ("Where is this command" . where-is))
  221.            ("Manual and tutorial"
  222.             ("Info system" . info)
  223.             ("Invoke Emacs tutorial" . help-with-tutorial))
  224.            ("Odds and ends"
  225.             ("Last 100 Keystrokes" . view-lossage)
  226.             ("Describe syntax table" . describe-syntax))
  227.            ("Modes"
  228.             ("Describe current major mode" . describe-mode)
  229.             ("List all keystroke commands" . describe-bindings))
  230.            ("Administrivia"
  231.             ("View Emacs news" . view-emacs-news)
  232.             ("View the GNU Emacs license" . describe-copying)
  233.             ("Describe distribution" . describe-distribution)
  234.             ("Describe (non)warranty" . describe-no-warranty))))))
  235.     (and selection (call-interactively selection))))
  236.  
  237. ; Prevent beeps on button-up.  If the button isn't bound to anything, it
  238. ; will beep on button-down.
  239. (define-key mouse-map x-button-right-up 'x-mouse-ignore)
  240. (define-key mouse-map x-button-middle-up 'x-mouse-ignore)
  241. (define-key mouse-map x-button-left-up 'x-mouse-ignore)
  242. (define-key mouse-map x-button-s-right-up 'x-mouse-ignore)
  243. (define-key mouse-map x-button-s-middle-up 'x-mouse-ignore)
  244. (define-key mouse-map x-button-s-left-up 'x-mouse-ignore)
  245. (define-key mouse-map x-button-m-right-up 'x-mouse-ignore)
  246. (define-key mouse-map x-button-m-middle-up 'x-mouse-ignore)
  247. (define-key mouse-map x-button-m-left-up 'x-mouse-ignore)
  248. (define-key mouse-map x-button-c-right-up 'x-mouse-ignore)
  249. (define-key mouse-map x-button-c-middle-up 'x-mouse-ignore)
  250. (define-key mouse-map x-button-c-left-up 'x-mouse-ignore)
  251. (define-key mouse-map x-button-m-s-right-up 'x-mouse-ignore)
  252. (define-key mouse-map x-button-m-s-middle-up 'x-mouse-ignore)
  253. (define-key mouse-map x-button-m-s-left-up 'x-mouse-ignore)
  254. (define-key mouse-map x-button-c-s-right-up 'x-mouse-ignore)
  255. (define-key mouse-map x-button-c-s-middle-up 'x-mouse-ignore)
  256. (define-key mouse-map x-button-c-s-left-up 'x-mouse-ignore)
  257. (define-key mouse-map x-button-c-m-right-up 'x-mouse-ignore)
  258. (define-key mouse-map x-button-c-m-middle-up 'x-mouse-ignore)
  259. (define-key mouse-map x-button-c-m-left-up 'x-mouse-ignore)
  260. (define-key mouse-map x-button-c-m-s-right-up 'x-mouse-ignore)
  261. (define-key mouse-map x-button-c-m-s-middle-up 'x-mouse-ignore)
  262. (define-key mouse-map x-button-c-m-s-left-up 'x-mouse-ignore)
  263.  
  264. (define-key mouse-map x-button-c-s-left 'x-buffer-menu)
  265. (define-key mouse-map x-button-c-s-middle 'x-help)
  266. (define-key mouse-map x-button-c-s-right 'x-mouse-keep-one-window)
  267. (define-key mouse-map x-button-s-middle 'x-cut-text)
  268. (define-key mouse-map x-button-s-right 'x-paste-text)
  269. (define-key mouse-map x-button-c-middle 'x-cut-and-wipe-text)
  270. (define-key mouse-map x-button-c-right 'x-mouse-select-and-split)
  271.  
  272. (if (= window-system-version 10)
  273.     (progn
  274.       (define-key mouse-map x-button-right 'x-mouse-select)
  275.       (define-key mouse-map x-button-left 'x-mouse-set-mark)
  276.       (define-key mouse-map x-button-middle 'x-mouse-set-point))
  277.   (define-key mouse-map x-button-right 'x-cut-text)
  278.   (define-key mouse-map x-button-left 'x-mouse-set-point)
  279.   (define-key mouse-map x-button-middle 'x-paste-text))
  280.