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

From: Philipp Stephani <[email-masked]>
Date: Wed, 11 May 2016 13:01:55 +0000

There was a small bug in the patch. I've attached a new version that
hopefully fixes that.

Nils Berg <[email-masked]> schrieb am Mi., 11. Mai 2016 um 10:32 Uhr:

> Still no dice, sorry.  I just tried the patched version with the original
> example:
> echo -n bar | xsel -i && \
>   emacs -Q -eval \
>   "(insert (propertize \"foo\" 'follow-link (lambda (pos) \"a\")))"
>
> Now when I click foo nothing happens in the buffer, but there's an error
> message:
> Function mouse--down-1-maybe-follows-link returns invalid key sequence
>
> I can't think of a reason why though :(
>
> M-x version: GNU Emacs 25.0.93.1 (x86_64-pc-linux-gnu, GTK+ Version 3.10.8)
>
> On Wed, May 11, 2016 at 10:14 AM, Eli Zaretskii <[email-masked]> wrote:
>
>> > From: Philipp Stephani <[email-masked]>
>> > Date: Tue, 10 May 2016 21:25:47 +0000
>> > Cc: [email-masked]
>> >
>> >  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.
>>
>> Thanks.  If no one objects in a week, please push to the master
>> branch.
>>
>
>
From bda8852c32a2c5ff79bbee5fbe9d61d42274054b Mon Sep 17 00:00:00 2001
From: Philipp Stephani <[email-masked]>
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 <[email-masked]>
+
+;; 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")))
+    (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