X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/c2385c6f36d346d6524a4119109f52d4fd975244..a7e302dc1dc18770aaf9eeedfd638f73b574bc19:/lisp/mouse.el diff --git a/lisp/mouse.el b/lisp/mouse.el index 5f3fa5d769..53d5a22167 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -1,6 +1,6 @@ ;;; mouse.el --- window system-independent mouse support -*- lexical-binding: t -*- -;; Copyright (C) 1993-1995, 1999-2015 Free Software Foundation, Inc. +;; Copyright (C) 1993-1995, 1999-2016 Free Software Foundation, Inc. ;; Maintainer: emacs-devel@gnu.org ;; Keywords: hardware, mouse @@ -97,35 +97,44 @@ Expects to be bound to `down-mouse-1' in `key-translation-map'." (when (and mouse-1-click-follows-link (eq (if (eq mouse-1-click-follows-link 'double) 'double-down-mouse-1 'down-mouse-1) - (car-safe last-input-event)) - (mouse-on-link-p (event-start last-input-event)) - (or mouse-1-click-in-non-selected-windows - (eq (selected-window) - (posn-window (event-start last-input-event))))) - (let ((timedout - (sit-for (if (numberp mouse-1-click-follows-link) - (/ (abs mouse-1-click-follows-link) 1000.0) - 0)))) - (if (if (and (numberp mouse-1-click-follows-link) - (>= mouse-1-click-follows-link 0)) - timedout (not timedout)) - nil - - (let ((event (read-key))) ;Use read-key so it works for xterm-mouse-mode! - (if (eq (car-safe event) (if (eq mouse-1-click-follows-link 'double) - 'double-mouse-1 'mouse-1)) - ;; Turn the mouse-1 into a mouse-2 to follow links. - (let ((newup (if (eq mouse-1-click-follows-link 'double) - 'double-mouse-2 'mouse-2))) - ;; If mouse-2 has never been done by the user, it doesn't have - ;; the necessary property to be interpreted correctly. - (unless (get newup 'event-kind) - (put newup 'event-kind (get (car event) 'event-kind))) - (push (cons newup (cdr event)) unread-command-events) - ;; Don't change the down event, only the up-event (bug#18212). - nil) - (push event unread-command-events) - nil)))))) + (car-safe 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 + (eq (selected-window) + (posn-window (event-start last-input-event))))) + (let ((timedout + (sit-for (if (numberp mouse-1-click-follows-link) + (/ (abs mouse-1-click-follows-link) 1000.0) + 0)))) + (if (if (and (numberp mouse-1-click-follows-link) + (>= mouse-1-click-follows-link 0)) + timedout (not timedout)) + nil + ;; Use read-key so it works for xterm-mouse-mode! + (let ((event (read-key))) + (if (eq (car-safe event) + (if (eq mouse-1-click-follows-link 'double) + 'double-mouse-1 'mouse-1)) + (progn + ;; Turn the mouse-1 into a mouse-2 to follow links, + ;; but only if ‘mouse-on-link-p’ hasn’t returned a + ;; string or vector (see its docstring). + (if (or (stringp action) (vectorp action)) + (push (aref action 0) unread-command-events) + (let ((newup (if (eq mouse-1-click-follows-link 'double) + 'double-mouse-2 'mouse-2))) + ;; If mouse-2 has never been done by the user, it + ;; doesn't have the necessary property to be + ;; interpreted correctly. + (unless (get newup 'event-kind) + (put newup 'event-kind (get (car event) 'event-kind))) + (push (cons newup (cdr event)) unread-command-events))) + ;; Don't change the down event, only the up-event + ;; (bug#18212). + nil) + (push event unread-command-events) + nil)))))))) (define-key key-translation-map [down-mouse-1] #'mouse--down-1-maybe-follows-link) @@ -152,13 +161,16 @@ items `Turn Off' and `Help'." (setq menu (if menu (mouse-menu-non-singleton menu) - `(keymap - ,indicator - (turn-off menu-item "Turn Off minor mode" ,mm-fun) - (help menu-item "Help for minor mode" - (lambda () (interactive) - (describe-function ',mm-fun)))))) - (popup-menu menu)))) + (if (fboundp mm-fun) ; bug#20201 + `(keymap + ,indicator + (turn-off menu-item "Turn off minor mode" ,mm-fun) + (help menu-item "Help for minor mode" + (lambda () (interactive) + (describe-function ',mm-fun))))))) + (if menu + (popup-menu menu) + (message "No menu available"))))) (defun mouse-minor-mode-menu (event) "Show minor-mode menu for EVENT on minor modes area of the mode line." @@ -335,9 +347,12 @@ This command must be bound to a mouse click." (first-line window-min-height) (last-line (- (window-height) window-min-height))) (if (< last-line first-line) - (error "Window too short to split") - (split-window-vertically - (min (max new-height first-line) last-line)))))) + (user-error "Window too short to split") + ;; Bind `window-combination-resize' to nil so we are sure to get + ;; the split right at the line clicked on. + (let (window-combination-resize) + (split-window-vertically + (min (max new-height first-line) last-line))))))) (defun mouse-split-window-horizontally (click) "Select Emacs window mouse is on, then split it horizontally in half. @@ -351,9 +366,12 @@ This command must be bound to a mouse click." (first-col window-min-width) (last-col (- (window-width) window-min-width))) (if (< last-col first-col) - (error "Window too narrow to split") - (split-window-horizontally - (min (max new-width first-col) last-col)))))) + (user-error "Window too narrow to split") + ;; Bind `window-combination-resize' to nil so we are sure to get + ;; the split right at the column clicked on. + (let (window-combination-resize) + (split-window-horizontally + (min (max new-width first-col) last-col))))))) (defun mouse-drag-line (start-event line) "Drag a mode line, header line, or vertical line with the mouse. @@ -397,7 +415,13 @@ must be one of the symbols `header', `mode', or `vertical'." (or (not resize-mini-windows) (eq minibuffer-window (active-minibuffer-window))))))) - (setq draggable nil)))) + (setq draggable nil))) + ((eq line 'vertical) + (let ((divider-width (frame-right-divider-width frame))) + (when (and (or (not (numberp divider-width)) + (zerop divider-width)) + (eq (frame-parameter frame 'vertical-scroll-bars) 'left)) + (setq window (window-in-direction 'left window t)))))) (let* ((exitfun nil) (move @@ -465,8 +489,10 @@ must be one of the symbols `header', `mode', or `vertical'." (setq dragged t) (adjust-window-trailing-edge window growth nil t)) (setq last-position position)))))) - ;; Start tracking. - (setq track-mouse t) + ;; Start tracking. The special value 'dragging' signals the + ;; display engine to freeze the mouse pointer shape for as long + ;; as we drag. + (setq track-mouse 'dragging) ;; Loop reading events and sampling the position of the mouse. (setq exitfun (set-transient-map @@ -547,7 +573,12 @@ command alters the kill ring or not." (mouse-minibuffer-check click) (select-window (posn-window (event-start click))) (let ((beg (posn-point (event-start click))) - (end (posn-point (event-end click))) + (end + (if (eq (posn-window (event-end click)) (selected-window)) + (posn-point (event-end click)) + ;; If the mouse ends up in any other window or on the menu + ;; bar, use `window-point' of selected window (Bug#23707). + (window-point))) (click-count (event-click-count click))) (let ((drag-start (terminal-parameter nil 'mouse-drag-start))) (when drag-start @@ -920,20 +951,29 @@ If MODE is 2 then do the same for lines." (= start end) (char-after start) (= (char-syntax (char-after start)) ?\()) - (list start - (save-excursion - (goto-char start) - (forward-sexp 1) - (point)))) + (if (/= (syntax-class (syntax-after start)) 4) ; raw syntax code for ?\( + ;; This happens in CC Mode when unbalanced parens in CPP + ;; constructs are given punctuation syntax with + ;; syntax-table text properties. (2016-02-21). + (signal 'scan-error (list "Containing expression ends prematurely" + start start)) + (list start + (save-excursion + (goto-char start) + (forward-sexp 1) + (point))))) ((and (= mode 1) (= start end) (char-after start) (= (char-syntax (char-after start)) ?\))) - (list (save-excursion - (goto-char (1+ start)) - (backward-sexp 1) - (point)) - (1+ start))) + (if (/= (syntax-class (syntax-after start)) 5) ; raw syntax code for ?\) + ;; See above comment about CC Mode. + (signal 'scan-error (list "Unbalanced parentheses" start start)) + (list (save-excursion + (goto-char (1+ start)) + (backward-sexp 1) + (point)) + (1+ start)))) ((and (= mode 1) (= start end) (char-after start) @@ -1016,7 +1056,7 @@ This must be bound to a mouse click." (interactive "e") (mouse-minibuffer-check click) (select-window (posn-window (event-start click))) - ;; We don't use save-excursion because that preserves the mark too. + ;; FIXME: Use save-excursion (let ((point-save (point))) (unwind-protect (progn (mouse-set-point click) @@ -1100,12 +1140,12 @@ This does not delete the region; it acts like \\[kill-ring-save]." ;; Delete, but make the undo-list entry share with the kill ring. ;; First, delete just one char, so in case buffer is being modified ;; for the first time, the undo list records that fact. - (let (before-change-functions after-change-functions) + (let ((inhibit-modification-hooks t)) (delete-region beg (+ beg (if (> end beg) 1 -1)))) (let ((buffer-undo-list buffer-undo-list)) ;; Undo that deletion--but don't change the undo list! - (let (before-change-functions after-change-functions) + (let ((inhibit-modification-hooks t)) (primitive-undo 1 buffer-undo-list)) ;; Now delete the rest of the specified region, ;; but don't record it. @@ -1663,7 +1703,7 @@ and selects that window." ;; Font selection. (defun font-menu-add-default () - (let* ((default (cdr (assq 'font (frame-parameters (selected-frame))))) + (let* ((default (frame-parameter nil 'font)) (font-alist x-fixed-font-alist) (elt (or (assoc "Misc" font-alist) (nth 1 font-alist)))) (if (assoc "Default" elt) @@ -1910,20 +1950,25 @@ choose a font." ;; vertical-line prevents Emacs from signaling an error when the mouse ;; button is released after dragging these lines, on non-toolkit ;; versions. -(global-set-key [mode-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) (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 [mode-line drag-mouse-1] 'mouse-select-window) +(global-set-key [mode-line down-mouse-1] 'mouse-drag-mode-line) +(global-set-key [mode-line mouse-1] 'mouse-select-window) (global-set-key [mode-line mouse-2] 'mouse-delete-other-windows) (global-set-key [mode-line mouse-3] 'mouse-delete-window) (global-set-key [mode-line C-mouse-2] 'mouse-split-window-horizontally) (global-set-key [vertical-scroll-bar C-mouse-2] 'mouse-split-window-vertically) -(global-set-key [vertical-line C-mouse-2] 'mouse-split-window-vertically) +(global-set-key [horizontal-scroll-bar C-mouse-2] 'mouse-split-window-horizontally) (global-set-key [vertical-line down-mouse-1] 'mouse-drag-vertical-line) +(global-set-key [vertical-line mouse-1] 'mouse-select-window) +(global-set-key [vertical-line C-mouse-2] 'mouse-split-window-vertically) (global-set-key [right-divider down-mouse-1] 'mouse-drag-vertical-line) +(global-set-key [right-divider mouse-1] 'ignore) +(global-set-key [right-divider C-mouse-2] 'mouse-split-window-vertically) (global-set-key [bottom-divider down-mouse-1] 'mouse-drag-mode-line) -(global-set-key [vertical-line mouse-1] 'mouse-select-window) +(global-set-key [bottom-divider mouse-1] 'ignore) +(global-set-key [bottom-divider C-mouse-2] 'mouse-split-window-horizontally) (provide 'mouse)