home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / packages / MouseAndMenuEmacs / x-mouse.el < prev    next >
Encoding:
Text File  |  1990-05-31  |  28.1 KB  |  675 lines
  1. ;; Mouse support for X window system.
  2. ;; Copyright (C) 1985, 1987 Free Software Foundation, Inc.
  3.  
  4. ;;;; Russell Ritchie, Scottish HCI Centre, <russell@uk.ac.strath.hci>.
  5. ;;;; Fri Jan 13 15:13:40 1989
  6.  
  7. ;;;; Created 4 conceptual screen regions, with a separate mouse-maps
  8. ;;;; for each. Patterned after "sun-mouse.el", which purports to be
  9. ;;;; modelled after the GNU Emacs keymap interface.
  10.  
  11. ;;;; To facilitate determination of what mouse-map to use, based on 
  12. ;;;; pointer position, added function x-mouse-window, which returns the 
  13. ;;;; window the pointer is in (a modeline considered part of a window), 
  14. ;;;; setting the (new) Lisp variable x-mouse-map to be the name of the 
  15. ;;;; appropriate map as part of that process. 
  16. ;;;; Which map is "the appropriate map" is determined as follows: 
  17. ;;;;     mouse location        map 
  18. ;;;;      minibuffer         x-mouse-minibuffer-map 
  19. ;;;;      modeline        x-mouse-modeline-map 
  20. ;;;;      text region        x-mouse-text-map 
  21. ;;;;      scrollbar region    x-mouse-scrollbar-map  
  22. ;;;; The "text region" is that part of the screen where a buffers 
  23. ;;;; contents are displayed. 
  24. ;;;; The "scrollbar region" is the N rightmost columns of the text 
  25. ;;;; region where N is defined by the value of x-mouse-scrollbar-width. 
  26.  
  27. ;; This file is part of GNU Emacs.
  28.  
  29. ;; GNU Emacs is distributed in the hope that it will be useful,
  30. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  31. ;; accepts responsibility to anyone for the consequences of using it
  32. ;; or for whether it serves any particular purpose or works at all,
  33. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  34. ;; License for full details.
  35.  
  36. ;; Everyone is granted permission to copy, modify and redistribute
  37. ;; GNU Emacs, but only under the conditions described in the
  38. ;; GNU Emacs General Public License.   A copy of this license is
  39. ;; supposed to have been given to you along with GNU Emacs so you
  40. ;; can know your rights and responsibilities.  It should be in a
  41. ;; file named COPYING.  Among other things, the copyright notice
  42. ;; and this notice must be preserved on all copies.
  43.  
  44. (provide 'x-mouse)
  45.  
  46. (defvar x-mouse-map nil
  47.   "The name of the x-mouse-map should be used for the place the mouse
  48. is currently pointing at according to the following algorithm:
  49.     mouse location        map
  50.       minibuffer         x-mouse-minibuffer-map
  51.       modeline        x-mouse-modeline-map
  52.       text region        x-mouse-text-map
  53.       scrollbar region    x-mouse-scrollbar-map
  54. The \"text region\" is that part of the screen where a buffer
  55. contents are displayed.
  56. The \"scrollbar region\" is the N rightmost columns of the text
  57. region where N is defined by the value of x-mouse-scrollbar-width.
  58. x-mouse-map will be set (in passing) by x-mouse-window, which returns
  59. the window the mouse is pointing at.
  60. Of course it's an ugly thing to do, but the code to figures out which
  61. window the mouse is in, is virtually the same as that required to work
  62. out what map to use, so it's pointless doing it twice.")
  63.  
  64. (defvar local-x-mouse-map nil
  65.   "The local x-mouse-map to be used for the place the mouse is currently pointing at.")
  66.  
  67. (defvar global-x-mouse-map nil
  68.   "The global x-mouse-map to be used for the place the mouse is currently pointing at.")
  69.  
  70. (defvar x-mouse-text-map nil
  71.   "The mouse map to be used in the text region for the X window system.")
  72.  
  73. (defvar x-mouse-modeline-map nil
  74.   "The mouse map to be used in modelines for the X window system.")
  75.  
  76. (defvar x-mouse-minibuffer-map nil
  77.   "The mouse map to be used in the minibuffer for the X window system.")
  78.  
  79. (defvar x-mouse-scrollbar-map nil
  80.   "The mouse map to be used in the scrollbar region for the X window system.")
  81.  
  82. (defvar x-mouse-scrollbar-width 5
  83.   "*Number of rightmost columns to be the width of the 'scrollbar' region.")
  84.  
  85. (defvar x-mouse-window nil
  86.   "The window the last mouse event occured in.")
  87.  
  88. (defconst x-button-right (char-to-string 0))
  89. (defconst x-button-middle (char-to-string 1))
  90. (defconst x-button-left (char-to-string 2))
  91.  
  92. (defconst x-button-right-up (char-to-string 4))
  93. (defconst x-button-middle-up (char-to-string 5))
  94. (defconst x-button-left-up (char-to-string 6))
  95.  
  96. (defconst x-button-s-right (char-to-string 16))
  97. (defconst x-button-s-middle (char-to-string 17))
  98. (defconst x-button-s-left (char-to-string 18))
  99.  
  100. (defconst x-button-s-right-up (char-to-string 20))
  101. (defconst x-button-s-middle-up (char-to-string 21))
  102. (defconst x-button-s-left-up (char-to-string 22))
  103.  
  104. (defconst x-button-m-right (char-to-string 32))
  105. (defconst x-button-m-middle (char-to-string 33))
  106. (defconst x-button-m-left (char-to-string 34))
  107.  
  108. (defconst x-button-m-right-up (char-to-string 36))
  109. (defconst x-button-m-middle-up (char-to-string 37))
  110. (defconst x-button-m-left-up (char-to-string 38))
  111.  
  112. (defconst x-button-c-right (char-to-string 64))
  113. (defconst x-button-c-middle (char-to-string 65))
  114. (defconst x-button-c-left (char-to-string 66))
  115.  
  116. (defconst x-button-c-right-up (char-to-string 68))
  117. (defconst x-button-c-middle-up (char-to-string 69))
  118. (defconst x-button-c-left-up (char-to-string 70))
  119.  
  120. (defconst x-button-m-s-right (char-to-string 48))
  121. (defconst x-button-m-s-middle (char-to-string 49))
  122. (defconst x-button-m-s-left (char-to-string 50))
  123.  
  124. (defconst x-button-m-s-right-up (char-to-string 52))
  125. (defconst x-button-m-s-middle-up (char-to-string 53))
  126. (defconst x-button-m-s-left-up (char-to-string 54))
  127.  
  128. (defconst x-button-c-s-right (char-to-string 80))
  129. (defconst x-button-c-s-middle (char-to-string 81))
  130. (defconst x-button-c-s-left (char-to-string 82))
  131.  
  132. (defconst x-button-c-s-right-up (char-to-string 84))
  133. (defconst x-button-c-s-middle-up (char-to-string 85))
  134. (defconst x-button-c-s-left-up (char-to-string 86))
  135.  
  136. (defconst x-button-c-m-right (char-to-string 96))
  137. (defconst x-button-c-m-middle (char-to-string 97))
  138. (defconst x-button-c-m-left (char-to-string 98))
  139.  
  140. (defconst x-button-c-m-right-up (char-to-string 100))
  141. (defconst x-button-c-m-middle-up (char-to-string 101))
  142. (defconst x-button-c-m-left-up (char-to-string 102))
  143.  
  144. (defconst x-button-c-m-s-right (char-to-string 112))
  145. (defconst x-button-c-m-s-middle (char-to-string 113))
  146. (defconst x-button-c-m-s-left (char-to-string 114))
  147.  
  148. (defconst x-button-c-m-s-right-up (char-to-string 116))
  149. (defconst x-button-c-m-s-middle-up (char-to-string 117))
  150. (defconst x-button-c-m-s-left-up (char-to-string 118))
  151.  
  152. (defvar x-button-help-alist
  153.   '((0 . right)           (1 . middle)                (2 . left)
  154.     (4 . right-up)          (5 . middle-up)         (6 . left-up)
  155.     (16 . shift-right)              (17 . shift-middle)             (18 . shift-left)
  156.     (20 . shift-right-up)      (21 . shift-middle-up)     (22 . shift-left-up)
  157.     (32 . meta-right)           (33 . meta-middle)          (34 . meta-left)
  158.     (36 . meta-right-up)      (37 . meta-middle-up)             (38 . meta-left-up)
  159.     (48 . meta-shift-right)      (49 . meta-shift-middle)      (50 . meta-shift-left)
  160.     (52 . meta-shift-right-up)      (53 . meta-shift-middle-up)     (54 . meta-shift-left-up)
  161.     (64 . control-right)      (65 . control-middle)             (66 . control-left)
  162.     (68 . control-right-up)      (69 . control-middle-up)     (70 . control-left-up)
  163.     (80 . control-shift-right)      (81 . control-shift-middle)     (82 . control-shift-left)
  164.     (84 . control-shift-right-up) (85 . control-shift-middle-up) (86 . control-shift-left-up)
  165.     (96 . meta-control-right)       (97 . meta-control-middle)      (98 . meta-control-left)
  166.     (100 . meta-control-right-up) (101 . meta-control-middle-up) (102 . meta-control-left-up)
  167.     (112 . meta-control-shift-right)
  168.     (113 . meta-control-shift-middle)
  169.     (114 . meta-control-shift-left)
  170.     (116 . meta-control-shift-right-up)
  171.     (117 . meta-control-shift-middle-up)
  172.     (118 . meta-control-shift-left-up))
  173.   "Alist of the descriptions of what keychord and button combinations
  174. generate which mouse events. If you change any of the x-button-... constants 
  175. you must change the entries in this list to update the online documentation.")
  176.  
  177. (defvar x-process-mouse-hook nil
  178.   "Hook to run after each mouse event is processed.  Should take two
  179. arguments; the first being a list (XPOS YPOS) corresponding to character
  180. offset from top left of screen and the second being a specifier for the
  181. buttons/keys.
  182.  
  183. This will normally be set on a per-buffer basis.")
  184.  
  185. (defmacro eval-in-window (window &rest forms)
  186.   "Switch to WINDOW, evaluate FORMS, return to original window."
  187.   (` (let ((OriginallySelectedWindow (selected-window)))
  188.        (unwind-protect
  189.        (progn
  190.          (select-window (, window))
  191.          (,@ forms))
  192.      (select-window OriginallySelectedWindow)))))
  193. (put 'eval-in-window 'lisp-indent-hook 1)
  194.  
  195. (defmacro eval-in-windows (form &optional yesmini)
  196.   "Switches to each window and evaluates FORM.  Optional argument
  197. YESMINI says to include the minibuffer as a window.
  198. This is a macro, and does not evaluate its arguments."
  199.   (` (let ((OriginallySelectedWindow (selected-window)))
  200.        (unwind-protect 
  201.        (while (progn
  202.             (, form)
  203.             (not (eq OriginallySelectedWindow
  204.                  (select-window
  205.                   (next-window nil (, yesmini)))))))
  206.      (select-window OriginallySelectedWindow)))))
  207. (put 'eval-in-windows 'lisp-indent-hook 0)
  208.  
  209. (defun move-to-loc (x y)
  210.   "Move cursor to window location X, Y.
  211. Handles wrapped and horizontally scrolled lines correctly."
  212.   (move-to-window-line y)
  213.   ;; window-line-end expects this to return the window column it moved to.
  214.   (let ((cc (current-column))
  215.     (nc (move-to-column
  216.          (if (zerop (window-hscroll))
  217.          (+ (current-column)
  218.             (min (- (window-width) 2)    ; To stay on the line.
  219.              x))
  220.            (+ (window-hscroll) -1
  221.           (min (1- (window-width))    ; To stay on the line.
  222.                x))))))
  223.     (- nc cc)))
  224.  
  225. (defmacro x-mouse-loc-win (loc)
  226.   "Return the window of LOC, a (window x y) 3 tuple."
  227.   (list 'nth 0 loc))
  228.  
  229. (defmacro x-mouse-loc-x (loc)
  230.   "Return the x coordinate of LOC, a (window x y) 3 tuple."
  231.   (list 'nth 1 loc))
  232.  
  233. (defmacro x-mouse-loc-y (loc)
  234.   "Return the y coordinate of LOC, a (window x y) 3 tuple."
  235.   (list 'nth 2 loc))
  236.  
  237. (defun minibuffer-window-p (window)
  238.   "True iff this WINDOW is minibuffer."
  239.   (= (screen-height) (nth 3 (window-edges window))))    ; The bottom edge.
  240.  
  241. (defun x-mouse-window-xy (mousepos)
  242.   ;; Minor mutilation of the sun mouse function which performs the same task.
  243.   "Find window containing MOUSEPOS (screen coordinates X and Y).
  244. Returns list (window x y) where x and y are relative to window."
  245.   (let ((x (car mousepos))
  246.     (y (car (cdr mousepos))))
  247.     (or
  248.      (catch 'found
  249.        (eval-in-windows 
  250.     (let ((we (window-edges (selected-window))))
  251.       (let ((le (nth 0 we))
  252.         (te (nth 1 we))
  253.         (re (nth 2 we))
  254.         (be (nth 3 we)))
  255.         (if (= re (screen-width))
  256.         ;; include the continuation column with this window
  257.         (setq re (1+ re)))
  258.         (if (= be (screen-height))
  259.         ;; include partial line at bottom of screen with this window
  260.         ;; id est, if window is not multple of char size.
  261.         (setq be (1+ be)))
  262.         (if (and (>= x le) (< x re)
  263.              (>= y te) (< y be))
  264.         (throw 'found 
  265.                (list (selected-window) (- x le) (- y te))))))
  266.     t))                ; include minibuffer in eval-in-windows
  267.      ;;If x,y from a real mouse click, we shouldn't get here.
  268.      (list nil x y))))
  269.  
  270. (defun x-mouse-window-region (loc)
  271.   "Parse (window x y) into a region symbol.
  272. Returns one of (text scrollbar modeline minibuffer)"
  273.   (let ((w (x-mouse-loc-win loc))
  274.     (x (x-mouse-loc-x loc))
  275.     (y (x-mouse-loc-y loc)))
  276.     (let ((right (1- (window-width w)))
  277.       (bottom (1- (window-height w))))
  278.       (cond ((minibuffer-window-p w) 'minibuffer)
  279.         ((>= y bottom) 'modeline)
  280.         ((>= x right) 'scrollbar)
  281.         ;; far right column (window seperator) is always a scrollbar
  282.         ((and x-mouse-scrollbar-width
  283.           ;; mouse within scrollbar-width of edge.
  284.           (>= x (- right x-mouse-scrollbar-width))
  285.           ;; mouse a few chars past the end of line.
  286.           (>= x (+ 2 (x-mouse-window-line-end w x y))))
  287.          'scrollbar)
  288.         (t 'text)))))
  289.  
  290. (defun x-mouse-window-line-end (w x y)
  291.   "Return WINDOW column (ignore X) containing end of line Y"
  292.   (eval-in-window w (save-excursion (move-to-loc (screen-width) y))))
  293.  
  294. (defun x-mouse-lookup (mouse-hit)
  295.   "Return the binding of MOUSE-HIT in local-x-mouse-map (then global-x-mouse-map), or nil."
  296.   (let ((local-mouse-map (symbol-value (intern-soft (format "local-%s" x-mouse-map)))))
  297.     (or (if local-mouse-map
  298.         (lookup-key local-mouse-map mouse-hit))
  299.     ;; global maps are vector keymaps
  300.     (lookup-key (symbol-value (intern-soft (format "global-%s" x-mouse-map))) mouse-hit))))
  301.  
  302. (defun x-multiple-map-flush-mouse-queue ()
  303.   "Process all queued mouse events using multiple mouse maps."
  304.   (interactive)
  305.   (while (> (x-mouse-events) 0)
  306.     (let ((mouse-event (x-get-mouse-event nil)) )
  307.       (let ((mouse-com-letter (car mouse-event))
  308.         (mouse-pos (car (cdr mouse-event))))
  309.     (let* ((mouse-loc (x-mouse-window-xy mouse-pos))
  310.            (mouse-pos (list (x-mouse-loc-x mouse-loc) ; Rebind mouse-pos to 
  311.                 (x-mouse-loc-y mouse-loc)))) ; be window-relative.
  312.       (setq x-mouse-window (x-mouse-loc-win mouse-loc)) ; Remember the mouse window.
  313.       (setq x-mouse-map (format "x-mouse-%s-map" (x-mouse-window-region mouse-loc)))
  314.       (if (integerp mouse-com-letter)
  315.           ;; x-get-mouse-event sometimes screws up and returns N
  316.           ;; instead of (char-to-string N), so...
  317.           (setq mouse-com-letter (char-to-string mouse-com-letter)))
  318.       (let ((mouse-cmd (save-excursion
  319.                  ;; Look up mouse binding in the mouse window buffer's maps.
  320.                  (set-buffer (window-buffer x-mouse-window))
  321.                  (x-mouse-lookup mouse-com-letter))))
  322.         (if mouse-cmd
  323.         (funcall mouse-cmd mouse-pos)
  324.           (ding))
  325.         (and (boundp 'x-process-mouse-hook)
  326.          (symbol-value 'x-process-mouse-hook)
  327.          (funcall x-process-mouse-hook x-mouse-pos x-mouse-item))))))))
  328.  
  329. (define-key global-map "\C-c\C-m" 'x-multiple-map-flush-mouse-queue)
  330. (define-key global-map "\C-x\C-@" 'x-multiple-map-flush-mouse-queue)
  331.  
  332. (defun local-set-mouse (region hit def)
  333.   "Args REGION, MOUSE-HIT and DEF.
  334. Define mouse-event MOUSE-HIT, in mouse region REGION, as DEF. 
  335. REGION is the quoted name of a mouse region, e.g. 'modeline
  336. MOUSE-HIT is a symbol denoting a mouse-event.
  337. DEF is an x-mouse function taking 1 arg: a list of the mouse (x y) position.
  338. Valid MOUSE-HIT symbols are:
  339.  x-button-BUTTON
  340.  x-button-c-BUTTON
  341.  x-button-m-BUTTON
  342.  x-button-s-BUTTON
  343.  x-button-c-m-BUTTON
  344.  x-button-c-s-BUTTON
  345.  x-button-m-s-BUTTON
  346.  x-button-c-m-s-BUTTON
  347. where BUTTON is one of left, middle or right.
  348. c, m, and s denote the control, meta and shift keys respectively (for chords).
  349. Additionally -up may be appended, indicating that the function is to be
  350. run on an up-click, i.e. when the mouse button is released.
  351.  
  352. The definition goes in the current buffer's local version of MOUSEMAP,
  353. which is shared with other buffers in the same major mode."
  354.   (funcall 'define-key 
  355.        (let ((mapname (format "local-x-mouse-%s-map" region)))
  356.          (or (symbol-value (intern-soft mapname)) ; Create a sparse local map
  357.          (set (intern mapname) (make-sparse-keymap)) ; if none currently exists.
  358.          (intern-soft mapname)))
  359.        hit 
  360.        def))
  361.  
  362. (defun global-set-mouse (region hit def)
  363.   "Args REGION, MOUSE-HIT and DEF.
  364. Define mouse-event MOUSE-HIT, in mouse region REGION, as DEF. 
  365. REGION is the quoted name of a mouse region, e.g. 'modeline
  366. MOUSE-HIT is an unquoted symbol denoting a mouse-event.
  367. DEF is the quoted name of an x-mouse function of 1 arg: the mouse (x y) position.
  368. Valid MOUSE-HIT symbols are:
  369.  x-button-BUTTON
  370.  x-button-c-BUTTON
  371.  x-button-m-BUTTON
  372.  x-button-s-BUTTON
  373.  x-button-c-m-BUTTON
  374.  x-button-c-s-BUTTON
  375.  x-button-m-s-BUTTON
  376.  x-button-c-m-s-BUTTON
  377. where BUTTON is one of left, middle or right.
  378. c, m, and s denote the control, meta and shift keys respectively (for chords).
  379. Additionally -up may be appended, indicating that the function is to be
  380. run on an up-click, i.e. when the mouse button is released.
  381.  
  382. The definition goes in the global version of MOUSEMAP,
  383. which is shared by all buffers by default."
  384.   (funcall 'define-key 
  385.        ;; Global maps are initialised next, thus they are always interned.
  386.        (symbol-value (intern-soft (format "global-x-mouse-%s-map" region)))
  387.        hit 
  388.        def))
  389.  
  390. (defun x-mouse-select (arg)
  391.   "Select Emacs window the mouse is on."
  392.   (select-window x-mouse-window))
  393.  
  394. (defun x-mouse-keep-one-window (arg)
  395.   "Select Emacs window mouse is on, then kill all other Emacs windows."
  396.   (delete-other-windows x-mouse-window))
  397.  
  398. (defun x-mouse-select-and-split (arg)
  399.   "Select Emacs window mouse is on, then split it vertically in half."
  400.   (select-window x-mouse-window)
  401.   (split-window-vertically nil))
  402.  
  403. (defun x-mouse-set-point (arg)
  404.   "Select Emacs window mouse is on, and move point to mouse position."
  405.   (select-window x-mouse-window)
  406.   (move-to-window-line (car (cdr arg)))
  407.   (move-to-column (+ (car arg) (current-column))))
  408.  
  409. (defun x-cut-text (arg &optional kill)
  410.   "Copy text between point and mouse position into window system cut buffer.
  411. Save in Emacs kill ring also."
  412.   (if (eq x-mouse-window (selected-window))
  413.       (save-excursion
  414.     (let ((opoint (point))
  415.           beg end)
  416.       (x-mouse-set-point arg)
  417.       (setq beg (min opoint (point))
  418.         end (max opoint (point)))
  419.       (x-store-cut-buffer (buffer-substring beg end))
  420.       (copy-region-as-kill beg end)
  421.       (if kill (delete-region beg end))))
  422.     (message "Mouse not in selected window")))
  423.  
  424. (defun x-paste-text (arg)
  425.   "Move point to mouse position and insert window system cut buffer contents."
  426.   (x-mouse-set-point arg)
  427.   (insert (x-get-cut-buffer)))
  428.  
  429. (defun x-cut-and-wipe-text (arg)
  430.   "Kill text between point and mouse; also copy to window system cut buffer."
  431.   (x-cut-text arg t))
  432.  
  433. (defun x-mouse-ignore (arg)
  434.   "Don't do anything.")
  435.  
  436. (defun x-mouse-help-region (arg)
  437.   "Describe the mouse bindings in current region."
  438.   (x-mouse-report-bindings x-mouse-map))
  439.  
  440. (defun x-mouse-where-is (function map)
  441.   (let ((map-name (symbol-name map))
  442.     (map-contents (symbol-value map)))
  443.     (if (consp map-contents)
  444.     ;; It's a sparse keymap
  445.     (apply 'append
  446.            (mapcar
  447.         (function 
  448.          (lambda (x)
  449.            (if (eq (cdr x) function)
  450.                (cons (string-to-int (car x)) map-name))))
  451.         (cdr map-contents))) 
  452.       (let ((index 0)            ; For remembering where we are in the map....
  453.         (result '())
  454.         (map-size (length map-contents)))
  455.     (while (< index map-size)
  456.       (let ((map-el (aref map-contents index)))
  457.         (if (and map-el (eq map-el function))
  458.         ;; We have a non-nil binding...
  459.         (setq result (cons (cons index map-name) result))))
  460.       (setq index (1+ index)))
  461.     result))))
  462.  
  463. (defun x-mouse-binding (x-mouse-fn &optional pretty)
  464.   "Describe the mouse binding of X-MOUSE-FN.
  465. If called interactively or if optional 2nd arg PRETTY is non-nil, 
  466. make it a user-friendly string description."
  467.   (interactive "aFunction name: \nP")
  468.   (let ((bindings 
  469.      (apply 'append 
  470.         (mapcar (function (lambda (x) (x-mouse-where-is x-mouse-fn x)))
  471.             (list 'local-x-mouse-text-map
  472.                   'local-x-mouse-scrollbar-map
  473.                   'local-x-mouse-modeline-map
  474.                   'local-x-mouse-minibuffer-map
  475.                   'global-x-mouse-text-map
  476.                   'global-x-mouse-scrollbar-map
  477.                   'global-x-mouse-modeline-map
  478.                   'global-x-mouse-minibuffer-map)))))
  479.     (if bindings
  480.     (if (interactive-p)
  481.         (message
  482.          (format
  483.           "%s is on %s." 
  484.           x-mouse-fn
  485.           (mapconcat
  486.            (function
  487.         (lambda (x)
  488.           (format "%s in the %s region"
  489.               (cdr (assq (car x) x-button-help-alist))
  490.               (let ((map-id (substring (cdr x) -6 -5)))
  491.                 (cond ((string= map-id "x") "text")
  492.                   ((string= map-id "a") "scrollbar")
  493.                   ((string= map-id "n") "modeline")
  494.                   ((string= map-id "e") "minibuffer"))))))
  495.            bindings " or ")))
  496.       (if pretty
  497.           (mapconcat
  498.            (function
  499.         (lambda (x)
  500.           (format "%s in the %s region"
  501.               (cdr (assq (car x) x-button-help-alist)) 
  502.               (let ((map-id (substring (cdr x) -6 -5)))
  503.                 (cond ((string= map-id "x") "text")
  504.                   ((string= map-id "a") "scrollbar")
  505.                   ((string= map-id "n") "modeline")
  506.                   ((string= map-id "e") "minibuffer"))))))
  507.            bindings " or ")
  508.         bindings))
  509.       (if (interactive-p)
  510.       (message (format "%s does not have a mouse-binding." x-mouse-fn))
  511.     (format "%s does not have a mouse-binding." x-mouse-fn)))))
  512.  
  513. (defun x-mouse-report-bindings (map)
  514.   "Describe the contents of MAP, a mouse map."
  515.   (eval-in-window
  516.     x-mouse-window
  517.     (with-output-to-temp-buffer "*Help*"
  518.       (let ((local-map (intern-soft (format "local-%s" map)))
  519.         (global-map (intern-soft (format "global-%s" map))))
  520.     (let ((l-map (eval local-map))
  521.           (region (substring map 8 -4)))
  522.       (if l-map
  523.           ;; The Local mouse map has some bindings in it...
  524.           (progn 
  525.         (princ "Local Mouse bindings in ")
  526.         (princ region)
  527.         (princ " region are:\n")
  528.         (princ (x-mouse-describe-map l-map))))
  529.       (princ "Global Mouse bindings in ")
  530.       (princ region)
  531.       (princ " region are:\n")
  532.       (princ (x-mouse-describe-map (eval global-map) l-map)))))))
  533.  
  534. (defun x-mouse-describe-map (map &optional local-map)
  535.   "Return a documentation string describing the bindings in MAP, an x-mouse map."
  536.   (if (consp map)
  537.       ;; It's a sparse keymap
  538.       (apply 'concat
  539.          (mapcar
  540.           (function (lambda (x)
  541.               (let ((fn (cdr x)))
  542.                 (if (eq fn 'x-mouse-ignore)    ; Ignore x-mouse-ignore
  543.                 ""
  544.                   (format "%s:            %s\n"
  545.                       (cdr (assoc (car x) x-button-help-alist)) fn)))))
  546.           (cdr map))) 
  547.     (let ((count 0));; For remembering where we are in the map....
  548.       (mapconcat
  549.        (function (lambda (x)
  550.            (setq count (1+ count))
  551.            (if x
  552.                ;; We have a non-nil binding...
  553.                (let ((keynum (1- count)))
  554.              (if (or (and local-map (assoc keynum local-map))
  555.                  ;; We have already printed the local
  556.                  ;; binding for this mouse event
  557.                  (eq x 'x-mouse-ignore)) ; Ignore x-mouse-ignore
  558.                  ""
  559.                (format "%s:            %s\n"
  560.                    (cdr (assoc keynum x-button-help-alist)) x)))
  561.              "")))
  562.        map "")))) 
  563.  
  564. ;;;; Initialise sensible (?) settings for maps whether they are being used or not.
  565.  
  566. (setq global-x-mouse-modeline-map (make-keymap))
  567. (setq global-x-mouse-minibuffer-map (make-keymap))
  568. (setq global-x-mouse-scrollbar-map (make-keymap))
  569. (setq global-x-mouse-text-map (make-keymap))
  570. (make-variable-buffer-local 'local-x-mouse-modeline-map)
  571. (make-variable-buffer-local 'local-x-mouse-minibuffer-map)
  572. (make-variable-buffer-local 'local-x-mouse-scrollbar-map)
  573. (make-variable-buffer-local 'local-x-mouse-text-map)
  574.  
  575. ;; Prevent beeps on button-up.  If the button isn't bound to anything, it
  576. ;; will beep on button-down.
  577.  
  578. (global-set-mouse 'modeline    x-button-right-up     'x-mouse-ignore)
  579. (global-set-mouse 'minibuffer    x-button-right-up     'x-mouse-ignore)
  580. (global-set-mouse 'text         x-button-right-up     'x-mouse-ignore)
  581. (global-set-mouse 'scrollbar    x-button-right-up     'x-mouse-ignore)
  582. (global-set-mouse 'modeline    x-button-middle-up     'x-mouse-ignore)
  583. (global-set-mouse 'minibuffer    x-button-middle-up     'x-mouse-ignore)
  584. (global-set-mouse 'text         x-button-middle-up     'x-mouse-ignore)
  585. (global-set-mouse 'scrollbar    x-button-middle-up     'x-mouse-ignore)
  586. (global-set-mouse 'modeline    x-button-left-up     'x-mouse-ignore)
  587. (global-set-mouse 'minibuffer    x-button-left-up     'x-mouse-ignore)
  588. (global-set-mouse 'text         x-button-left-up     'x-mouse-ignore)
  589. (global-set-mouse 'scrollbar    x-button-left-up     'x-mouse-ignore)
  590. (global-set-mouse 'modeline    x-button-s-right-up     'x-mouse-ignore)
  591. (global-set-mouse 'minibuffer    x-button-s-right-up     'x-mouse-ignore)
  592. (global-set-mouse 'text         x-button-s-right-up     'x-mouse-ignore)
  593. (global-set-mouse 'scrollbar    x-button-s-right-up     'x-mouse-ignore)
  594. (global-set-mouse 'modeline    x-button-s-middle-up     'x-mouse-ignore)
  595. (global-set-mouse 'minibuffer    x-button-s-middle-up     'x-mouse-ignore)
  596. (global-set-mouse 'text         x-button-s-middle-up     'x-mouse-ignore)
  597. (global-set-mouse 'scrollbar    x-button-s-middle-up     'x-mouse-ignore)
  598. (global-set-mouse 'modeline    x-button-s-left-up     'x-mouse-ignore)
  599. (global-set-mouse 'minibuffer    x-button-s-left-up     'x-mouse-ignore)
  600. (global-set-mouse 'text         x-button-s-left-up     'x-mouse-ignore)
  601. (global-set-mouse 'scrollbar    x-button-s-left-up     'x-mouse-ignore)
  602. (global-set-mouse 'modeline    x-button-m-right-up     'x-mouse-ignore)
  603. (global-set-mouse 'minibuffer    x-button-m-right-up     'x-mouse-ignore)
  604. (global-set-mouse 'text         x-button-m-right-up     'x-mouse-ignore)
  605. (global-set-mouse 'scrollbar    x-button-m-right-up     'x-mouse-ignore)
  606. (global-set-mouse 'modeline    x-button-m-middle-up     'x-mouse-ignore)
  607. (global-set-mouse 'minibuffer    x-button-m-middle-up     'x-mouse-ignore)
  608. (global-set-mouse 'text         x-button-m-middle-up     'x-mouse-ignore)
  609. (global-set-mouse 'scrollbar    x-button-m-middle-up     'x-mouse-ignore)
  610. (global-set-mouse 'modeline    x-button-m-left-up     'x-mouse-ignore)
  611. (global-set-mouse 'minibuffer    x-button-m-left-up     'x-mouse-ignore)
  612. (global-set-mouse 'text         x-button-m-left-up     'x-mouse-ignore)
  613. (global-set-mouse 'scrollbar    x-button-m-left-up     'x-mouse-ignore)
  614. (global-set-mouse 'modeline    x-button-c-right-up     'x-mouse-ignore)
  615. (global-set-mouse 'minibuffer    x-button-c-right-up     'x-mouse-ignore)
  616. (global-set-mouse 'text         x-button-c-right-up     'x-mouse-ignore)
  617. (global-set-mouse 'scrollbar    x-button-c-right-up     'x-mouse-ignore)
  618. (global-set-mouse 'modeline    x-button-c-middle-up     'x-mouse-ignore)
  619. (global-set-mouse 'minibuffer    x-button-c-middle-up     'x-mouse-ignore)
  620. (global-set-mouse 'text         x-button-c-middle-up     'x-mouse-ignore)
  621. (global-set-mouse 'scrollbar    x-button-c-middle-up     'x-mouse-ignore)
  622. (global-set-mouse 'modeline    x-button-c-left-up     'x-mouse-ignore)
  623. (global-set-mouse 'minibuffer    x-button-c-left-up     'x-mouse-ignore)
  624. (global-set-mouse 'text         x-button-c-left-up     'x-mouse-ignore)
  625. (global-set-mouse 'scrollbar    x-button-c-left-up     'x-mouse-ignore)
  626. (global-set-mouse 'modeline    x-button-m-s-right-up     'x-mouse-ignore)
  627. (global-set-mouse 'minibuffer    x-button-m-s-right-up     'x-mouse-ignore)
  628. (global-set-mouse 'text         x-button-m-s-right-up     'x-mouse-ignore)
  629. (global-set-mouse 'scrollbar    x-button-m-s-right-up     'x-mouse-ignore)
  630. (global-set-mouse 'modeline    x-button-m-s-middle-up     'x-mouse-ignore)
  631. (global-set-mouse 'minibuffer    x-button-m-s-middle-up     'x-mouse-ignore)
  632. (global-set-mouse 'text         x-button-m-s-middle-up     'x-mouse-ignore)
  633. (global-set-mouse 'scrollbar    x-button-m-s-middle-up     'x-mouse-ignore)
  634. (global-set-mouse 'modeline    x-button-m-s-left-up     'x-mouse-ignore)
  635. (global-set-mouse 'minibuffer    x-button-m-s-left-up     'x-mouse-ignore)
  636. (global-set-mouse 'text         x-button-m-s-left-up     'x-mouse-ignore)
  637. (global-set-mouse 'scrollbar    x-button-m-s-left-up     'x-mouse-ignore)
  638. (global-set-mouse 'modeline    x-button-c-s-right-up     'x-mouse-ignore)
  639. (global-set-mouse 'minibuffer    x-button-c-s-right-up     'x-mouse-ignore)
  640. (global-set-mouse 'text         x-button-c-s-right-up     'x-mouse-ignore)
  641. (global-set-mouse 'scrollbar    x-button-c-s-right-up     'x-mouse-ignore)
  642. (global-set-mouse 'modeline    x-button-c-s-middle-up     'x-mouse-ignore)
  643. (global-set-mouse 'minibuffer    x-button-c-s-middle-up     'x-mouse-ignore)
  644. (global-set-mouse 'text         x-button-c-s-middle-up     'x-mouse-ignore)
  645. (global-set-mouse 'scrollbar    x-button-c-s-middle-up     'x-mouse-ignore)
  646. (global-set-mouse 'modeline    x-button-c-s-left-up     'x-mouse-ignore)
  647. (global-set-mouse 'minibuffer    x-button-c-s-left-up     'x-mouse-ignore)
  648. (global-set-mouse 'text         x-button-c-s-left-up     'x-mouse-ignore)
  649. (global-set-mouse 'scrollbar    x-button-c-s-left-up     'x-mouse-ignore)
  650. (global-set-mouse 'modeline    x-button-c-m-right-up     'x-mouse-ignore)
  651. (global-set-mouse 'minibuffer    x-button-c-m-right-up     'x-mouse-ignore)
  652. (global-set-mouse 'text        x-button-c-m-right-up     'x-mouse-ignore)
  653. (global-set-mouse 'scrollbar    x-button-c-m-right-up     'x-mouse-ignore)
  654. (global-set-mouse 'modeline    x-button-c-m-middle-up     'x-mouse-ignore)
  655. (global-set-mouse 'minibuffer    x-button-c-m-middle-up     'x-mouse-ignore)
  656. (global-set-mouse 'text         x-button-c-m-middle-up     'x-mouse-ignore)
  657. (global-set-mouse 'scrollbar    x-button-c-m-middle-up     'x-mouse-ignore)
  658. (global-set-mouse 'modeline    x-button-c-m-left-up     'x-mouse-ignore)
  659. (global-set-mouse 'minibuffer    x-button-c-m-left-up     'x-mouse-ignore)
  660. (global-set-mouse 'text         x-button-c-m-left-up     'x-mouse-ignore)
  661. (global-set-mouse 'scrollbar    x-button-c-m-left-up     'x-mouse-ignore)
  662. (global-set-mouse 'modeline    x-button-c-m-s-right-up     'x-mouse-ignore)
  663. (global-set-mouse 'minibuffer    x-button-c-m-s-right-up     'x-mouse-ignore)
  664. (global-set-mouse 'text         x-button-c-m-s-right-up     'x-mouse-ignore)
  665. (global-set-mouse 'scrollbar    x-button-c-m-s-right-up     'x-mouse-ignore)
  666. (global-set-mouse 'modeline    x-button-c-m-s-middle-up 'x-mouse-ignore)
  667. (global-set-mouse 'minibuffer    x-button-c-m-s-middle-up 'x-mouse-ignore)
  668. (global-set-mouse 'text         x-button-c-m-s-middle-up 'x-mouse-ignore)
  669. (global-set-mouse 'scrollbar    x-button-c-m-s-middle-up 'x-mouse-ignore)
  670. (global-set-mouse 'modeline    x-button-c-m-s-left-up     'x-mouse-ignore)
  671. (global-set-mouse 'minibuffer    x-button-c-m-s-left-up     'x-mouse-ignore)
  672. (global-set-mouse 'text         x-button-c-m-s-left-up     'x-mouse-ignore)
  673. (global-set-mouse 'scrollbar    x-button-c-m-s-left-up     'x-mouse-ignore)
  674.   
  675.