home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / packages / MouseAndMenuEmacs / x-fns.el < prev    next >
Encoding:
Text File  |  1990-05-31  |  20.2 KB  |  505 lines
  1. ;;;; Russell Ritchie, Scottish HCI Centre, <russell@uk.ac.strath.hci>.
  2. ;;;; Fri Jan  6 12:07:49 1989
  3. ;;;; Subroutines for Mouse operations under X windows, based on the file
  4. ;;;; "sun-fns.el" from the standard distribution.
  5.  
  6. (require 'x-mouse)
  7. (require 'utilities)            ; For indicate-region
  8. (provide 'x-fns)
  9.  
  10. (defun x-mouse-select-item (arg header items)
  11.   "Pop up an X Menu at ARG with HEADER and ITEMS, return selected ITEM or nil.
  12. ARG is a list (x-pos y-pos).
  13. HEADER is a string.
  14. If ITEMS is a list of strings or symbols, the selected string or
  15. symbol is returned. If it is a list of lists in which case the car of
  16. the list (which must be a string) is displayed as the selection item
  17. and the cdr of the list is returned when it is selected.
  18. See also x-mouse-query which is a more robust version of this." 
  19.   (x-popup-menu
  20.    arg
  21.    (list
  22.     "Selection Menu"
  23.     (cons header
  24.       (if (consp (car items))
  25.           items
  26.         (mapcar (function (lambda (x) (cons (format "%s" x) x))) items))))))
  27.  
  28. (defun x-mouse-move-point (arg)
  29.   "Move point to X mouse cursor."
  30.   (select-window x-mouse-window)
  31.   (move-to-loc (car arg) (car (cdr arg)))
  32.   (if (memq last-command        ; support the mouse-copy/delete/yank
  33.         '(mouse-copy mouse-delete mouse-yank-move))
  34.       (setq this-command 'x-mouse-yank-move)))
  35.  
  36. (defun x-mouse-set-mark (arg)
  37.   "Select Emacs window mouse is on, and set mark at mouse position.
  38. Display cursor at that position for a second."
  39.   (eval-in-window x-mouse-window    ; use this to get the unwind protect
  40.     (let ((point (point)))
  41.       (move-to-loc (car arg) (car (cdr arg)))
  42.       (set-mark (point))
  43.       (goto-char point)
  44.       (indicate-region))))
  45.  
  46. (defun x-mouse-set-mark-and-stuff (arg)
  47.   "Set mark at mouse cursor, and put region in window system cut buffer."
  48.   (x-mouse-set-mark arg)
  49.   (x-store-cut-buffer (buffer-substring (region-beginning) (region-end))))
  50.  
  51. ;;;; Simple mouse dragging stuff: marking with button up
  52.  
  53. (defvar *mouse-drag-window* nil
  54.   "The window the last mouse drag action started in, bound on mouse down.")
  55. (defvar *mouse-drag-coordinates* nil
  56.   "The (x y) start location of the last mouse drag action, bound on mouse down.")
  57.  
  58. (defun x-mouse-drag-move-point (arg)
  59.   "Move point to mouse cursor, and allow dragging."
  60.   (x-mouse-move-point arg)
  61.   (setq *mouse-drag-window* x-mouse-window 
  62.      *mouse-drag-coordinates* arg))
  63.  
  64. (defun x-mouse-drag-set-mark-stuff (arg)
  65.   "The up click handler that goes with mouse-drag-move-point.
  66.  If mouse is in same window but at different x or y than when
  67.  mouse-drag-move-point was last executed, set the mark at mouse
  68.  and put the region in the window system cut buffer."
  69.   (if (and (eq *mouse-drag-window* x-mouse-window)
  70.        (not (equal *mouse-drag-coordinates* arg)))
  71.       (x-mouse-set-mark-and-stuff arg)
  72.     (setq this-command last-command)))    ; this was just an upclick no-op.
  73.  
  74. (defun x-mouse-select-or-drag-move-point (arg)
  75.   "Select window if not selected, otherwise do mouse-drag-move-point."
  76.   (if (eq (selected-window) x-mouse-window)
  77.       (x-mouse-drag-move-point arg)
  78.     (select-window x-mouse-window)))
  79.  
  80. (defun x-mouse-exch-pt-and-mark (arg)
  81.   "Exchange point and mark."
  82.   (select-window x-mouse-window)
  83.   (exchange-point-and-mark))
  84.  
  85. (defun x-mouse-call-kbd-macro (arg)
  86.   "Invokes last keyboard macro at mouse cursor."
  87.   (x-mouse-move-point arg)
  88.   (call-last-kbd-macro))
  89.  
  90. (defun x-mouse-mark-thing (arg)
  91.   "Set point and mark to text object using syntax table.
  92.  The resulting region is put in the window system cut buffer.
  93.  Left or right Paren syntax marks an s-expression.  
  94.  Clicking at the end of a line marks the line including a trailing newline.  
  95.  If it doesn't recognize one of these it marks the character at point."
  96.   (x-mouse-move-point arg)
  97.   (if (eobp) (open-line 1))
  98.   (let* ((char (char-after (point)))
  99.      (syntax (char-syntax char)))
  100.     (cond
  101.      ((eq syntax ?w)            ; word.
  102.       (forward-word 1)
  103.       (set-mark (point))
  104.       (forward-word -1))
  105.      ((eq syntax ?\( )            ; open paren.
  106.       (mark-sexp 1))
  107.      ((eq syntax ?\) )            ; close paren.
  108.       (forward-char 1)
  109.       (mark-sexp -1)
  110.       (exchange-point-and-mark))
  111.      ((eolp)                ; mark line if at end.
  112.       (set-mark (1+ (point)))
  113.       (beginning-of-line 1))
  114.      (t                    ; mark character
  115.       (set-mark (1+ (point)))))
  116.     (indicate-region))            ; display region boundary.
  117.   (x-store-cut-buffer (buffer-substring (region-beginning) (region-end))))
  118.  
  119. (defun x-mouse-kill-thing (arg)
  120.   "Kill thing at mouse, and put point there."
  121.   (x-mouse-mark-thing arg)
  122.   (kill-region-and-unmark (region-beginning) (region-end)))
  123.  
  124. (defun x-mouse-kill-thing-there (arg)
  125.   "Kill thing at mouse, leave point where it was.
  126. See x-mouse-mark-thing for a description of the objects recognized."
  127.   (eval-in-window x-mouse-window
  128.     (save-excursion
  129.       (x-mouse-mark-thing arg)
  130.       (kill-region (region-beginning) (region-end)))))
  131.  
  132. (defun x-mouse-save-thing (arg &optional quiet)
  133.   "Put thing at mouse in kill ring.
  134. See x-mouse-mark-thing for a description of the objects recognized."
  135.   (x-mouse-mark-thing arg)
  136.   (copy-region-as-kill (region-beginning) (region-end))
  137.   (if (not quiet) (message "Thing saved")))
  138.  
  139. (defun x-mouse-save-thing-there (arg &optional quiet)
  140.   "Put thing at mouse in kill ring, leave point as is.
  141. See x-mouse-mark-thing for a description of the objects recognized."
  142.   (eval-in-window x-mouse-window
  143.     (save-excursion
  144.       (x-mouse-save-thing arg quiet))))
  145.  
  146. (defun x-mouse-copy-thing (arg)
  147.   "Put thing at mouse in kill ring, yank to point.
  148. See x-mouse-mark-thing for a description of the objects recognized."
  149.   (setq last-command 'not-kill)        ; Avoids appending to previous kills.
  150.   (x-mouse-save-thing-there arg t)
  151.   (yank)
  152.   (setq this-command 'yank))
  153.  
  154. (defun x-mouse-move-thing (arg)
  155.   "Kill thing at mouse, yank it to point.
  156. See mouse-mark-thing for a description of the objects recognized."
  157.   (setq last-command 'not-kill)        ; Avoids appending to previous kills.
  158.   (x-mouse-kill-thing-there arg)
  159.   (yank)
  160.   (setq this-command 'yank))
  161.  
  162. (defun x-mouse-yank-at-point (&optional arg)
  163.   "Yank from kill-ring at point; then cycle thru kill ring."
  164.   (if (eq last-command 'yank)
  165.       (let ((before (< (point) (mark))))
  166.      (delete-region (point) (mark))
  167.      (rotate-yank-pointer 1)
  168.      (insert (car kill-ring-yank-pointer))
  169.      (if before (exchange-point-and-mark)))
  170.     (yank))
  171.   (setq this-command 'yank))
  172.  
  173. (defun x-mouse-yank-at-mouse (arg)
  174.   "Yank from kill-ring at mouse; then cycle thru kill ring."
  175.   (x-mouse-move-point arg)
  176.   (x-mouse-yank-at-point arg))
  177.   
  178. (defun x-mouse-save/delete/yank (&optional arg)
  179.   "Context sensitive save/delete/yank.
  180. Consecutive clicks perform as follows:
  181.      * first click saves region to kill ring,
  182.      * second click kills region,
  183.      * third click yanks from kill ring,
  184.      * subsequent clicks cycle thru kill ring.
  185. If x-mouse-set-point is performed after the first or second click,
  186. the next click will do a yank, etc.  
  187. Except for a possible x-mouse-set-point, this command is insensitive
  188. to mouse location."  
  189.   (cond
  190.    ((memq last-command '(x-mouse-delete yank x-mouse-yank-move)) ; third+ click
  191.     (x-mouse-yank-at-point))
  192.    ((eq last-command 'x-mouse-copy)    ; second click
  193.     (kill-region (region-beginning) (region-end))
  194.     (setq this-command 'x-mouse-delete))
  195.    (t                    ; first click
  196.     (copy-region-as-kill (region-beginning) (region-end))
  197.     (message "Region saved")
  198.     (setq this-command 'x-mouse-copy))))
  199.  
  200. (defun x-mouse-save/delete/yank-no-op (arg)
  201.   "Percolate last-command through a mouse-event."
  202.   (setq this-command last-command))
  203.  
  204. (defun x-mouse-split-horizontally (arg)
  205.   "Splits the window horizontally at mouse cursor."
  206.   (eval-in-window
  207.       x-mouse-window
  208.     (split-window-horizontally (1+ (car arg)))))
  209.  
  210. (defun x-mouse-split-vertically (arg)
  211.   "Split the window vertically at the mouse cursor."
  212.   (eval-in-window
  213.       x-mouse-window
  214.     (split-window-vertically (1+ (car (cdr arg))))))
  215.  
  216. (fset 'x-mouse-delete-other-windows 'x-mouse-keep-one-window)
  217.  
  218. (defun x-mouse-delete-window (arg)
  219.   "Deletes the window mouse is in."
  220.   (delete-window x-mouse-window))
  221.  
  222. (defun x-mouse-select-emacs-buffer (arg &optional buffers header)
  223.   "Pop up an X menu at position ARG of BUFFERS (defaults to (buffer-list)).
  224. If optional 3rd arg HEADER is non-nil use that instead of 
  225. \"Select a buffer\" as the namestripe of the menu to be popped up.
  226. Return selected buffer or nil."   
  227.   (x-mouse-select-item 
  228.    arg (or header "Select a buffer")
  229.    (let ((buffers (or buffers (buffer-list)))
  230.      buffer-a-list)
  231.      (while buffers
  232.        (let ((elt (car buffers)))
  233.      (if (not (string-match "^ " (buffer-name elt)))
  234.          (setq buffer-a-list 
  235.            (cons (cons (format "%14s   %s"
  236.                        (buffer-name elt)
  237.                        (or (buffer-file-name elt) ""))
  238.                    elt)
  239.              buffer-a-list))))
  240.        (setq buffers (cdr buffers)))
  241.      (reverse buffer-a-list))))
  242.  
  243. (defun x-mouse-switch-to-buffer (arg)
  244.   "Switch to a buffer selected via an X menu."
  245.   (eval-in-window
  246.       x-mouse-window
  247.     (switch-to-buffer 
  248.      (or (x-mouse-select-emacs-buffer x-mouse-pos nil "Switch to buffer:")
  249.      (current-buffer)))))
  250.  
  251. (defun x-mouse-switch-to-buffer-other-window (arg)
  252.   "Switch to a buffer selected via an X menu."
  253.   (eval-in-window
  254.       x-mouse-window
  255.     (switch-to-buffer-other-window 
  256.      (or (x-mouse-select-emacs-buffer
  257.       x-mouse-pos nil "Switch to buffer other window:")
  258.      (current-buffer)))))
  259.  
  260. (defvar *mouse-resizing* nil
  261.   "Non-nil if we are in the middle of a window resize.")
  262.  
  263. (defun x-mouse-resize-window-mouse-down (arg)
  264.   "Shrink/enlarge window by dragging the modeline.
  265. This function is bound to the desired mouse-down event."
  266.   (setq *mouse-drag-window* x-mouse-window
  267.     *mouse-drag-coordinates* arg
  268.     *mouse-resizing* t))
  269.  
  270. (defun x-mouse-resize-window-mouse-up (arg)
  271.   "Shrink/enlarge window by dragging the modeline.
  272. This function must bound to the desired mouse-up event in ALL mousemaps."
  273.   (eval-in-window x-mouse-window  
  274.     (if *mouse-resizing*
  275.     (let ((old-y (car (cdr *mouse-drag-coordinates*)))
  276.           (new-y (car (cdr arg)))
  277.           (old-y-top (car (cdr (window-edges *mouse-drag-window*))))
  278.           (new-y-top (car (cdr (window-edges x-mouse-window)))))
  279.       (select-window *mouse-drag-window*)
  280.       (if (> new-y old-y)
  281.           (enlarge-window (- (+ new-y new-y-top) (+ old-y old-y-top)))
  282.         (shrink-window (- (+ old-y old-y-top) (+ new-y new-y-top))))
  283.       (setq *mouse-resizing* nil)))))
  284.  
  285. (defun x-mouse-undo (arg)
  286.   "Invokes undo in the window mouse is in."
  287.   (eval-in-window x-mouse-window (undo)))
  288.  
  289. ;;; The move-to-window-line is used below because otherwise
  290. ;;; scrolling a non-selected process window with the mouse, after
  291. ;;; the process has written text past the bottom of the window,
  292. ;;; gives an "End of buffer" error, and then scrolls.  The
  293. ;;; move-to-window-line seems to force recomputing where things are.
  294.     
  295. (defun x-mouse-scroll-up (arg)
  296.   "Scroll the window whose modeline the mouse is in up a page."
  297.   (eval-in-window x-mouse-window (move-to-window-line 1) (scroll-up nil)))
  298.  
  299. (defun x-mouse-scroll-down (arg)
  300.   "Scroll the window whose modeline the mouse is in down a page."
  301.   (eval-in-window x-mouse-window (scroll-down nil)))
  302.  
  303. (defun x-mouse-scroll-proportional (arg)
  304.   "Scrolls the window the mouse is in proportionally,
  305. corresponding to window-relative X divided by window width."
  306.   (let ((x (car arg)))
  307.     (eval-in-window
  308.     x-mouse-window
  309.       (if (>= x (1- (window-width)))
  310.       ;; When x is maximum (equal to or 1 less than window width),
  311.       ;; goto end of buffer.  We check for this special case
  312.       ;; because the calculated goto-char often goes short of the
  313.       ;; end due to roundoff error, and we often really want to go
  314.       ;; to the end.
  315.       (goto-char (point-max))
  316.     (progn
  317.       (goto-char (+ (point-min)    ; For narrowed regions.
  318.             (* x (/ (- (point-max) (point-min))
  319.                 (1- (window-width))))))
  320.       (beginning-of-line)))
  321.       (what-cursor-position))))
  322.  
  323. (defun x-mouse-line-to-top (arg)
  324.   "Scrolls the line at the mouse cursor up to the top."
  325.   (eval-in-window x-mouse-window (scroll-up (car (cdr arg)))))
  326.  
  327. (defun x-mouse-top-to-line (arg)
  328.   "Scrolls the top line down to the mouse cursor."
  329.   (eval-in-window x-mouse-window (scroll-down (car (cdr arg)))))
  330.  
  331. (defun x-mouse-line-to-bottom (arg)
  332.   "Scrolls the line at the mouse cursor to the bottom."
  333.   (eval-in-window
  334.       x-mouse-window
  335.     (scroll-up (+ (car (cdr arg)) (- 2 (window-height))))))
  336.  
  337. (defun x-mouse-bottom-to-line (arg)
  338.   "Scrolls the bottom line up to the mouse cursor."
  339.   (eval-in-window
  340.       x-mouse-window
  341.     (scroll-down (+ (car (cdr arg)) (- 2 (window-height))))))
  342.  
  343. (defun x-mouse-line-to-middle (arg)
  344.   "Scrolls the line at the mouse cursor to the middle."
  345.   (eval-in-window
  346.       x-mouse-window
  347.     (scroll-up (- (car (cdr arg)) -1 (/ (window-height) 2)))))
  348.  
  349. (defun x-mouse-middle-to-line (arg)
  350.   "Scrolls the line at the middle to the mouse cursor."
  351.   (eval-in-window
  352.       x-mouse-window
  353.     (scroll-up (- (/ (window-height) 2) (car (cdr arg)) 1))))
  354.  
  355. (defun x-mouse-expand-horizontally (arg)
  356.   (eval-in-window x-mouse-window (enlarge-window 4 t)))
  357.  
  358. (defun x-mouse-expand-vertically (arg)
  359.   (eval-in-window x-mouse-window (enlarge-window 4)))
  360.  
  361. (defun x-mouse-select-previous-buffer (arg)
  362.   "Switch buffer in mouse window to most recently selected buffer."
  363.   (eval-in-window x-mouse-window (switch-to-buffer (other-buffer))))
  364.  
  365. (defun x-mouse-prev-complex-command (arg)
  366.   "Perform a previous-complex-command from a mouse click."
  367.   (if (eq (current-local-map) repeat-complex-command-map)
  368.       (previous-complex-command 1)
  369.     (error "Not in command history minibuffer.")))
  370.  
  371. (defun x-mouse-next-complex-command (arg)
  372.   "Perform a next-complex-command from a mouse click."  
  373.   (if (eq (current-local-map) repeat-complex-command-map)
  374.       (next-complex-command 1)
  375.     (error "Not in command history minibuffer.")))
  376.  
  377. (defun x-mouse-eval-expression (arg)
  378.   "Allow evaluation of an arbitrary Lisp Expression from a mouse click."
  379.   (call-interactively 'eval-expression))
  380.  
  381. (defun x-mouse-mini-move-point (arg)
  382.   ;; -6 is good for most common cases
  383.   (x-mouse-move-point (list (- (car arg) 6) 0)))
  384.  
  385. (defun x-mouse-mini-set-mark-and-stuff (arg)
  386.   ;; -6 is good for most common cases
  387.   (x-mouse-set-mark-and-stuff (list (- (car arg) 6) 0)))
  388.  
  389. ;;;           Global Mouse Bindings.
  390. ;;;
  391. ;;; There is some sense to this mouse binding madness:
  392. ;;; left and right scrolls are inverses.
  393. ;;; Shift makes an opposite meaning in the scroll bar.
  394. ;;; Meta makes the scrollbar functions work in the text region. [See below -- Russell]
  395. ;;; middle operates the mark
  396. ;;; left operates at point
  397.  
  398. ;;; Meta commands are generally non-destructive,
  399. ;;; Shift is a little more dangerous.
  400. ;;; Control is for the really complicated ones.
  401.  
  402. ;;; Control-Meta-Shift-right gives help on that region.
  403.  
  404. ;;; Text Region mousemap
  405.  
  406. ;;; The basics: Point, Mark, Menu, Cut:
  407. (global-set-mouse 'text x-button-left 'x-mouse-drag-move-point)
  408. (global-set-mouse 'text x-button-left-up 'x-mouse-drag-set-mark-stuff)
  409. (global-set-mouse 'text x-button-s-left 'x-mouse-exch-pt-and-mark)
  410. (global-set-mouse 'text x-button-middle 'x-mouse-set-mark-and-stuff)
  411. (global-set-mouse 'text x-button-s-right 'x-paste-text)
  412. (global-set-mouse 'text x-button-s-right-up ; See modeline map for explanation.
  413.           'x-mouse-resize-window-mouse-up)
  414. ;;; The Slymoblics multi-command for Save, Kill, Copy, Move:
  415. ;;; What is this supposed to do? We don't have a Symbolics. -- Russell
  416. (global-set-mouse 'text x-button-s-middle 'x-mouse-save/delete/yank)
  417. (global-set-mouse 'text x-button-s-middle-up 'x-mouse-save/delete/yank-no-op)
  418. ;;; Save, Kill, Copy, Move Things:
  419. ;;; Control-left combines with Control middle/right to produce copy/move
  420. (global-set-mouse 'text x-button-c-middle 'x-mouse-save-thing-there)
  421. (global-set-mouse 'text x-button-c-right 'x-mouse-kill-thing-there)
  422. (global-set-mouse 'text x-button-c-left 'x-mouse-yank-at-point)
  423. (global-set-mouse 'text x-button-c-s-left 'x-mouse-copy-thing)
  424. ; (global-set-mouse '(text control middle left)    'mouse-copy-thing)
  425. (global-set-mouse 'text x-button-c-s-middle 'x-mouse-move-thing)
  426. ; (global-set-mouse '(text control right left)    'mouse-move-thing)
  427. (global-set-mouse 'text x-button-c-s-right 'x-mouse-mark-thing)
  428. ; (global-set-mouse '(text control right middle)    'mouse-mark-thing)
  429. ;;; The Universal mouse help command (press all keys and right button):
  430. (global-set-mouse 'text x-button-c-m-s-right 'x-mouse-help-region)
  431. ;;; Meta in Text Region is like Meta version in scrollbar:
  432. ;;; Oh no it's not -- Russell, Not all the time anyway, in this world
  433. ;;; we still some key bindings for window manager operations...
  434. ;;; For now we'll make do with:
  435. ;;;     Meta-Shift-Left in text-map = mouse line to top of window
  436. ;;;     Meta-Shift-Right in text-map = mouse line to bottom of window.
  437. ;;; They're the ones I want the most.
  438. (global-set-mouse 'text x-button-m-s-left 'x-mouse-line-to-top)
  439. (global-set-mouse 'text x-button-m-s-right 'x-mouse-line-to-bottom)
  440. ; (global-set-mouse '(text meta shift  left)    'mouse-line-to-bottom)
  441. ; (global-set-mouse '(text meta double left)    'mouse-line-to-bottom)
  442. ; (global-set-mouse '(text meta         middle)    'mouse-line-to-middle)
  443. ; (global-set-mouse '(text meta shift   middle)    'mouse-middle-to-line)
  444. ; (global-set-mouse '(text meta double  middle)    'mouse-middle-to-line)
  445. ; (global-set-mouse '(text meta control middle)    'mouse-split-vertically)
  446. ; (global-set-mouse '(text meta        right)    'mouse-top-to-line)
  447. ; (global-set-mouse '(text meta shift  right)    'mouse-bottom-to-line)
  448. ; (global-set-mouse '(text meta double right)    'mouse-bottom-to-line)
  449. ;;; Miscellaneous:
  450. (global-set-mouse 'text x-button-c-m-left 'x-mouse-call-kbd-macro)
  451. (global-set-mouse 'text x-button-c-m-right 'x-mouse-undo)
  452.  
  453. ;;; Scrollbar mousemap.
  454.  
  455. (global-set-mouse 'scrollbar x-button-left 'x-mouse-line-to-top)
  456. (global-set-mouse 'scrollbar x-button-s-left 'x-mouse-line-to-bottom)
  457. (global-set-mouse 'scrollbar x-button-middle 'x-mouse-line-to-middle)
  458. (global-set-mouse 'scrollbar x-button-s-middle 'x-mouse-middle-to-line)
  459. (global-set-mouse 'scrollbar x-button-c-middle 'x-mouse-split-vertically)
  460. (global-set-mouse 'scrollbar x-button-right 'x-mouse-top-to-line)
  461. (global-set-mouse 'scrollbar x-button-s-right 'x-mouse-bottom-to-line)
  462. (global-set-mouse 'scrollbar x-button-s-right-up ; See below 
  463.           'x-mouse-resize-window-mouse-up)
  464. (global-set-mouse 'scrollbar x-button-m-left 'x-mouse-line-to-top)
  465. (global-set-mouse 'scrollbar x-button-m-s-left 'x-mouse-line-to-bottom)
  466. (global-set-mouse 'scrollbar x-button-m-middle 'x-mouse-line-to-middle)
  467. (global-set-mouse 'scrollbar x-button-m-s-middle 'x-mouse-middle-to-line)
  468. (global-set-mouse 'scrollbar x-button-c-m-middle 'x-mouse-split-vertically)
  469. (global-set-mouse 'scrollbar x-button-m-right 'x-mouse-top-to-line)
  470. (global-set-mouse 'scrollbar x-button-m-s-right 'x-mouse-bottom-to-line)
  471. ;;; And the help menu:
  472. (global-set-mouse 'scrollbar x-button-c-m-s-right 'x-mouse-help-region)
  473.  
  474. ;;; Modeline mousemap.
  475.  
  476. (global-set-mouse 'modeline x-button-left 'x-mouse-scroll-up)
  477. (global-set-mouse 'modeline x-button-middle 'x-mouse-scroll-proportional)
  478. (global-set-mouse 'modeline x-button-right 'x-mouse-scroll-down)
  479. ;;; Shift-right starts enlarge/shrink, shift-right-up ends it.
  480. (global-set-mouse 'modeline x-button-s-right 'x-mouse-resize-window-mouse-down)
  481. (global-set-mouse 'modeline x-button-s-right-up
  482.           ;; This needs to go on every shift-right-up event since it is
  483.           ;; unlikely that the user will drag a window onto another
  484.           ;; window's modeline.
  485.           'x-mouse-resize-window-mouse-up) 
  486. ;;; Control-left selects this window, Control-right deletes it.
  487. (global-set-mouse 'modeline x-button-c-left 'x-mouse-delete-other-windows)
  488. (global-set-mouse 'modeline x-button-c-middle 'x-mouse-split-horizontally)
  489. (global-set-mouse 'modeline x-button-c-right 'x-mouse-delete-window)
  490. ;;; Shift-left lists buffers and switch-to-buffer-other-window's the selection.
  491. (global-set-mouse 'modeline x-button-s-left 'x-mouse-switch-to-buffer-other-window)
  492. ;;; Meta-Shift-left lists buffers and switch-to-buffer's the selection.
  493. (global-set-mouse 'modeline x-button-m-s-left 'x-mouse-switch-to-buffer)
  494. ;;; And the help menu:
  495. (global-set-mouse 'modeline x-button-c-m-s-right 'x-mouse-help-region)
  496.  
  497. ;;; Minibuffer Mousemap
  498.  
  499. (global-set-mouse 'minibuffer x-button-left 'x-mouse-prev-complex-command)
  500. (global-set-mouse 'minibuffer x-button-middle 'x-mouse-eval-expression)
  501. (global-set-mouse 'minibuffer x-button-right 'x-mouse-next-complex-command)
  502. (global-set-mouse 'minibuffer x-button-s-right-up ; See above...
  503.           'x-mouse-resize-window-mouse-up)
  504. (global-set-mouse 'minibuffer x-button-c-m-s-right 'x-mouse-help-region)
  505.