[gnus git] branch master updated: n0-15-79-g5627fc9 =1= Use <base> to expand relative URLs.

       via  5627fc94bf5c729eabff96cfddac7ff24515822c (commit)
      from  30ad87c1e3b03e7c0bf9a6c3b1269e753ba53955 (commit)


- Log -----------------------------------------------------------------
commit 5627fc94bf5c729eabff96cfddac7ff24515822c
Author: Lars Magne Ingebrigtsen <[email protected]>
Date:   Thu Apr 21 00:34:03 2011 +0200

    Use <base> to expand relative URLs.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 0d2f6b6..f67f77b 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,9 @@
+2011-04-20  Lars Magne Ingebrigtsen  <[email protected]>
+
+	* shr.el (shr-base): New binding.
+	(shr-tag-base): Keep track of <base>.
+	(shr-expand-url): New function used throughout.
+
 2011-04-20  Teodor Zlatanov  <[email protected]>
 
 	* gnus-registry.el
diff --git a/lisp/shr.el b/lisp/shr.el
index 113137a..f27705e 100644
--- a/lisp/shr.el
+++ b/lisp/shr.el
@@ -99,6 +99,7 @@ cid: URL as the argument.")
 (defvar shr-kinsoku-shorten nil)
 (defvar shr-table-depth 0)
 (defvar shr-stylesheet nil)
+(defvar shr-base nil)
 
 (defvar shr-map
   (let ((map (make-sparse-keymap)))
@@ -127,6 +128,7 @@ cid: URL as the argument.")
   (setq shr-content-cache nil)
   (let ((shr-state nil)
 	(shr-start nil)
+	(shr-base nil)
 	(shr-width (or shr-width (window-width))))
     (shr-descend (shr-transform-dom dom))))
 
@@ -392,6 +394,18 @@ redirects somewhere else."
 	 (forward-char 1))))
     (not failed)))
 
+(defun shr-expand-url (url)
+  (cond
+   ;; Absolute URL.
+   ((or (string-match "\\`[a-z]*:" url)
+	(not shr-base))
+    url)
+   ((and (not (string-match "/\\'" shr-base))
+	 (not (string-match "\\`" url)))
+    (concat shr-base "/" url))
+   (t
+    (concat shr-base url))))
+
 (defun shr-ensure-newline ()
   (unless (zerop (current-column))
     (insert "\n")))
@@ -773,13 +787,16 @@ ones, in case fg and bg are nil."
 		    plist)))))
       plist)))
 
+(defun shr-tag-base (cont)
+  (setq shr-base (cdr (assq :href cont))))
+
 (defun shr-tag-a (cont)
   (let ((url (cdr (assq :href cont)))
         (title (cdr (assq :title cont)))
 	(start (point))
 	shr-start)
     (shr-generic cont)
-    (shr-urlify (or shr-start start) url title)))
+    (shr-urlify (or shr-start start) (shr-expand-url url) title)))
 
 (defun shr-tag-object (cont)
   (let ((start (point))
@@ -792,7 +809,7 @@ ones, in case fg and bg are nil."
 	(setq url (or url (cdr (assq :value (cdr elem)))))))
     (when url
       (shr-insert " [multimedia] ")
-      (shr-urlify start url))
+      (shr-urlify start (shr-expand-url url)))
     (shr-generic cont)))
 
 (defun shr-tag-video (cont)
@@ -800,7 +817,7 @@ ones, in case fg and bg are nil."
 	(url (cdr (assq :src cont)))
 	(start (point)))
     (shr-tag-img nil image)
-    (shr-urlify start url)))
+    (shr-urlify start (shr-expand-url url))))
 
 (defun shr-tag-img (cont &optional url)
   (when (or url
@@ -810,7 +827,7 @@ ones, in case fg and bg are nil."
 	       (not (eq shr-state 'image)))
       (insert "\n"))
     (let ((alt (cdr (assq :alt cont)))
-	  (url (or url (cdr (assq :src cont)))))
+	  (url (shr-expand-url (or url (cdr (assq :src cont))))))
       (let ((start (point-marker)))
 	(when (zerop (length alt))
 	  (setq alt "*"))

-----------------------------------------------------------------------
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we listed those
revisions in full, above.

Summary of changes:
 lisp/ChangeLog |    6 ++++++
 lisp/shr.el    |   25 +++++++++++++++++++++----
 2 files changed, 27 insertions(+), 4 deletions(-)

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "Gnus Project".

The branch, master has been updated


hooks/post-receive
-- 
Gnus Project