diff options
Diffstat (limited to 'lisp/mouse.el')
| -rw-r--r-- | lisp/mouse.el | 219 |
1 files changed, 213 insertions, 6 deletions
diff --git a/lisp/mouse.el b/lisp/mouse.el index 8732fb80866..d2a5200d8de 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -119,7 +119,9 @@ Expects to be bound to `(double-)mouse-1' in `key-translation-map'." (time-since (cdr mouse--last-down)) (/ (abs mouse-1-click-follows-link) 1000.0)))))) (eq (car mouse--last-down) - (event-convert-list (list 'down (car-safe last-input-event)))) + (event-convert-list + `(down ,@(event-modifiers last-input-event) + ,(event-basic-type last-input-event)))) (let* ((action (mouse-on-link-p (event-start last-input-event)))) (when (and action (or mouse-1-click-in-non-selected-windows @@ -178,7 +180,7 @@ items `Turn Off' and `Help'." `(keymap ,(format "%s - %s" indicator (capitalize - (replace-regexp-in-string + (string-replace "-" " " (format "%S" minor-mode)))) (turn-off menu-item "Turn off minor mode" ,mm-fun) (help menu-item "Help for minor mode" @@ -275,6 +277,194 @@ not it is actually displayed." minor-mode-menus))) +;; Context menus. + +(defcustom context-menu-functions '(context-menu-undo + context-menu-region + context-menu-local + context-menu-minor) + "List of functions that produce the contents of the context menu. +Each function receives the menu as its argument and should return +the same menu with changes such as added new menu items." + :type '(repeat + (choice (function-item context-menu-undo) + (function-item context-menu-region) + (function-item context-menu-global) + (function-item context-menu-local) + (function-item context-menu-minor) + (function-item context-menu-vc) + (function-item context-menu-ffap) + (function :tag "Custom function"))) + :version "28.1") + +(defcustom context-menu-filter-function nil + "Function that can filter the list produced by `context-menu-functions'." + :type '(choice (const nil) function) + :version "28.1") + +(defun context-menu-map () + "Return composite menu map." + (let ((menu (make-sparse-keymap))) + (run-hook-wrapped 'context-menu-functions + (lambda (fun) + (setq menu (funcall fun menu)) + nil)) + (when (functionp context-menu-filter-function) + (setq menu (funcall context-menu-filter-function menu))) + menu)) + +(defun context-menu-global (menu) + "Global submenus." + (run-hooks 'activate-menubar-hook 'menu-bar-update-hook) + (define-key-after menu [separator-global] menu-bar-separator) + (map-keymap (lambda (key binding) + (when (consp binding) + (define-key-after menu (vector key) + (copy-sequence binding)))) + (lookup-key global-map [menu-bar])) + menu) + +(defun context-menu-local (menu) + "Major mode submenus." + (run-hooks 'activate-menubar-hook 'menu-bar-update-hook) + (define-key-after menu [separator-local] menu-bar-separator) + (let ((keymap (local-key-binding [menu-bar]))) + (when keymap + (map-keymap (lambda (key binding) + (when (consp binding) + (define-key-after menu (vector key) + (copy-sequence binding)))) + keymap))) + menu) + +(defun context-menu-minor (menu) + "Minor modes submenus." + (run-hooks 'activate-menubar-hook 'menu-bar-update-hook) + (define-key-after menu [separator-minor] menu-bar-separator) + (dolist (mode (reverse (minor-mode-key-binding [menu-bar]))) + (when (and (consp mode) (symbol-value (car mode))) + (map-keymap (lambda (key binding) + (when (consp binding) + (define-key-after menu (vector key) + (copy-sequence binding)))) + (cdr mode)))) + menu) + +(defun context-menu-vc (menu) + "Version Control menu." + (define-key-after menu [separator-vc] menu-bar-separator) + (define-key-after menu [vc-menu] vc-menu-entry) + menu) + +(defun context-menu-undo (menu) + "Undo menu." + (when (cddr menu) + (define-key-after menu [separator-undo] menu-bar-separator)) + (define-key-after menu [undo] + '(menu-item "Undo" undo + :visible (and (not buffer-read-only) + (not (eq t buffer-undo-list)) + (if (eq last-command 'undo) + (listp pending-undo-list) + (consp buffer-undo-list))) + :help "Undo last edits")) + (define-key-after menu [undo-redo] + '(menu-item "Redo" undo-redo + :visible (and (not buffer-read-only) + (undo--last-change-was-undo-p buffer-undo-list)) + :help "Redo last undone edits")) + menu) + +(defun context-menu-region (menu) + "Region commands menu." + (when (cddr menu) + (define-key-after menu [separator-region] menu-bar-separator)) + (define-key-after menu [cut] + '(menu-item "Cut" kill-region + :visible (and mark-active (not buffer-read-only)) + :help + "Cut (kill) text in region between mark and current position")) + (define-key-after menu [copy] + ;; ns-win.el said: Substitute a Copy function that works better + ;; under X (for GNUstep). + `(menu-item "Copy" ,(if (featurep 'ns) + 'ns-copy-including-secondary + 'kill-ring-save) + :visible mark-active + :help "Copy text in region between mark and current position" + :keys ,(if (featurep 'ns) + "\\[ns-copy-including-secondary]" + "\\[kill-ring-save]"))) + (define-key-after menu [paste] + `(menu-item "Paste" mouse-yank-primary + :visible (funcall + ',(lambda () + (and (or + (gui-backend-selection-exists-p 'CLIPBOARD) + (if (featurep 'ns) ; like paste-from-menu + (cdr yank-menu) + kill-ring)) + (not buffer-read-only)))) + :help "Paste (yank) text most recently cut/copied")) + (define-key-after menu (if (featurep 'ns) [select-paste] + [paste-from-menu]) + ;; ns-win.el said: Change text to be more consistent with + ;; surrounding menu items `paste', etc." + `(menu-item ,(if (featurep 'ns) "Select and Paste" "Paste from Kill Menu") + yank-menu + :visible (and (cdr yank-menu) (not buffer-read-only)) + :help "Choose a string from the kill ring and paste it")) + (define-key-after menu [clear] + '(menu-item "Clear" delete-active-region + :visible (and mark-active + (not buffer-read-only)) + :help + "Delete the text in region between mark and current position")) + (define-key-after menu [mark-whole-buffer] + '(menu-item "Select All" mark-whole-buffer + :help "Mark the whole buffer for a subsequent cut/copy")) + menu) + +(defun context-menu-ffap (menu) + "File at point menu." + (save-excursion + (mouse-set-point last-input-event) + (when (ffap-guess-file-name-at-point) + (define-key menu [ffap-separator] menu-bar-separator) + (define-key menu [ffap-at-mouse] + '(menu-item "Find File or URL" ffap-at-mouse + :help "Find file or URL guessed from text around mouse click")))) + menu) + +(defvar context-menu-entry + `(menu-item ,(purecopy "Context Menu") ignore + :filter (lambda (_) (context-menu-map)))) + +(defvar context-menu--old-down-mouse-3 nil) +(defvar context-menu--old-mouse-3 nil) + +(define-minor-mode context-menu-mode + "Toggle Context Menu mode. + +When Context Menu mode is enabled, clicking the mouse button down-mouse-3 +activates the menu whose contents depends on its surrounding context." + :global t :group 'mouse + (cond + (context-menu-mode + (setq context-menu--old-mouse-3 (global-key-binding [mouse-3])) + (global-unset-key [mouse-3]) + (setq context-menu--old-down-mouse-3 (global-key-binding [down-mouse-3])) + (global-set-key [down-mouse-3] context-menu-entry)) + (t + (if (not context-menu--old-down-mouse-3) + (global-unset-key [down-mouse-3]) + (global-set-key [down-mouse-3] context-menu--old-down-mouse-3) + (setq context-menu--old-down-mouse-3 nil)) + (when context-menu--old-mouse-3 + (global-set-key [mouse-3] context-menu--old-mouse-3) + (setq context-menu--old-mouse-3 nil))))) + + ;; Commands that operate on windows. (defun mouse-minibuffer-check (event) @@ -413,7 +603,7 @@ must be one of the symbols `header', `mode', or `vertical'." (when (window-live-p (setq posn-window (posn-window start))) ;; Add left edge of `posn-window' to `position'. (setq position (+ (window-pixel-left posn-window) position)) - (unless (nth 1 start) + (unless (posn-area start) ;; Add width of objects on the left of the text area to ;; `position'. (when (eq (window-current-scroll-bars posn-window) 'left) @@ -492,9 +682,11 @@ must be one of the symbols `header', `mode', or `vertical'." (define-key map [header-line] map) (define-key map [vertical-line] map) ;; ... and some maybe even with a right- or bottom-divider - ;; prefix. + ;; or left- or right-margin prefix ... (define-key map [right-divider] map) (define-key map [bottom-divider] map) + (define-key map [left-margin] map) + (define-key map [right-margin] map) map) t (lambda () (setq track-mouse old-track-mouse))))))) @@ -546,6 +738,18 @@ the frame instead." (when (frame-parameter frame 'drag-with-header-line) (mouse-drag-frame-move start-event)))))) +(defun mouse-drag-tab-line (start-event) + "Drag frame with tab line in its topmost window. +START-EVENT is the starting mouse event of the drag action." + (interactive "e") + (let* ((start (event-start start-event)) + (window (posn-window start))) + (when (and (window-live-p window) + (window-at-side-p window 'top)) + (let ((frame (window-frame window))) + (when (frame-parameter frame 'drag-with-tab-line) + (mouse-drag-frame-move start-event)))))) + (defun mouse-drag-vertical-line (start-event) "Change the width of a window by dragging on a vertical line. START-EVENT is the starting mouse event of the drag action." @@ -674,6 +878,7 @@ frame with the mouse." ;; with a mode-line, header-line or vertical-line prefix ... (define-key map [mode-line] map) (define-key map [header-line] map) + (define-key map [tab-line] map) (define-key map [vertical-line] map) ;; ... and some maybe even with a right- or bottom-divider ;; prefix. @@ -900,6 +1105,7 @@ frame with the mouse." ;; with a mode-line, header-line or vertical-line prefix ... (define-key map [mode-line] map) (define-key map [header-line] map) + (define-key map [tab-line] map) (define-key map [vertical-line] map) ;; ... and some maybe even with a right- or bottom-divider ;; prefix. @@ -1190,7 +1396,7 @@ overlay property, the value of that property determines what to do. for the `follow-link' event, the binding of that event determines what to do. -The resulting value determine whether POS is inside a link: +The resulting value determines whether POS is inside a link: - If the value is `mouse-face', POS is inside a link if there is a non-nil `mouse-face' property at POS. Return t in this case. @@ -2863,8 +3069,8 @@ is copied instead of being cut." (set-marker (nth 2 state) nil)) (with-current-buffer (window-buffer window) (setq cursor-type (nth 3 state))))))) - + ;;; Bindings for mouse commands. (global-set-key [down-mouse-1] 'mouse-drag-region) @@ -2904,6 +3110,7 @@ is copied instead of being cut." ;; versions. (global-set-key [header-line down-mouse-1] 'mouse-drag-header-line) (global-set-key [header-line mouse-1] 'mouse-select-window) +(global-set-key [tab-line down-mouse-1] 'mouse-drag-tab-line) (global-set-key [tab-line mouse-1] 'mouse-select-window) ;; (global-set-key [mode-line drag-mouse-1] 'mouse-select-window) (global-set-key [mode-line down-mouse-1] 'mouse-drag-mode-line) |