[Emacs-diffs] Changes to emacs/lisp/url/url-http.el,v

[Magnus Henoch]

CVSROOT:        /sources/emacs
Module name:    emacs
Changes by:     Magnus Henoch <legoscia>        06/11/08 20:34:36

Index: url-http.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/url/url-http.el,v
retrieving revision 1.39
retrieving revision 1.40
diff -u -b -r1.39 -r1.40
--- url-http.el 2 Nov 2006 23:06:20 -0000       1.39
+++ url-http.el 8 Nov 2006 20:34:36 -0000       1.40
@@ -313,21 +313,27 @@
        (type nil)
        (url (url-recreate-url url-current-object))
        (url-basic-auth-storage 'url-http-real-basic-auth-storage)
-       auth)
+       auth
+       (strength 0))
     ;; Cheating, but who cares? :)
     (if proxy
        (setq url-basic-auth-storage 'url-http-proxy-basic-auth-storage))
 
-    ;; find first supported auth
-    (while auths
-      (setq auth (url-eat-trailing-space (url-strip-leading-spaces (car 
auths))))
-      (if (string-match "[ \t]" auth)
-         (setq type (downcase (substring auth 0 (match-beginning 0))))
-       (setq type (downcase auth)))
-      (if (url-auth-registered type)
-         (setq auths nil)              ; no more check
-       (setq auth nil
-             auths (cdr auths))))
+    ;; find strongest supported auth
+    (dolist (this-auth auths)
+      (setq this-auth (url-eat-trailing-space 
+                      (url-strip-leading-spaces 
+                       this-auth)))
+      (let* ((this-type 
+             (if (string-match "[ \t]" this-auth)
+                 (downcase (substring this-auth 0 (match-beginning 0)))
+               (downcase this-auth)))
+            (registered (url-auth-registered this-type))
+            (this-strength (cddr registered)))
+       (when (and registered (> this-strength strength))
+         (setq auth this-auth
+               type this-type
+               strength this-strength))))
 
     (if (not (url-auth-registered type))
        (progn