[gnus git] branch master updated: m0-7-82-gbb49e8d =1= Expand relative URLs more correctly by using `url-generic-parse-url'

       via  bb49e8d0f273fbfea53977fead80b1ab286cf6ec (commit)
      from  1474b920b7471e4bdb4f983b98fb767d61f8037b (commit)


- Log -----------------------------------------------------------------
commit bb49e8d0f273fbfea53977fead80b1ab286cf6ec
Author: Lars Magne Ingebrigtsen <[email protected]>
Date:   Sun Jun 16 14:14:34 2013 +0200

    Expand relative URLs more correctly by using `url-generic-parse-url'
    
    * eww.el (eww-submit): Pass the base in to `shr-expand-url'.
    
    * shr.el (shr-parse-base): New function.
    (shr-expand-url): Use it to expand relative URLs reliably.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index cd0b448..6980d58 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,10 @@
+2013-06-16  Lars Magne Ingebrigtsen  <[email protected]>
+
+	* eww.el (eww-submit): Pass the base in to `shr-expand-url'.
+
+	* shr.el (shr-parse-base): New function.
+	(shr-expand-url): Use it to expand relative URLs reliably.
+
 2013-06-15  Teodor Zlatanov  <[email protected]>
 
 	* auth-source.el (auth-source-search-collection): Fix docstring.
diff --git a/lisp/eww.el b/lisp/eww.el
index 270c3ee..7db661c 100644
--- a/lisp/eww.el
+++ b/lisp/eww.el
@@ -330,22 +330,22 @@
 			  (plist-get (cdr elem) :value))
 		    values)
 	      (setq rest nil))))))
-    (debug values)
-    (let ((shr-base eww-current-url))
       (if (and (stringp (cdr (assq :method form)))
 	       (equal (downcase (cdr (assq :method form))) "post"))
 	  (let ((url-request-method "POST")
 		(url-request-extra-headers
 		 '(("Content-Type" . "application/x-www-form-urlencoded")))
 		(url-request-data (mm-url-encode-www-form-urlencoded values)))
-	    (eww-browse-url (shr-expand-url (cdr (assq :action form)))))
+	  (eww-browse-url (shr-expand-url (cdr (assq :action form))
+					  eww-current-url)))
 	(eww-browse-url
 	 (concat
 	  (if (cdr (assq :action form))
-	      (shr-expand-url (cdr (assq :action form)))
+	    (shr-expand-url (cdr (assq :action form))
+			    eww-current-url)
 	    eww-current-url)
 	  "?"
-	  (mm-url-encode-www-form-urlencoded values)))))))
+	(mm-url-encode-www-form-urlencoded values))))))
 
 (defun eww-convert-widgets ()
   (let ((start (point-min))
diff --git a/lisp/shr.el b/lisp/shr.el
index c93357e..13f376b 100644
--- a/lisp/shr.el
+++ b/lisp/shr.el
@@ -484,31 +484,37 @@ size, and full-buffer size."
 	 (forward-char 1))))
     (not failed)))
 
-(defun shr-expand-url (url)
-  (if (or (not url)
-	  (string-match "\\`[a-z]*:" url)
-	  (not shr-base))
-      ;; Absolute URL.
-      url
-    (let ((base shr-base))
+(defun shr-parse-base (url)
+  (let* ((parsed (url-generic-parse-url url))
+	 (local (url-filename parsed)))
+    (setf (url-filename parsed) "")
       ;; Chop off query string.
-      (when (string-match "\\`\\([^?]+\\)[?]" base)
-	(setq base (match-string 1 base)))
-      ;; Chop off the bit after the last slash.
-      (when (string-match "\\`\\(.*\\)[/][^/]+" base)
-	(setq base (match-string 1 base)))
-      (cond
-       ((and (string-match "\\`//" url)
-	     (string-match "\\`[a-z]*:" base))
-	(concat (match-string 0 base) url))
-       ((and (not (string-match "/\\'" base))
-	     (not (string-match "\\`/" url)))
-	(concat base "/" url))
-       ((and (string-match "\\`/" url)
-	     (string-match "\\(\\`[^:]*://[^/]+\\)/" base))
-	(concat (match-string 1 base) url))
+    (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 "/")))
+    (cons (url-recreate-url parsed)
+	  local)))
+
+(defun shr-expand-url (url &optional base)
+  (setq base
+	(if base
+	    (shr-parse-base base)
+	  ;; Bound by the parser.
+	  shr-base))
+  (cond ((or (not url)
+	     (not base)
+	     (string-match "\\`[a-z]*:" url))
+	 ;; Absolute URL.
+	 (or url (car base)))
+	((eq (aref url 0) ?/)
+	 ;; Just use the host name part.
+	 (concat (car base) url))
        (t
-	(concat base url))))))
+	 ;; Totally relative.
+	 (concat (car base) (cdr base) url))))
 
 (defun shr-ensure-newline ()
   (unless (zerop (current-column))
@@ -965,7 +971,7 @@ ones, in case fg and bg are nil."
       plist)))
 
 (defun shr-tag-base (cont)
-  (setq shr-base (cdr (assq :href cont)))
+  (setq shr-base (shr-parse-base (cdr (assq :href cont))))
   (shr-generic cont))
 
 (defun shr-tag-a (cont)

-----------------------------------------------------------------------
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 |    7 ++++++
 lisp/eww.el    |   32 +++++++++++++++---------------
 lisp/shr.el    |   58 ++++++++++++++++++++++++++++++-------------------------
 3 files changed, 55 insertions(+), 42 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