Lines Matching +refs:mouse +refs:left
0 ;;; mouse.el --- window system-independent mouse support
7 ;; Keywords: hardware, mouse
29 ;; system access) through the mouse. All this code assumes that mouse
38 ;;; Indent track-mouse like progn.
39 (put 'track-mouse 'lisp-indent-function 0)
41 (defcustom mouse-yank-at-point nil
42 "*If non-nil, mouse yank commands yank at point instead of at click."
44 :group 'mouse)
46 (defcustom mouse-drag-copy-region t
47 "*If non-nil, mouse drag copies region to kill-ring."
50 :group 'mouse)
52 (defcustom mouse-1-click-follows-link 450
59 typically sets point where you click the mouse).
62 releasing the mouse button determines whether to follow the link
73 Note that dragging the mouse never follows the link.
77 packages. See `mouse-on-link-p' for details."
83 :group 'mouse)
85 (defcustom mouse-1-click-in-non-selected-windows t
89 the normal mouse-1 binding, typically selects the window and sets
93 :group 'mouse)
98 ;; Provide a mode-specific menu on a mouse button.
105 the current mouse position.
116 (let ((mp (mouse-pixel-position)))
125 ;; mouse-major-mode-menu was using a weird:
131 (let ((mouse-click (apply 'vector event))
134 (setq binding (lookup-key (car map) mouse-click))
152 ;; mouse-major-mode-menu was using `command-execute' instead.
155 (defvar mouse-major-mode-menu-prefix) ; dynamically bound
157 (defun mouse-major-mode-menu (event &optional prefix)
158 "Pop up a mode-specific menu of mouse commands.
165 (let* (;; This is where mouse-major-mode-menu-prefix
168 (mouse-major-mode-menu-prefix nil)
170 (ancestor (mouse-major-mode-menu-1
186 ;;;(defun mouse-major-mode-menu-compute-equiv-keys (menu)
197 ;;; (mouse-major-mode-menu-compute-equiv-keys tail))))
204 (defun mouse-major-mode-menu-1 (menubar)
216 (setq mouse-major-mode-menu-prefix (list (car submap)))
219 (defun mouse-popup-menubar (event prefix)
269 (defun mouse-popup-menubar-stuff (event prefix)
270 "Popup a menu like either `mouse-major-mode-menu' or `mouse-popup-menubar'.
274 (mouse-popup-menubar event prefix)
275 (mouse-major-mode-menu event prefix)))
280 (defun mouse-minibuffer-check (event)
286 (run-hooks 'mouse-leave-buffer-hook))
288 (defun mouse-delete-window (click)
291 This command must be bound to a mouse click."
294 (mouse-minibuffer-check click)
297 (defun mouse-select-window (click)
300 (mouse-minibuffer-check click)
307 (set-mouse-position (selected-frame) (1- (frame-width)) 0))))
309 (defun mouse-tear-off-window (click)
312 (mouse-minibuffer-check click)
320 (defun mouse-delete-other-windows ()
325 (defun mouse-split-window-vertically (click)
326 "Select Emacs window mouse is on, then split it vertically in half.
328 This command must be bound to a mouse click."
330 (mouse-minibuffer-check click)
341 (defun mouse-split-window-horizontally (click)
342 "Select Emacs window mouse is on, then split it horizontally in half.
344 This command must be bound to a mouse click."
346 (mouse-minibuffer-check click)
357 (defun mouse-drag-window-above (window)
361 (start-left (nth 0 (window-edges window)))
367 (let ((left (nth 0 (window-edges window)))
371 (or (and (<= left start-left) (<= start-right right))
372 (and (<= start-left left) (<= left start-right))
373 (and (<= start-left right) (<= right start-right))))
378 (defun mouse-drag-move-window-bottom (window growth)
387 (defsubst mouse-drag-move-window-top (window growth)
394 (let ((window-above (mouse-drag-window-above window)))
396 (mouse-drag-move-window-bottom window-above (- growth)))))
398 (defun mouse-drag-mode-line-1 (start-event mode-line-p)
400 START-EVENT is the starting mouse-event of the drag action.
403 (run-hooks 'mouse-leave-buffer-hook)
411 should-enlarge-minibuffer event mouse y top bot edges wconfig growth)
412 (track-mouse
424 ;; the mouse.
427 mouse (mouse-position))
431 ;; - the mouse isn't in the frame that we started in
432 ;; - the mouse isn't in any Emacs frame
434 ;; - there is a mouse-movement event
436 ;; (same as mouse movement for our purposes)
446 ((not (memq (car event) '(mouse-movement scroll-bar-movement)))
451 ((not (eq (car mouse) start-event-frame))
454 ((null (car (cdr mouse)))
458 (setq y (cdr (cdr mouse))
482 (mouse-drag-move-window-bottom start-event-window growth))
486 (mouse-drag-move-window-bottom start-event-window growth)
487 (mouse-drag-move-window-top start-event-window growth)))
506 (defun mouse-drag-mode-line (start-event)
509 (mouse-drag-mode-line-1 start-event t))
511 (defun mouse-drag-header-line (start-event)
526 (mouse-drag-mode-line-1 start-event nil))))
530 (defun mouse-drag-vertical-line-rightward-window (window)
533 (left (nth 0 (window-inside-edges window)))
542 (< try-right left)
548 (defun mouse-drag-vertical-line (start-event)
552 (run-hooks 'mouse-leave-buffer-hook)
557 event mouse x left right edges growth
568 ((and (eq which-side 'left)
571 (track-mouse
574 ;; the mouse.
577 mouse (mouse-position))
580 ;; - the mouse isn't in the frame that we started in
581 ;; - the mouse isn't in any Emacs frame
583 ;; - there is a mouse-movement event
585 ;; (same as mouse movement for our purposes)
594 '(mouse-movement scroll-bar-movement)))
599 ((not (eq (car mouse) start-event-frame))
601 ((null (car (cdr mouse)))
605 ;; If the scroll bar is on the window's left,
606 ;; adjust the window on the left.
609 (mouse-drag-vertical-line-rightward-window
611 (setq x (- (car (cdr mouse))
614 left (nth 0 edges)
618 (if (< (- x left -1) window-min-width)
619 (setq x (+ left window-min-width -1)))
627 (defun mouse-set-point (event)
628 "Move point to the position clicked on with the mouse.
629 This should be bound to a mouse click event type."
631 (mouse-minibuffer-check event)
632 ;; Use event-end in case called from mouse-drag-region.
636 (defvar mouse-last-region-beg nil)
637 (defvar mouse-last-region-end nil)
638 (defvar mouse-last-region-tick nil)
640 (defun mouse-region-match ()
641 "Return non-nil if there's an active region that was set with the mouse."
643 (eq mouse-last-region-beg (region-beginning))
644 (eq mouse-last-region-end (region-end))
645 (eq mouse-last-region-tick (buffer-modified-tick))))
647 (defun mouse-set-region (click)
649 This should be bound to a mouse drag event."
651 (mouse-minibuffer-check click)
669 (when mouse-drag-copy-region
672 (mouse-set-region-1)))
674 (defun mouse-set-region-1 ()
678 (setq mouse-last-region-beg (region-beginning))
679 (setq mouse-last-region-end (region-end))
680 (setq mouse-last-region-tick (buffer-modified-tick)))
682 (defcustom mouse-scroll-delay 0.25
683 "*The pause between scroll steps caused by mouse drags, in seconds.
684 If you drag the mouse beyond the edge of a window, Emacs scrolls the
687 the mouse back into the window, or release the button.
691 :group 'mouse)
693 (defcustom mouse-scroll-min-lines 1
694 "*The minimum number of lines scrolled by dragging mouse out of window.
695 Moving the mouse out the top or bottom edge of the window begins
698 the mouse has moved. However, it always scrolls at least the number
701 :group 'mouse)
703 (defun mouse-scroll-subr (window jump &optional overlay start)
709 ((and (> jump 0) (< jump mouse-scroll-min-lines))
710 (setq jump mouse-scroll-min-lines))
711 ((and (< jump 0) (< (- jump) mouse-scroll-min-lines))
712 (setq jump (- mouse-scroll-min-lines))))
735 (sit-for mouse-scroll-delay)))))
740 (defconst mouse-drag-overlay
746 (defvar mouse-selection-click-count 0)
748 (defvar mouse-selection-click-count-buffer nil)
750 (defun mouse-drag-region (start-event)
751 "Set the region to the text that the mouse is dragged over.
752 Highlight the drag area as you move the mouse.
753 This must be bound to a button-down mouse event.
769 (run-hooks 'mouse-leave-buffer-hook)
770 (mouse-drag-track start-event t))))
773 (defun mouse-posn-property (pos property)
791 (defun mouse-on-link-p (pos)
793 POS must be a buffer position in the current buffer or a mouse
795 However, if `mouse-1-click-in-non-selected-windows' is non-nil,
796 POS may be a mouse event location in any window.
809 - If the value is `mouse-face', POS is inside a link if there
810 is a non-nil `mouse-face' property at POS. Return t in this case.
814 from that call. Arg is \(posn-point POS) if POS is a mouse event.
820 - If it is a string, the mouse-1 event is translated into the
821 first character of the string, i.e. the action of the mouse-1
824 - If it is a vector, the mouse-1 event is translated into the
825 first element of that vector, i.e. the action of the mouse-1
828 - Otherwise, the mouse-1 event is translated into a mouse-2 event
832 mouse-1-click-in-non-selected-windows
834 (or (mouse-posn-property pos 'follow-link)
837 ((eq action 'mouse-face)
838 (and (mouse-posn-property pos 'mouse-face) t))
848 (defun mouse-fixup-help-message (msg)
849 "Fix help message MSG for `mouse-1-click-follows-link'."
851 (if (and mouse-1-click-follows-link
854 (string-match "^mouse-2" msg))
855 (setq mp (mouse-pixel-position))
862 (if (mouse-on-link-p pos)
865 ((eq mouse-1-click-follows-link 'double) "double-")
866 ((and (integerp mouse-1-click-follows-link)
867 (< mouse-1-click-follows-link 0)) "Long ")
869 "mouse-1" (substring msg 7)))))))
872 (defun mouse-move-drag-overlay (ol start end mode)
878 ;; only applied on entry to mouse-drag-region, which had the problem
884 (let ((range (mouse-start-end start end mode)))
887 (defun mouse-drag-track (start-event &optional
888 do-mouse-drag-region-post-process)
889 "Track mouse drags by highlighting area between point and cursor.
892 should only be used by mouse-drag-region."
893 (mouse-minibuffer-check start-event)
894 (setq mouse-selection-click-count-buffer (current-buffer))
899 (_ (mouse-set-point start-event))
913 (on-link (and mouse-1-click-follows-link
914 (or mouse-1-click-in-non-selected-windows
919 (mouse-on-link-p start-posn)))
922 (eq mouse-1-click-follows-link 'double)
928 (setq mouse-selection-click-count click-count)
934 (if remap-double-click ;; Don't expand mouse overlay in links
936 (mouse-move-drag-overlay mouse-drag-overlay start-point start-point
938 (overlay-put mouse-drag-overlay 'window start-window)
941 (track-mouse
944 (or (mouse-movement-p event)
950 ;; mouse, go ahead and hscroll.
962 (mouse-move-drag-overlay mouse-drag-overlay start-point end-point click-count))
965 (let ((mouse-row (cdr (cdr (mouse-position)))))
967 ((null mouse-row))
968 ((< mouse-row top)
969 (mouse-scroll-subr start-window (- mouse-row top)
970 mouse-drag-overlay start-point))
971 ((>= mouse-row bottom)
972 (mouse-scroll-subr start-window (1+ (- mouse-row bottom))
973 mouse-drag-overlay start-point)))))))))
975 ;; In case we did not get a mouse-motion event
976 ;; for the final move of the mouse before a drag event
983 (mouse-move-drag-overlay mouse-drag-overlay start-point end-point click-count))
991 '(mouse-set-point
992 mouse-set-region))))))
994 (if (and (not (= (overlay-start mouse-drag-overlay)
995 (overlay-end mouse-drag-overlay)))
1005 (overlay-start mouse-drag-overlay)
1006 (overlay-end mouse-drag-overlay)))
1010 (- (+ (overlay-end mouse-drag-overlay)
1011 (overlay-start mouse-drag-overlay))
1016 (if (not do-mouse-drag-region-post-process)
1018 (delete-overlay mouse-drag-overlay)
1020 (when mouse-drag-copy-region
1024 (mouse-show-mark)
1025 ;; mouse-show-mark can call read-event,
1031 (mouse-set-region-1)))))
1033 ;; If a multiple click is not bound to mouse-set-point,
1034 ;; cancel the effects of mouse-move-drag-overlay to
1037 (delete-overlay mouse-drag-overlay)
1042 ;; the mouse-set-point for the down-mouse
1045 ;; up-mouse event will contain a different
1056 (not (eq mouse-1-click-follows-link 'double))
1059 (or (not (integerp mouse-1-click-follows-link))
1063 (if (> mouse-1-click-follows-link 0)
1064 (<= (- t1 t0) mouse-1-click-follows-link)
1065 (< (- t0 t1) mouse-1-click-follows-link))))))))
1066 ;; If we rebind to mouse-2, reselect previous selected window,
1067 ;; so that the mouse-2 event runs in the same
1073 (setcar event 'mouse-2)
1074 ;; If this mouse click has never been done by
1077 (put 'mouse-2 'event-kind 'mouse-click)))
1082 (delete-overlay mouse-drag-overlay)))))
1086 (defun mouse-skip-word (dir)
1117 (defun mouse-start-end (start end mode)
1176 (mouse-skip-word -1)
1180 (mouse-skip-word 1)
1195 (defun mouse-set-mark-fast (click)
1196 (mouse-minibuffer-check click)
1202 (defun mouse-undouble-last-event (events)
1225 (defcustom mouse-region-delete-keys '([delete] [deletechar] [backspace])
1226 "List of keys that should cause the mouse region to be deleted."
1227 :group 'mouse
1230 (defun mouse-show-mark ()
1241 (throw 'mouse-show-mark t))))
1243 (delete-overlay mouse-drag-overlay)
1244 (move-overlay mouse-drag-overlay (point) (mark t)))
1245 (catch 'mouse-show-mark
1259 (not (mouse-undouble-last-event events))
1260 (not (member key mouse-region-delete-keys)))))
1274 (if (member key mouse-region-delete-keys)
1291 (delete-overlay mouse-drag-overlay))))
1293 (defun mouse-set-mark (click)
1294 "Set mark at the position clicked on with the mouse.
1296 This must be bound to a mouse click."
1298 (mouse-minibuffer-check click)
1303 (progn (mouse-set-point click)
1309 (defun mouse-kill (click)
1310 "Kill the region between point and the mouse click.
1313 (mouse-minibuffer-check click)
1321 (defun mouse-yank-at-click (click arg)
1326 If `mouse-yank-at-point' is non-nil, insert at point
1330 (run-hooks 'mouse-leave-buffer-hook)
1331 (or mouse-yank-at-point (mouse-set-point click))
1333 (setq mouse-selection-click-count 0)
1336 (defun mouse-kill-ring-save (click)
1337 "Copy the region between point and the mouse click in the kill ring.
1340 (mouse-set-mark-fast click)
1343 (mouse-show-mark))
1345 ;;; This function used to delete the text between point and the mouse
1350 ;;; invocation of mouse-save-then-kill.
1351 (defvar mouse-save-then-kill-posn nil)
1353 (defun mouse-save-then-kill-delete-region (beg end)
1375 (error "Lossage in mouse-save-then-kill-delete-region"))
1387 (defun mouse-save-then-kill (click)
1389 If the text between point and the mouse is the same as what's
1402 (mouse-minibuffer-check click)
1409 (and (mark t) (> (mod mouse-selection-click-count 3) 0)
1411 (eq mouse-selection-click-count-buffer
1413 (if (not (and (eq last-command 'mouse-save-then-kill)
1415 (car (cdr-safe (cdr-safe mouse-save-then-kill-posn))))))
1418 (mouse-start-end click-posn click-posn
1419 mouse-selection-click-count)))
1430 (mouse-set-region-1)
1431 ;; Arrange for a repeated mouse-3 to kill this region.
1432 (setq mouse-save-then-kill-posn
1434 (mouse-show-mark))
1437 (mouse-save-then-kill-delete-region (mark) (point))
1438 (setq mouse-selection-click-count 0)
1439 (setq mouse-save-then-kill-posn nil))
1440 (if (and (eq last-command 'mouse-save-then-kill)
1441 mouse-save-then-kill-posn
1442 (eq (car mouse-save-then-kill-posn) (car kill-ring))
1443 (equal (cdr mouse-save-then-kill-posn) (list (point) click-posn)))
1445 ;; mouse-save-then-kill, delete the text from the buffer.
1447 (mouse-save-then-kill-delete-region (point) (mark))
1449 (setq mouse-save-then-kill-posn nil))
1452 (if (or (and (eq last-command 'mouse-save-then-kill)
1453 mouse-save-then-kill-posn)
1456 '(mouse-drag-region mouse-set-region))
1473 (mouse-set-mark-fast click)
1478 (mouse-show-mark)
1479 (mouse-set-region-1)
1480 (setq mouse-save-then-kill-posn
1484 (global-set-key [M-mouse-1] 'mouse-start-secondary)
1485 (global-set-key [M-drag-mouse-1] 'mouse-set-secondary)
1486 (global-set-key [M-down-mouse-1] 'mouse-drag-secondary)
1487 (global-set-key [M-mouse-3] 'mouse-secondary-save-then-kill)
1488 (global-set-key [M-mouse-2] 'mouse-yank-secondary)
1490 (defconst mouse-secondary-overlay
1498 (defvar mouse-secondary-click-count 0)
1502 (defvar mouse-secondary-start nil)
1504 (defun mouse-start-secondary (click)
1506 Use \\[mouse-secondary-save-then-kill] to set the other end
1509 (mouse-minibuffer-check click)
1513 (delete-overlay mouse-secondary-overlay)
1516 (or mouse-secondary-start
1517 (setq mouse-secondary-start (make-marker)))
1518 (move-marker mouse-secondary-start (posn-point posn)))))))
1520 (defun mouse-set-secondary (click)
1521 "Set the secondary selection to the text that the mouse is dragged over.
1522 This must be bound to a mouse drag event."
1524 (mouse-minibuffer-check click)
1531 (move-overlay mouse-secondary-overlay beg (posn-point end))
1534 (buffer-substring (overlay-start mouse-secondary-overlay)
1535 (overlay-end mouse-secondary-overlay))))))
1537 (defun mouse-drag-secondary (start-event)
1538 "Set the secondary selection to the text that the mouse is dragged over.
1539 Highlight the drag area as you move the mouse.
1540 This must be bound to a button-down mouse event.
1543 (mouse-minibuffer-check start-event)
1556 (setq mouse-secondary-click-count click-count)
1560 (let ((range (mouse-start-end start-point start-point click-count)))
1561 (set-marker mouse-secondary-start nil)
1563 ;; (move-overlay mouse-secondary-overlay 1 1
1565 (move-overlay mouse-secondary-overlay (car range) (nth 1 range)
1568 (or mouse-secondary-start
1569 (setq mouse-secondary-start (make-marker)))
1570 (set-marker mouse-secondary-start start-point)
1571 (delete-overlay mouse-secondary-overlay))
1573 (track-mouse
1576 (or (mouse-movement-p event)
1587 (let ((range (mouse-start-end start-point end-point
1590 (null (marker-position mouse-secondary-start)))
1592 (set-marker mouse-secondary-start nil)
1593 (move-overlay mouse-secondary-overlay
1596 (let ((mouse-row (cdr (cdr (mouse-position)))))
1598 ((null mouse-row))
1599 ((< mouse-row top)
1600 (mouse-scroll-subr start-window (- mouse-row top)
1601 mouse-secondary-overlay start-point))
1602 ((>= mouse-row bottom)
1603 (mouse-scroll-subr start-window (1+ (- mouse-row bottom))
1604 mouse-secondary-overlay start-point)))))))))
1607 (if (marker-position mouse-secondary-start)
1609 (delete-overlay mouse-secondary-overlay)
1613 (goto-char mouse-secondary-start)
1618 (buffer-substring (overlay-start mouse-secondary-overlay)
1619 (overlay-end mouse-secondary-overlay)))))))))
1621 (defun mouse-yank-secondary (click)
1624 If `mouse-yank-at-point' is non-nil, insert at point
1628 (run-hooks 'mouse-leave-buffer-hook)
1629 (or mouse-yank-at-point (mouse-set-point click))
1632 (defun mouse-kill-secondary ()
1634 This is intended more as a keyboard command than as a mouse command
1643 (or (eq (overlay-buffer mouse-secondary-overlay)
1649 (with-current-buffer (overlay-buffer mouse-secondary-overlay)
1650 (kill-region (overlay-start mouse-secondary-overlay)
1651 (overlay-end mouse-secondary-overlay))))
1652 (delete-overlay mouse-secondary-overlay)
1656 (defun mouse-secondary-save-then-kill (click)
1658 You must use this in a buffer where you have recently done \\[mouse-start-secondary].
1659 If the text between where you did \\[mouse-start-secondary] and where
1670 (mouse-minibuffer-check click)
1677 (or (overlay-buffer mouse-secondary-overlay)
1678 (if mouse-secondary-start
1679 (marker-buffer mouse-secondary-start))))
1682 (if (> (mod mouse-secondary-click-count 3) 0)
1683 (if (not (and (eq last-command 'mouse-secondary-save-then-kill)
1685 (car (cdr-safe (cdr-safe mouse-save-then-kill-posn))))))
1688 (mouse-start-end click-posn click-posn
1689 mouse-secondary-click-count)))
1692 (if (< (abs (- click-posn (overlay-start mouse-secondary-overlay)))
1693 (abs (- click-posn (overlay-end mouse-secondary-overlay))))
1694 (move-overlay mouse-secondary-overlay (car range)
1695 (overlay-end mouse-secondary-overlay))
1696 (move-overlay mouse-secondary-overlay
1697 (overlay-start mouse-secondary-overlay)
1703 (overlay-start mouse-secondary-overlay)
1704 (overlay-end mouse-secondary-overlay)) t)
1705 ;; Arrange for a repeated mouse-3 to kill this region.
1706 (setq mouse-save-then-kill-posn
1711 (mouse-save-then-kill-delete-region
1712 (overlay-start mouse-secondary-overlay)
1713 (overlay-end mouse-secondary-overlay))
1714 (setq mouse-save-then-kill-posn nil)
1715 (setq mouse-secondary-click-count 0)
1716 (delete-overlay mouse-secondary-overlay)))
1717 (if (and (eq last-command 'mouse-secondary-save-then-kill)
1718 mouse-save-then-kill-posn
1719 (eq (car mouse-save-then-kill-posn) (car kill-ring))
1720 (equal (cdr mouse-save-then-kill-posn) (list (point) click-posn)))
1722 ;; mouse-secondary-save-then-kill, delete the text from the buffer.
1724 (mouse-save-then-kill-delete-region
1725 (overlay-start mouse-secondary-overlay)
1726 (overlay-end mouse-secondary-overlay))
1727 (setq mouse-save-then-kill-posn nil)
1728 (delete-overlay mouse-secondary-overlay))
1729 (if (overlay-start mouse-secondary-overlay)
1736 (if (< (abs (- click-posn (overlay-start mouse-secondary-overlay)))
1737 (abs (- click-posn (overlay-end mouse-secondary-overlay))))
1738 (move-overlay mouse-secondary-overlay click-posn
1739 (overlay-end mouse-secondary-overlay))
1740 (move-overlay mouse-secondary-overlay
1741 (overlay-start mouse-secondary-overlay)
1744 (if (eq last-command 'mouse-secondary-save-then-kill)
1750 (overlay-start mouse-secondary-overlay)
1751 (overlay-end mouse-secondary-overlay)) t)
1753 (copy-region-as-kill (overlay-start mouse-secondary-overlay)
1754 (overlay-end mouse-secondary-overlay)))))
1755 (if mouse-secondary-start
1758 (let ((start (+ 0 mouse-secondary-start)))
1760 (move-overlay mouse-secondary-overlay start click-posn))))
1761 (setq mouse-save-then-kill-posn
1763 (if (overlay-buffer mouse-secondary-overlay)
1766 (overlay-start mouse-secondary-overlay)
1767 (overlay-end mouse-secondary-overlay)))))))
1770 (defcustom mouse-buffer-menu-maxlen 20
1773 `mouse-buffer-menu-maxlen' and make a pane (or submenu) for each one."
1775 :group 'mouse)
1777 (defcustom mouse-buffer-menu-mode-mult 4
1778 "*Group the buffers by the major mode groups on \\[mouse-buffer-menu]?
1779 This number which determines (in a hairy way) whether \\[mouse-buffer-menu]
1781 `mouse-buffer-menu-mode-groups') or just by menu length.
1785 :group 'mouse
1788 (defvar mouse-buffer-menu-mode-groups
1799 "How to group various major modes together in \\[mouse-buffer-menu].
1803 (defun mouse-buffer-menu (event)
1804 "Pop up a menu of buffers for selection with the mouse.
1808 (mouse-minibuffer-check event)
1817 (let ((tail mouse-buffer-menu-mode-groups))
1840 (if (< (* sum-of-squares mouse-buffer-menu-mode-mult)
1843 (let (subdivided-menus (buffers-left (length buffers)))
1854 (> (* buffers-left 10) (length buffers))))
1855 (let ((this-mode-list (mouse-buffer-menu-alist
1863 (setq buffers-left
1864 (- buffers-left (length (cdr (car split-by-major-mode)))))
1866 ;; If any major modes are left over,
1870 (mouse-buffer-menu-alist
1880 (setq alist (mouse-buffer-menu-alist buffers))
1882 (mouse-buffer-menu-split "Select Buffer" alist)))))
1891 (defun mouse-buffer-menu-alist (buffers)
1933 (defun mouse-buffer-menu-split (title alist)
1936 (if (> (length alist) (/ (* mouse-buffer-menu-maxlen 3) 2))
1940 ;; Pull off the next mouse-buffer-menu-maxlen buffers
1942 (setq next (nthcdr mouse-buffer-menu-maxlen alist))
1944 (setcdr (nthcdr (1- mouse-buffer-menu-maxlen) alist)
1959 ;;;!! (defun mouse-scroll-down (click)
1961 ;;;!! (scroll-down (1+ (cdr (mouse-coords click)))))
1963 ;;;!! (defun mouse-scroll-up (click)
1965 ;;;!! (scroll-up (1+ (cdr (mouse-coords click)))))
1967 ;;;!! (defun mouse-scroll-down-full ()
1971 ;;;!! (defun mouse-scroll-up-full ()
1975 ;;;!! (defun mouse-scroll-move-cursor (click)
1977 ;;;!! (move-to-window-line (1+ (cdr (mouse-coords click)))))
1979 ;;;!! (defun mouse-scroll-absolute (event)
1993 ;;;!! (defun mouse-scroll-left (click)
1995 ;;;!! (scroll-left (1+ (car (mouse-coords click)))))
1997 ;;;!! (defun mouse-scroll-right (click)
1999 ;;;!! (scroll-right (1+ (car (mouse-coords click)))))
2001 ;;;!! (defun mouse-scroll-left-full ()
2003 ;;;!! (scroll-left nil))
2005 ;;;!! (defun mouse-scroll-right-full ()
2009 ;;;!! (defun mouse-scroll-move-cursor-horizontally (click)
2011 ;;;!! (move-to-column (1+ (car (mouse-coords click)))))
2013 ;;;!! (defun mouse-scroll-absolute-horizontally (event)
2020 ;;;!! (global-set-key [scroll-bar mouse-1] 'mouse-scroll-up)
2021 ;;;!! (global-set-key [scroll-bar mouse-2] 'mouse-scroll-absolute)
2022 ;;;!! (global-set-key [scroll-bar mouse-3] 'mouse-scroll-down)
2024 ;;;!! (global-set-key [vertical-slider mouse-1] 'mouse-scroll-move-cursor)
2025 ;;;!! (global-set-key [vertical-slider mouse-2] 'mouse-scroll-move-cursor)
2026 ;;;!! (global-set-key [vertical-slider mouse-3] 'mouse-scroll-move-cursor)
2028 ;;;!! (global-set-key [thumbup mouse-1] 'mouse-scroll-up-full)
2029 ;;;!! (global-set-key [thumbup mouse-2] 'mouse-scroll-up-full)
2030 ;;;!! (global-set-key [thumbup mouse-3] 'mouse-scroll-up-full)
2032 ;;;!! (global-set-key [thumbdown mouse-1] 'mouse-scroll-down-full)
2033 ;;;!! (global-set-key [thumbdown mouse-2] 'mouse-scroll-down-full)
2034 ;;;!! (global-set-key [thumbdown mouse-3] 'mouse-scroll-down-full)
2036 ;;;!! (global-set-key [horizontal-scroll-bar mouse-1] 'mouse-scroll-left)
2037 ;;;!! (global-set-key [horizontal-scroll-bar mouse-2]
2038 ;;;!! 'mouse-scroll-absolute-horizontally)
2039 ;;;!! (global-set-key [horizontal-scroll-bar mouse-3] 'mouse-scroll-right)
2041 ;;;!! (global-set-key [horizontal-slider mouse-1]
2042 ;;;!! 'mouse-scroll-move-cursor-horizontally)
2043 ;;;!! (global-set-key [horizontal-slider mouse-2]
2044 ;;;!! 'mouse-scroll-move-cursor-horizontally)
2045 ;;;!! (global-set-key [horizontal-slider mouse-3]
2046 ;;;!! 'mouse-scroll-move-cursor-horizontally)
2048 ;;;!! (global-set-key [thumbleft mouse-1] 'mouse-scroll-left-full)
2049 ;;;!! (global-set-key [thumbleft mouse-2] 'mouse-scroll-left-full)
2050 ;;;!! (global-set-key [thumbleft mouse-3] 'mouse-scroll-left-full)
2052 ;;;!! (global-set-key [thumbright mouse-1] 'mouse-scroll-right-full)
2053 ;;;!! (global-set-key [thumbright mouse-2] 'mouse-scroll-right-full)
2054 ;;;!! (global-set-key [thumbright mouse-3] 'mouse-scroll-right-full)
2056 ;;;!! (global-set-key [horizontal-scroll-bar S-mouse-2]
2057 ;;;!! 'mouse-split-window-horizontally)
2058 ;;;!! (global-set-key [mode-line S-mouse-2]
2059 ;;;!! 'mouse-split-window-horizontally)
2060 ;;;!! (global-set-key [vertical-scroll-bar S-mouse-2]
2061 ;;;!! 'mouse-split-window)
2070 ;;;!! ;;;; Dynamically track mouse coordinates
2073 ;;;!! ;;(defun track-mouse (event)
2074 ;;;!! ;; "Track the coordinates, absolute and relative, of the mouse."
2076 ;;;!! ;; (while mouse-grabbed
2077 ;;;!! ;; (let* ((pos (read-mouse-position (selected-screen)))
2084 ;;;!! ;; (message "mouse: [%d %d], (%d %d)" abs-x abs-y
2087 ;;;!! ;; (message "mouse: [%d %d]" abs-x abs-y)))))
2095 ;;;!! ;;(defun mouse-select-buffer-line (event)
2120 ;;;!! ;;(defun mouse-boxing (event)
2124 ;;;!! ;; (while (= (x-mouse-events) 0)
2125 ;;;!! ;; (let* ((pos (read-mouse-position screen))
2154 ;;;!! ;;(defun mouse-erase-box ()
2162 ;;;!! ;;; (use-local-mouse-map (setq rectangle-test-map (make-sparse-keymap)))
2163 ;;;!! ;;; (define-key rectangle-test-map mouse-motion-button-left 'mouse-boxing)
2164 ;;;!! ;;; (define-key rectangle-test-map mouse-button-left-up 'mouse-erase-box))
2193 ;;;!! ;;; (use-local-mouse-map (setq doubleclick-test-map (make-sparse-keymap)))
2194 ;;;!! ;;; (define-key doubleclick-test-map mouse-button-left 'double-down)
2195 ;;;!! ;;; (define-key doubleclick-test-map mouse-button-left-up 'double-up))
2215 ;;;!! (while (= (x-mouse-events) 0)
2227 ;;;!! ;;; (let ((scrolling-map (function mouse-vertical-scroll-bar-prefix)))
2228 ;;;!! ;;; (define-key scrolling-map mouse-button-left 'incr-scroll-down)
2229 ;;;!! ;;; (define-key scrolling-map mouse-button-right 'incr-scroll-up)
2230 ;;;!! ;;; (define-key scrolling-map mouse-button-left-up 'incr-scroll-stop)
2231 ;;;!! ;;; (define-key scrolling-map mouse-button-right-up 'incr-scroll-stop)))
2237 ;;;!! (defun mouse-kill-rectangle (event)
2238 ;;;!! "Kill the rectangle between point and the mouse cursor."
2242 ;;;!! (mouse-set-point event)
2248 ;;;!! (defun mouse-open-rectangle (event)
2249 ;;;!! "Kill the rectangle between point and the mouse cursor."
2253 ;;;!! (mouse-set-point event)
2261 ;;;!! (defun mouse-multiple-insert (n char)
2268 ;;;!! (defun mouse-move-text (event)
2278 ;;;!! (mouse-multiple-insert
2283 ;; Choose a completion with the mouse.
2285 (defun mouse-choose-completion (event)
2289 (run-hooks 'mouse-leave-buffer-hook)
2301 (if (and (not (eobp)) (get-text-property (point) 'mouse-face))
2305 (setq beg (previous-single-property-change beg 'mouse-face))
2306 (setq end (or (next-single-property-change end 'mouse-face)
2404 (defun mouse-set-font (&rest fonts)
2429 ;;; Bindings for mouse commands.
2431 (define-key global-map [down-mouse-1] 'mouse-drag-region)
2432 (global-set-key [mouse-1] 'mouse-set-point)
2433 (global-set-key [drag-mouse-1] 'mouse-set-region)
2435 ;; These are tested for in mouse-drag-region.
2436 (global-set-key [double-mouse-1] 'mouse-set-point)
2437 (global-set-key [triple-mouse-1] 'mouse-set-point)
2440 (global-set-key [left-fringe mouse-1] 'mouse-set-point)
2441 (global-set-key [right-fringe mouse-1] 'mouse-set-point)
2443 (global-set-key [mouse-2] 'mouse-yank-at-click)
2445 (global-set-key [right-fringe mouse-2] 'mouse-yank-at-click)
2446 (global-set-key [left-fringe mouse-2] 'mouse-yank-at-click)
2447 (global-set-key [mouse-3] 'mouse-save-then-kill)
2448 (global-set-key [right-fringe mouse-3] 'mouse-save-then-kill)
2449 (global-set-key [left-fringe mouse-3] 'mouse-save-then-kill)
2453 (global-set-key [C-down-mouse-1] 'mouse-buffer-menu)
2455 (global-set-key [S-down-mouse-1] 'mouse-set-font))
2456 ;; C-down-mouse-2 is bound in facemenu.el.
2457 (global-set-key [C-down-mouse-3] 'mouse-popup-menubar-stuff)
2460 ;; Replaced with dragging mouse-1
2461 ;; (global-set-key [S-mouse-1] 'mouse-set-mark)
2463 ;; Binding mouse-1 to mouse-select-window when on mode-, header-, or
2464 ;; vertical-line prevents Emacs from signaling an error when the mouse
2467 (global-set-key [mode-line mouse-1] 'mouse-select-window)
2468 (global-set-key [mode-line drag-mouse-1] 'mouse-select-window)
2469 (global-set-key [mode-line down-mouse-1] 'mouse-drag-mode-line)
2470 (global-set-key [header-line down-mouse-1] 'mouse-drag-header-line)
2471 (global-set-key [header-line mouse-1] 'mouse-select-window)
2472 (global-set-key [mode-line mouse-2] 'mouse-delete-other-windows)
2473 (global-set-key [mode-line mouse-3] 'mouse-delete-window)
2474 (global-set-key [mode-line C-mouse-2] 'mouse-split-window-horizontally)
2475 (global-set-key [vertical-scroll-bar C-mouse-2] 'mouse-split-window-vertically)
2476 (global-set-key [vertical-line C-mouse-2] 'mouse-split-window-vertically)
2477 (global-set-key [vertical-line down-mouse-1] 'mouse-drag-vertical-line)
2478 (global-set-key [vertical-line mouse-1] 'mouse-select-window)
2480 (provide 'mouse)
2483 (defalias 'mldrag-drag-mode-line 'mouse-drag-mode-line)
2484 (defalias 'mldrag-drag-vertical-line 'mouse-drag-vertical-line)
2485 (make-obsolete 'mldrag-drag-mode-line 'mouse-drag-mode-line "21.1")
2486 (make-obsolete 'mldrag-drag-vertical-line 'mouse-drag-vertical-line "21.1")
2490 ;;; mouse.el ends here