Get the base URL right when being redirected

(eww-render): When being redirected, use the redirect URL as the new
base URL.

* shr.el (shr-expand-url): Respect // URLs.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index be54368..7a1d4b1 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,7 +1,11 @@
 2013-06-16  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
+       * shr.el (shr-expand-url): Respect // URLs.
+
        * eww.el (eww-tag-body): Override the shr body rendering so that we can
        put a background colour onto the entire buffer.
+       (eww-render): When being redirected, use the redirect URL as the new
+       base URL.
 
        * shr.el (shr-parse-base): Fix parsing error.
 

diff --git a/lisp/eww.el b/lisp/eww.el
index 7014003..ddc4edd 100644 (file)
--- a/lisp/eww.el
+++ b/lisp/eww.el
@@ -53,6 +53,9 @@
             (match-string 1)))))
 
 (defun eww-render (status url &optional point)
+  (let ((redirect (plist-get status :redirect)))
+    (when redirect
+      (setq url redirect)))
   (let* ((headers (eww-parse-headers))
         (content-type
          (mail-header-parse-content-type

diff --git a/lisp/shr.el b/lisp/shr.el
index a8996bc..7ed5778 100644 (file)
--- a/lisp/shr.el
+++ b/lisp/shr.el
@@ -495,8 +495,9 @@ size, and full-buffer size."
     (when (and (not (zerop (length local)))
               (not (eq (aref local (1- (length local))) ?/)))
       (setq local (concat local "/")))
-    (cons (url-recreate-url parsed)
-         local)))
+    (list (url-recreate-url parsed)
+         local
+         (url-type parsed))))
 
 (defun shr-expand-url (url &optional base)
   (setq base
@@ -510,11 +511,15 @@ size, and full-buffer size."
         ;; Absolute URL.
         (or url (car base)))
        ((eq (aref url 0) ?/)
-        ;; Just use the host name part.
-        (concat (car base) url))
+        (if (and (> (length url) 1)
+                 (eq (aref url 1) ?/))
+            ;; //host...; just use the protocol
+            (concat (nth 2 base) ":" url)
+          ;; Just use the host name part.
+          (concat (car base) url)))
        (t
         ;; Totally relative.
-        (concat (car base) (cdr base) url))))
+        (concat (car base) (cadr base) url))))
 
 (defun shr-ensure-newline ()
   (unless (zerop (current-column))