bug#23288: 25.0.92; Clicking on links inserts primary X selection

[Philipp Stephani <p.stephani2@gmail.com>]

[-- Attachment #1.1: Type: text/plain, Size: 1485 bytes --]

Philipp Stephani <p.stephani2@gmail.com> schrieb am Mi., 20. Apr. 2016 um
18:53 Uhr:

> Nils Berg <nilsb@google.com> schrieb am Mo., 18. Apr. 2016 um 10:50 Uhr:
>
>> I applied the patch, and the paste-on-click behavior is gone.
>>
>> However, if you try your original example again, you'll find that nothing
>> happens at all, when we're expecting an "a" to be inserted.
>> As the documentation of mouse-on-link-p says, a string or vector return
>> value indicates the event to translate the original mouse-1 click into. In
>> emacs24, that translation was done in mouse-drag-track:
>> (let (on-link (and mouse-1-click-follows-link
>>                        ;; Use start-point before the intangibility
>>                        ;; treatment, in case we click on a link inside
>>                        ;; intangible text.
>>   (mouse-on-link-p start-posn)))
>>   (if (or (vectorp on-link) (stringp on-link))
>>  (setq event (aref on-link 0))
>> (select-window original-window)
>> (setcar event 'mouse-2)
>> ;; If this mouse click has never been done by the
>> ;; user, it doesn't have the necessary property to be
>> ;; interpreted correctly.
>> (put 'mouse-2 'event-kind 'mouse-click)))
>>
>> (abridged from mouse.el:791/901 in Emacs 24.3.1)
>>
>> I think mouse--down-1-maybe-follows-link should do something similar.
>>
>
> Agreed. https://debbugs.gnu.org/cgi/bugreport.cgi?bug=17887 might also be
> related.
>
>
I've attached a new patch that should hopefully correct the behavior.

[-- Attachment #1.2: Type: text/html, Size: 2817 bytes --]

[-- Attachment #2: 0001-Fix-handling-of-mouse-on-link-p.patch --]
[-- Type: application/octet-stream, Size: 7334 bytes --]

From 6b4e9cc6e79ec3e723f1d13457ec8a890de06b8b Mon Sep 17 00:00:00 2001
From: Philipp Stephani <phst@google.com>
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                 | 66 ++++++++++++++++++++++++-------------------
 test/automated/mouse-tests.el | 48 +++++++++++++++++++++++++++++++
 2 files changed, 85 insertions(+), 29 deletions(-)
 create mode 100644 test/automated/mouse-tests.el

diff --git a/lisp/mouse.el b/lisp/mouse.el
index fa355ff..e010def 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -97,35 +97,43 @@ 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))
+                  ;; 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..a0cbbeb
--- /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 <phst@google.com>
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; 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")))
+    (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)))
+    (mouse--down-1-maybe-follows-link)
+    (should (equal unread-command-events '((mouse-2 nil 1))))))
+
+;;; mouse-tests.el ends here
-- 
2.8.2