Misc url-cookie tidy-up.

* lisp/url/url-cookie.el: Don't require cl when compiling.
(url-cookie-clean-up, url-cookie-generate-header-lines): Use dolist.
(url-cookie-parse-file, url-cookie-store, url-cookie-retrieve)
(url-cookie-handle-set-cookie): Simplify.

2 files changed, 104 insertions, 155 deletions

diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog
index 5fd96e43b6b..619375b0249 100644
--- a/lisp/url/ChangeLog
+++ b/lisp/url/ChangeLog
@@ -1,3 +1,10 @@
+2010-12-14  Glenn Morris  <rgm@gnu.org>
+
+        * url-cookie.el: Don't require cl when compiling.
+        (url-cookie-clean-up, url-cookie-generate-header-lines): Use dolist.
+        (url-cookie-parse-file, url-cookie-store, url-cookie-retrieve)
+        (url-cookie-handle-set-cookie): Simplify.
+
 2010-12-13  Chong Yidong  <cyd@stupidchicken.com>
 
         * url-cookie.el (url-cookie-retrieve): Handle null LOCALPART.
@@ -2363,11 +2370,10 @@
 
 ;; Local variables:
 ;; coding: utf-8
-;; add-log-time-zone-rule: t
 ;; End:
 
-    Copyright (C) 1999, 2001, 2002, 2004, 2005,
-        2006, 2007, 2008, 2009, 2010  Free Software Foundation, Inc.
+  Copyright (C) 1999, 2001, 2002, 2004, 2005, 2006, 2007, 2008, 2009,
+    2010  Free Software Foundation, Inc.
 
   This file is part of GNU Emacs.
 
@@ -2384,4 +2390,3 @@
   You should have received a copy of the GNU General Public License
   along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
-;; arch-tag: ac117078-3091-4533-be93-098162ac2926
diff --git a/lisp/url/url-cookie.el b/lisp/url/url-cookie.el
index ec0974e9d76..78dccac19c2 100644
--- a/lisp/url/url-cookie.el
+++ b/lisp/url/url-cookie.el
@@ -1,4 +1,4 @@
-;;; url-cookie.el --- Netscape Cookie support
+;;; url-cookie.el --- URL cookie support
 
 ;; Copyright (C) 1996, 1997, 1998, 1999, 2004, 2005, 2006, 2007, 2008,
 ;;   2009, 2010  Free Software Foundation, Inc.
@@ -26,10 +26,6 @@
 
 (require 'url-util)
 (require 'url-parse)
-(eval-when-compile (require 'cl))
-
-;; See http://home.netscape.com/newsref/std/cookie_spec.html for the
-;; 'open standard' defining this crap.
 
 (defgroup url-cookie nil
   "URL cookies."
@@ -76,41 +72,23 @@ telling Microsoft that."
   "Whether the cookies list has changed since the last save operation.")
 
 (defun url-cookie-parse-file (&optional fname)
-  (setq fname (or fname url-cookie-file))
-  (condition-case ()
-      (load fname nil t)
-    (error
-     ;; It's completely normal for the cookies file not to exist yet.
-     ;; (message "Could not load cookie file %s" fname)
-     )))
+  "Load FNAME, default `url-cookie-file'."
+  ;; It's completely normal for the cookies file not to exist yet.
+  (load (or fname url-cookie-file) t t))
 
 (declare-function url-cookie-p "url-cookie" t t) ; defstruct
 
 (defun url-cookie-clean-up (&optional secure)
-  (let* (
-         (var (if secure 'url-cookie-secure-storage 'url-cookie-storage))
-         (val (symbol-value var))
-         (cur nil)
-         (new nil)
-         (cookies nil)
-         (cur-cookie nil)
-         (new-cookies nil)
-         )
-    (while val
-      (setq cur (car val)
-            val (cdr val)
-            new-cookies nil
-            cookies (cdr cur))
-      (while cookies
-        (setq cur-cookie (car cookies)
-              cookies (cdr cookies))
-        (if (or (not (url-cookie-p cur-cookie))
-                (url-cookie-expired-p cur-cookie)
-                (null (url-cookie-expires cur-cookie)))
-            nil
-          (setq new-cookies (cons cur-cookie new-cookies))))
-      (if (not new-cookies)
-          nil
+  (let ((var (if secure 'url-cookie-secure-storage 'url-cookie-storage))
+        new new-cookies)
+    (dolist (cur (symbol-value var))
+      (setq new-cookies nil)
+      (dolist (cur-cookie (cdr cur))
+        (or (not (url-cookie-p cur-cookie))
+            (url-cookie-expired-p cur-cookie)
+            (null (url-cookie-expires cur-cookie))
+            (setq new-cookies (cons cur-cookie new-cookies))))
+      (when new-cookies
         (setcdr cur new-cookies)
         (setq new (cons cur new))))
     (set var new)))
@@ -143,54 +121,42 @@ telling Microsoft that."
     (setq url-cookies-changed-since-last-save nil))))
 
 (defun url-cookie-store (name value &optional expires domain localpart secure)
-  "Store a netscape-style cookie."
-  (let* ((storage (if secure url-cookie-secure-storage url-cookie-storage))
-         (tmp storage)
-         (cur nil)
-         (found-domain nil))
-
-    ;; First, look for a matching domain
-    (setq found-domain (assoc domain storage))
-
-    (if found-domain
+  "Store a cookie."
+  (let ((storage (if secure url-cookie-secure-storage url-cookie-storage))
+        tmp found-domain)
+    ;; First, look for a matching domain.
+    (if (setq found-domain (assoc domain storage))
         ;; Need to either stick the new cookie in existing domain storage
         ;; or possibly replace an existing cookie if the names match.
-        (progn
-          (setq storage (cdr found-domain)
-                tmp nil)
-          (while storage
-            (setq cur (car storage)
-                  storage (cdr storage))
-            (if (and (equal localpart (url-cookie-localpart cur))
-                     (equal name (url-cookie-name cur)))
-                (progn
-                  (setf (url-cookie-expires cur) expires)
-                  (setf (url-cookie-value cur) value)
-                  (setq tmp t))))
-          (if (not tmp)
-              ;; New cookie
-              (setcdr found-domain (cons
-                                    (url-cookie-create :name name
-                                                       :value value
-                                                       :expires expires
-                                                       :domain domain
-                                                       :localpart localpart
-                                                       :secure secure)
-                                    (cdr found-domain)))))
-      ;; Need to add a new top-level domain
+        (unless (dolist (cur (setq storage (cdr found-domain)) tmp)
+                  (and (equal localpart (url-cookie-localpart cur))
+                       (equal name (url-cookie-name cur))
+                       (progn
+                         (setf (url-cookie-expires cur) expires)
+                         (setf (url-cookie-value cur) value)
+                         (setq tmp t))))
+          ;; New cookie.
+          (setcdr found-domain (cons
+                                (url-cookie-create :name name
+                                                   :value value
+                                                   :expires expires
+                                                   :domain domain
+                                                   :localpart localpart
+                                                   :secure secure)
+                                (cdr found-domain))))
+      ;; Need to add a new top-level domain.
       (setq tmp (url-cookie-create :name name
                                    :value value
                                    :expires expires
                                    :domain domain
                                    :localpart localpart
                                    :secure secure))
-      (cond
-       (storage
-        (setcdr storage (cons (list domain tmp) (cdr storage))))
-       (secure
-        (setq url-cookie-secure-storage (list (list domain tmp))))
-       (t
-        (setq url-cookie-storage (list (list domain tmp))))))))
+      (cond (storage
+             (setcdr storage (cons (list domain tmp) (cdr storage))))
+            (secure
+             (setq url-cookie-secure-storage (list (list domain tmp))))
+            (t
+             (setq url-cookie-storage (list (list domain tmp))))))))
 
 (defun url-cookie-expired-p (cookie)
   "Return non-nil if COOKIE is expired."
@@ -203,14 +169,9 @@ telling Microsoft that."
                      (append url-cookie-secure-storage url-cookie-storage)
                    url-cookie-storage))
         (case-fold-search t)
-        (cookies nil)
-        (cur nil)
-        (retval nil)
-        (localpart-match nil))
-    (while storage
-      (setq cur (car storage)
-            storage (cdr storage)
-            cookies (cdr cur))
+        cookies retval localpart-match)
+    (dolist (cur storage)
+      (setq cookies (cdr cur))
       (if (and (car cur)
                (string-match
                 (concat "^.*"
@@ -222,36 +183,28 @@ telling Microsoft that."
                            (car cur)))
                         "$") host))
           ;; The domains match - a possible hit!
-          (while cookies
-            (setq cur (car cookies)
-                  cookies (cdr cookies)
-                  localpart-match (url-cookie-localpart cur))
-            (if (and (if (and (stringp localpart-match)
-                              (stringp localpart))
-                         (string-match (concat "^" (regexp-quote
-                                                    localpart-match))
-                                       localpart)
-                       (equal localpart localpart-match))
-                     (not (url-cookie-expired-p cur)))
-                (setq retval (cons cur retval))))))
+          (dolist (cur cookies)
+            (and (if (and (stringp
+                           (setq localpart-match (url-cookie-localpart cur)))
+                          (stringp localpart))
+                     (string-match (concat "^" (regexp-quote localpart-match))
+                                   localpart)
+                   (equal localpart localpart-match))
+                 (not (url-cookie-expired-p cur))
+                 (setq retval (cons cur retval))))))
     retval))
 
 (defun url-cookie-generate-header-lines (host localpart secure)
-  (let* ((cookies (url-cookie-retrieve host localpart secure))
-         (retval nil)
-         (cur nil)
-         (chunk nil))
-    ;; Have to sort this for sending most specific cookies first
+  (let ((cookies (url-cookie-retrieve host localpart secure))
+        retval chunk)
+    ;; Have to sort this for sending most specific cookies first.
     (setq cookies (and cookies
                        (sort cookies
-                             (function
-                              (lambda (x y)
-                                (> (length (url-cookie-localpart x))
-                                   (length (url-cookie-localpart y))))))))
-    (while cookies
-      (setq cur (car cookies)
-            cookies (cdr cookies)
-            chunk (format "%s=%s" (url-cookie-name cur) (url-cookie-value cur))
+                             (lambda (x y)
+                               (> (length (url-cookie-localpart x))
+                                  (length (url-cookie-localpart y)))))))
+    (dolist (cur cookies)
+      (setq chunk (format "%s=%s" (url-cookie-name cur) (url-cookie-value cur))
             retval (if (and url-cookie-multiple-line
                             (< 80 (+ (length retval) (length chunk) 4)))
                        (concat retval "\r\nCookie: " chunk)
@@ -321,40 +274,38 @@ telling Microsoft that."
                         (file-name-directory
                          (url-filename url-current-object))))
          (rest nil))
-    (while args
-      (if (not (member (downcase (car (car args)))
-                       '("secure" "domain" "expires" "path")))
-          (setq rest (cons (car args) rest)))
-      (setq args (cdr args)))
+    (dolist (this args)
+      (or (member (downcase (car this)) '("secure" "domain" "expires" "path"))
+          (setq rest (cons this rest))))
 
     ;; Sometimes we get dates that the timezone package cannot handle very
     ;; gracefully - take care of this here, instead of in url-cookie-expired-p
     ;; to speed things up.
-    (if (and expires
-             (string-match
-              (concat "^[^,]+, +\\(..\\)-\\(...\\)-\\(..\\) +"
-                      "\\(..:..:..\\) +\\[*\\([^\]]+\\)\\]*$")
-              expires))
-        (setq expires (concat (match-string 1 expires) " "
-                              (match-string 2 expires) " "
-                              (match-string 3 expires) " "
-                              (match-string 4 expires) " ["
-                              (match-string 5 expires) "]")))
+    (and expires
+         (string-match
+          (concat "^[^,]+, +\\(..\\)-\\(...\\)-\\(..\\) +"
+                  "\\(..:..:..\\) +\\[*\\([^\]]+\\)\\]*$")
+          expires)
+         (setq expires (concat (match-string 1 expires) " "
+                               (match-string 2 expires) " "
+                               (match-string 3 expires) " "
+                               (match-string 4 expires) " ["
+                               (match-string 5 expires) "]")))
 
     ;; This one is for older Emacs/XEmacs variants that don't
     ;; understand this format without tenths of a second in it.
     ;; Wednesday, 30-Dec-2037 16:00:00 GMT
     ;;       - vs -
     ;; Wednesday, 30-Dec-2037 16:00:00.00 GMT
-    (if (and expires
-             (string-match
-              "\\([0-9]+\\)-\\([A-Za-z]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+:[0-9]+\\)\\(\\.[0-9]+\\)*[ \t]+\\([-+a-zA-Z0-9]+\\)"
-              expires))
-        (setq expires (concat (match-string 1 expires) "-"      ; day
-                              (match-string 2 expires) "-"      ; month
-                              (match-string 3 expires) " "      ; year
-                              (match-string 4 expires) ".00 " ; hour:minutes:seconds
-                              (match-string 6 expires)))) ":" ; timezone
+    (and expires
+         (string-match
+          "\\([0-9]+\\)-\\([A-Za-z]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+:[0-9]+\\)\\(\\.[0-9]+\\)*[ \t]+\\([-+a-zA-Z0-9]+\\)"
+          expires)
+         (setq expires (concat (match-string 1 expires) "-"     ; day
+                               (match-string 2 expires) "-"     ; month
+                               (match-string 3 expires) " "     ; year
+                               (match-string 4 expires) ".00 " ; hour:minutes:seconds
+                               (match-string 6 expires)))) ":" ; timezone
 
     (while (consp trusted)
       (if (string-match (car trusted) current-url)
@@ -364,42 +315,36 @@ telling Microsoft that."
       (if (string-match (car untrusted) current-url)
           (setq untrusted (- (match-end 0) (match-beginning 0)))
         (pop untrusted)))
-    (if (and trusted untrusted)
-        ;; Choose the more specific match
-        (if (> trusted untrusted)
-            (setq untrusted nil)
-          (setq trusted nil)))
+    (and trusted untrusted
+         ;; Choose the more specific match.
+         (set (if (> trusted untrusted) 'untrusted 'trusted) nil))
     (cond
      (untrusted
-      ;; The site was explicity marked as untrusted by the user
+      ;; The site was explicity marked as untrusted by the user.
       nil)
      ((or (eq url-privacy-level 'paranoid)
           (and (listp url-privacy-level) (memq 'cookies url-privacy-level)))
-      ;; user never wants cookies
+      ;; User never wants cookies.
       nil)
      ((and url-cookie-confirmation
            (not trusted)
            (save-window-excursion
              (with-output-to-temp-buffer "*Cookie Warning*"
                (mapcar
-                (function
-                 (lambda (x)
-                   (princ (format "%s - %s" (car x) (cdr x))))) rest))
+                (lambda (x)
+                  (princ (format "%s - %s" (car x) (cdr x)))) rest))
              (prog1
                  (not (funcall url-confirmation-func
                                (format "Allow %s to set these cookies? "
                                        (url-host url-current-object))))
                (if (get-buffer "*Cookie Warning*")
                    (kill-buffer "*Cookie Warning*")))))
-      ;; user wants to be asked, and declined.
+      ;; User wants to be asked, and declined.
       nil)
      ((url-cookie-host-can-set-p (url-host url-current-object) domain)
-      ;; Cookie is accepted by the user, and passes our security checks
-      (let ((cur nil))
-        (while rest
-          (setq cur (pop rest))
-          (url-cookie-store (car cur) (cdr cur)
-                            expires domain localpart secure))))
+      ;; Cookie is accepted by the user, and passes our security checks.
+      (dolist (cur rest)
+        (url-cookie-store (car cur) (cdr cur) expires domain localpart secure)))
      (t
       (url-lazy-message "%s tried to set a cookie for domain %s - rejected."
                         (url-host url-current-object) domain)))))
@@ -430,5 +375,4 @@ to run the `url-cookie-setup-save-timer' function manually."
 
 (provide 'url-cookie)
 
-;; arch-tag: 2568751b-6452-4398-aa2d-303edadb54d7
 ;;; url-cookie.el ends here