From dbd5ffad4d537506245e92d56c7b833ad5af821b Mon Sep 17 00:00:00 2001 From: Lars Magne Ingebrigtsen Date: Thu, 21 Apr 2011 00:24:27 +0000 Subject: [PATCH] shr.el (shr-base): New binding. (shr-tag-base): Keep track of . (shr-expand-url): New function used throughout. --- lisp/gnus/ChangeLog | 6 ++++++ lisp/gnus/shr.el | 25 +++++++++++++++++++++---- 2 files changed, 27 insertions(+), 4 deletions(-) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 73e7345e07d..9c37b9bf576 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,9 @@ +2011-04-20 Lars Magne Ingebrigtsen + + * shr.el (shr-base): New binding. + (shr-tag-base): Keep track of . + (shr-expand-url): New function used throughout. + 2011-04-20 Teodor Zlatanov * gnus-registry.el diff --git a/lisp/gnus/shr.el b/lisp/gnus/shr.el index 113137a0046..f27705e0bf5 100644 --- a/lisp/gnus/shr.el +++ b/lisp/gnus/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 "*")) -- 2.39.2