From bda8852c32a2c5ff79bbee5fbe9d61d42274054b Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Tue, 10 May 2016 23:23:26 +0200 Subject: [PATCH] =?UTF-8?q?Fix=20handling=20of=20=E2=80=98mouse-on-link-p?= =?UTF-8?q?=E2=80=99.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit If ‘mouse-on-link-p’ returns a string or vector, the first element is to be used as new event. Translation to ‘mouse-2’ should only happen if the return value is not a string or vector. See docstring of ‘mouse-on-link-p’ and Bug#23288. * lisp/mouse.el (mouse--down-1-maybe-follows-link): Process return value of ‘mouse-on-link-p’ according to documentation. * test/automated/mouse-tests.el (bug23288-use-return-value) (bug23288-translate-to-mouse-2): Tests for Bug#23288. --- lisp/mouse.el | 67 ++++++++++++++++++++++++------------------- test/automated/mouse-tests.el | 48 +++++++++++++++++++++++++++++++ 2 files changed, 86 insertions(+), 29 deletions(-) create mode 100644 test/automated/mouse-tests.el diff --git a/lisp/mouse.el b/lisp/mouse.el index fa355ff..ba6b04a 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -97,35 +97,44 @@ mouse--down-1-maybe-follows-link (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) diff --git a/test/automated/mouse-tests.el b/test/automated/mouse-tests.el new file mode 100644 index 0000000..21abf38 --- /dev/null +++ b/test/automated/mouse-tests.el @@ -0,0 +1,48 @@ +;;; mouse-tests.el --- unit tests for mouse.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2016 Free Software Foundation, Inc. + +;; Author: Philipp Stephani + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; Unit tests for lisp/mouse.el. + +;;; Code: + +(ert-deftest bug23288-use-return-value () + "If ‘mouse-on-link-p’ returns a string, its first character is +used." + (cl-letf ((last-input-event '(down-mouse-1 nil 1)) + (unread-command-events '((mouse-1 nil 1))) + (mouse-1-click-follows-link t) + (mouse-1-click-in-non-selected-windows t) + ((symbol-function 'mouse-on-link-p) (lambda (_pos) "abc"))) + (should-not (mouse--down-1-maybe-follows-link)) + (should (equal unread-command-events '(?a))))) + +(ert-deftest bug23288-translate-to-mouse-2 () + "If ‘mouse-on-link-p’ doesn’t return a string or vector, +translate ‘mouse-1’ events into ‘mouse-2’ events." + (cl-letf ((last-input-event '(down-mouse-1 nil 1)) + (unread-command-events '((mouse-1 nil 1))) + (mouse-1-click-follows-link t) + (mouse-1-click-in-non-selected-windows t) + ((symbol-function 'mouse-on-link-p) (lambda (_pos) t))) + (should-not (mouse--down-1-maybe-follows-link)) + (should (equal unread-command-events '((mouse-2 nil 1)))))) + +;;; mouse-tests.el ends here -- 2.8.0.rc3.226.g39d4020