From: Lars Ingebrigtsen <larsi@gnus.org>
Date: Fri, 13 Apr 2018 12:17:51 +0000 (+0200)
Subject: When opening external links in eww, blink the link
X-Git-Tag: emacs-27.0.90~5262
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=4f4c7b8083b91633704b2d9c2c3ebbef8713060e;p=emacs.git

When opening external links in eww, blink the link

* lisp/net/eww.el (eww-follow-link): Ditto.

* lisp/net/shr.el (shr-selected-link): New face (bug#25096).
(shr--blink-link): New function to blink links.
(shr--current-link-region): New utility function.
(shr-browse-url): Use it to blink external links.

Blinking the link allows the user to get immediate feedback that the
action has been performed.  Opening the external browser may take a
while, and may not be obvious that is going on.
---

diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index 10d9c47e8de..08a40cef182 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -1486,7 +1486,8 @@ If EXTERNAL is double prefix, browse in new buffer."
      ((string-match "^mailto:" url)
       (browse-url-mail url))
      ((and (consp external) (<= (car external) 4))
-      (funcall shr-external-browser url))
+      (funcall shr-external-browser url)
+      (shr--blink-link))
      ;; This is a #target url in the same page as the current one.
      ((and (url-target (url-generic-parse-url url))
 	   (eww-same-page-p url (plist-get eww-data :url)))
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index e743f9d3849..2dc1036e412 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -142,6 +142,11 @@ cid: URL as the argument.")
   "Font for link elements."
   :group 'shr)
 
+(defface shr-selected-link
+  '((t (:inherit shr-link :background "red")))
+  "Font for link elements."
+  :group 'shr)
+
 (defvar shr-inhibit-images nil
   "If non-nil, inhibit loading images.")
 
@@ -344,6 +349,30 @@ If the URL is already at the front of the kill ring act like
       (shr-probe-and-copy-url url)
     (shr-copy-url url)))
 
+(defun shr--current-link-region ()
+  (let ((current (get-text-property (point) 'shr-url))
+        start)
+    (save-excursion
+      ;; Go to the beginning.
+      (while (and (not (bobp))
+		  (equal (get-text-property (point) 'shr-url) current))
+        (forward-char -1))
+      (unless (equal (get-text-property (point) 'shr-url) current)
+        (forward-char 1))
+      (setq start (point))
+      ;; Go to the end.
+      (while (and (not (eobp))
+                  (equal (get-text-property (point) 'shr-url) current))
+        (forward-char 1))
+      (list start (point)))))
+
+(defun shr--blink-link ()
+  (let* ((region (shr--current-link-region))
+         (overlay (make-overlay (car region) (cadr region))))
+    (overlay-put overlay 'face 'shr-selected-link)
+    (run-at-time 1 nil (lambda ()
+                         (delete-overlay overlay)))))
+
 (defun shr-next-link ()
   "Skip to the next link."
   (interactive)
@@ -950,7 +979,9 @@ the mouse click event."
       (browse-url-mail url))
      (t
       (if external
-	  (funcall shr-external-browser url)
+          (progn
+	    (funcall shr-external-browser url)
+            (shr--blink-link))
 	(browse-url url))))))
 
 (defun shr-save-contents (directory)