Don't reload eww pages when browsing to different #targets

* net/eww.el (eww-follow-link): New command to avoid reloading
pages when we follow #target links.

Fixes: debbugs:15243

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index f6f6b51d723a0e4caf829aa27bb116f9aa4dac28..6c2d57c8a7928c788b8a48f882e0ad7f2a2f84e5 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,8 @@
+2013-12-01  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+       * net/eww.el (eww-follow-link): New command to avoid reloading
+       pages when we follow #target links (bug#15243).
+
 2013-12-01  Kenjiro NAKAYAMA  <nakayamakenjiro@gmail.com>
 
        * net/eww.el (eww-tag-select): Support <optgroup> tags in <select>

diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index 5b1fc0831d6ed046d0b632160490b8b16e68c443..9a90ccd258b07032175c9be60d14207799c8cf7e 100644 (file)
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -143,9 +143,6 @@ word(s) will be searched for via `eww-search-prefix'."
   (set (make-local-variable 'eww-start-url) nil)
   (set (make-local-variable 'eww-contents-url) nil)
   (let* ((headers (eww-parse-headers))
-        (shr-target-id
-         (and (string-match "#\\(.*\\)" url)
-              (match-string 1 url)))
         (content-type
          (mail-header-parse-content-type
           (or (cdr (assoc "content-type" headers))
@@ -161,22 +158,15 @@ word(s) will be searched for via `eww-search-prefix'."
        (progn
          (cond
           ((equal (car content-type) "text/html")
-           (eww-display-html charset url))
+           (eww-display-html charset url nil point))
           ((string-match "^image/" (car content-type))
-           (eww-display-image))
+           (eww-display-image)
+           (eww-update-header-line-format))
           (t
-           (eww-display-raw)))
+           (eww-display-raw)
+           (eww-update-header-line-format)))
          (setq eww-current-url url
-               eww-history-position 0)
-         (eww-update-header-line-format)
-         (cond
-          (point
-           (goto-char point))
-          (shr-target-id
-           (let ((point (next-single-property-change
-                         (point-min) 'shr-target-id)))
-             (when point
-               (goto-char (1+ point)))))))
+               eww-history-position 0))
       (kill-buffer data-buffer))))
 
 (defun eww-parse-headers ()
@@ -208,7 +198,7 @@ word(s) will be searched for via `eww-search-prefix'."
 (declare-function libxml-parse-html-region "xml.c"
                  (start end &optional base-url))
 
-(defun eww-display-html (charset url)
+(defun eww-display-html (charset url &optional document point)
   (or (fboundp 'libxml-parse-html-region)
       (error "This function requires Emacs to be compiled with libxml2"))
   (unless (eq charset 'utf8)
@@ -216,14 +206,16 @@ word(s) will be searched for via `eww-search-prefix'."
        (decode-coding-region (point) (point-max) charset)
       (coding-system-error nil)))
   (let ((document
-        (list
-         'base (list (cons 'href url))
-         (libxml-parse-html-region (point) (point-max)))))
+        (or document
+            (list
+             'base (list (cons 'href url))
+             (libxml-parse-html-region (point) (point-max))))))
     (eww-setup-buffer)
     (setq eww-current-dom document)
     (let ((inhibit-read-only t)
          (after-change-functions nil)
          (shr-width nil)
+         (shr-target-id (url-target (url-generic-parse-url url)))
          (shr-external-rendering-functions
           '((title . eww-tag-title)
             (form . eww-tag-form)
@@ -233,8 +225,20 @@ word(s) will be searched for via `eww-search-prefix'."
             (select . eww-tag-select)
             (link . eww-tag-link)
             (a . eww-tag-a))))
-      (shr-insert-document document))
-    (goto-char (point-min))))
+      (shr-insert-document document)
+      (cond
+       (point
+       (goto-char point))
+       (shr-target-id
+       (let ((point (next-single-property-change
+                     (point-min) 'shr-target-id)))
+         (when point
+           (goto-char (1+ point)))))
+       (t
+       (goto-char (point-min)))))
+    (setq eww-current-url url
+         eww-history-position 0)
+    (eww-update-header-line-format)))
 
 (defun eww-handle-link (cont)
   (let* ((rel (assq :rel cont))
@@ -266,7 +270,9 @@ word(s) will be searched for via `eww-search-prefix'."
 
 (defun eww-tag-a (cont)
   (eww-handle-link cont)
-  (shr-tag-a cont))
+  (let ((start (point)))
+    (shr-tag-a cont)
+    (put-text-property start (point) 'keymap eww-link-keymap)))
 
 (defun eww-update-header-line-format ()
   (if eww-header-line-format
@@ -374,6 +380,11 @@ word(s) will be searched for via `eww-search-prefix'."
        ["List cookies" url-cookie-list t]))
     map))
 
+(defvar eww-link-keymap
+  (let ((map (copy-keymap shr-map)))
+    (define-key map "\r" 'eww-follow-link)
+    map))
+
 (define-derived-mode eww-mode nil "eww"
   "Mode for browsing the web.
 
@@ -928,6 +939,36 @@ The browser to used is specified by the `shr-external-browser' variable."
   (interactive)
   (funcall shr-external-browser eww-current-url))
 
+(defun eww-follow-link (&optional external mouse-event)
+  "Browse the URL under point.
+If EXTERNAL, browse the URL using `shr-external-browser'."
+  (interactive (list current-prefix-arg last-nonmenu-event))
+  (mouse-set-point mouse-event)
+  (let ((url (get-text-property (point) 'shr-url)))
+    (cond
+     ((not url)
+      (message "No link under point"))
+     ((string-match "^mailto:" url)
+      (browse-url-mail url))
+     (external
+      (funcall shr-external-browser url))
+     ;; 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 eww-current-url))
+      (eww-save-history)
+      (eww-display-html 'utf8 url eww-current-dom))
+     (t
+      (eww-browse-url url)))))
+
+(defun eww-same-page-p (url1 url2)
+  "Return non-nil if boths URLs represent the same page.
+Differences in #targets are ignored."
+  (let ((obj1 (url-generic-parse-url url1))
+       (obj2 (url-generic-parse-url url2)))
+    (setf (url-target obj1) nil)
+    (setf (url-target obj2) nil)
+    (equal (url-recreate-url obj1) (url-recreate-url obj2))))
+
 (defun eww-copy-page-url ()
   (interactive)
   (message "%s" eww-current-url)

diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index b742172be461a563a95c89a0b7fce1243993a5b6..a7f1f9c88f52bf6b668c21af78e87af0112b202e 100644 (file)
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -849,7 +849,6 @@ START, and END.  Note that START and END should be markers."
   (shr-ensure-paragraph))
 
 (defun shr-urlify (start url &optional title)
-  (when (and title (string-match "ctx" title)) (debug))
   (shr-add-font start (point) 'shr-link)
   (add-text-properties
    start (point)