]> git.eshelyaron.com Git - emacs.git/commitdiff
When opening external links in eww, blink the link
authorLars Ingebrigtsen <larsi@gnus.org>
Fri, 13 Apr 2018 12:17:51 +0000 (14:17 +0200)
committerLars Ingebrigtsen <larsi@gnus.org>
Fri, 13 Apr 2018 12:17:51 +0000 (14:17 +0200)
* 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.

lisp/net/eww.el
lisp/net/shr.el

index 10d9c47e8def31160cc9714787d572eb19200404..08a40cef182154be6dd23a081f5a88c280352af5 100644 (file)
@@ -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)))
index e743f9d3849379d39f2e690e56c5c116de870dde..2dc1036e412ef076d5702ccb428d35620ecdf7c4 100644 (file)
@@ -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)