-(defun shr-expand-url (url)
- (cond
- ;; Absolute URL.
- ((or (not url)
- (string-match "\\`[a-z]*:" url)
- (not shr-base))
- url)
- ((and (string-match "\\`//" url)
- (string-match "\\`[a-z]*:" shr-base))
- (concat (match-string 0 shr-base) url))
- ((and (not (string-match "/\\'" shr-base))
- (not (string-match "\\`/" url)))
- (concat shr-base "/" url))
- (t
- (concat shr-base url))))
+(defun shr-parse-base (url)
+ ;; Always chop off anchors.
+ (when (string-match "#.*" url)
+ (setq url (substring url 0 (match-beginning 0))))
+ (let* ((parsed (url-generic-parse-url url))
+ (local (url-filename parsed)))
+ (setf (url-filename parsed) "")
+ ;; Chop off the bit after the last slash.
+ (when (string-match "\\`\\(.*/\\)[^/]+\\'" local)
+ (setq local (match-string 1 local)))
+ ;; Always make the local bit end with a slash.
+ (when (and (not (zerop (length local)))
+ (not (eq (aref local (1- (length local))) ?/)))
+ (setq local (concat local "/")))
+ (list (url-recreate-url parsed)
+ local
+ (url-type parsed)
+ url)))
+
+(defun shr-expand-url (url &optional base)
+ (setq base
+ (if base
+ (shr-parse-base base)
+ ;; Bound by the parser.
+ shr-base))
+ (when (zerop (length url))
+ (setq url nil))
+ (cond ((or (not url)
+ (not base)
+ (string-match "\\`[a-z]*:" url))
+ ;; Absolute URL.
+ (or url (car base)))
+ ((eq (aref url 0) ?/)
+ (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)))
+ ((eq (aref url 0) ?#)
+ ;; A link to an anchor.
+ (concat (nth 3 base) url))
+ (t
+ ;; Totally relative.
+ (concat (car base) (cadr base) url))))