Merge from mainline.

10 files changed, 139 insertions, 53 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index e8308059963..e80de4e9175 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,32 @@
+2011-02-12  Thierry Volpiatto  <thierry.volpiatto@gmail.com>
+
+        * files.el (copy-directory): New argument COPY-CONTENTS for
+        copying directory contents into another existing directory.
+
+2011-02-12  Tassilo Horn  <tassilo@member.fsf.org>
+
+        * minibuffer.el (completion-table-case-fold): New function for
+        creating a case-insensitive completion table.
+
+2011-02-12  Teodor Zlatanov  <tzz@lifelogs.com>
+
+        * net/tramp.el (tramp-default-method): Also check if
+        `auth-source-search' is bound.
+        (tramp-read-passwd): Use `auth-source-search' instead of
+        `auto-source-user-or-password'.
+
+        * net/tramp-imap.el: Autoload `auto-source-search' instead of
+        `auto-source-user-or-password.
+        (tramp-imap-passphrase-callback-function): Use it.
+
+        * net/imap-hash.el: Autoload `auto-source-search' instead of
+        `auto-source-user-or-password.
+        (imap-hash-open-connection): Use it.
+
+        * mail/smtpmail.el: Autoload `auto-source-search' instead of
+        `auto-source-user-or-password.
+        (smtpmail-try-auth-methods): Use it.
+
 2011-02-12  Phil Hagelberg  <phil@hagelb.org>
 
         * emacs-lisp/package.el: Allow packages to be reinstalled.
diff --git a/lisp/files.el b/lisp/files.el
index 43b31cb0a7a..2d3dbc67d72 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -4826,10 +4826,8 @@ given.  With a prefix argument, TRASH is nil."
                  directory 'full directory-files-no-dot-files-regexp)))
       (delete-directory-internal directory)))))
 
-(defun copy-directory (directory newname &optional keep-time parents)
+(defun copy-directory (directory newname &optional keep-time parents copy-contents)
   "Copy DIRECTORY to NEWNAME.  Both args must be strings.
-If NEWNAME names an existing directory, copy DIRECTORY as subdirectory there.
-
 This function always sets the file modes of the output files to match
 the corresponding input file.
 
@@ -4840,7 +4838,12 @@ A prefix arg makes KEEP-TIME non-nil.
 
 Noninteractively, the last argument PARENTS says whether to
 create parent directories if they don't exist.  Interactively,
-this happens by default."
+this happens by default.
+
+If NEWNAME names an existing directory, copy DIRECTORY as a
+subdirectory there.  However, if called from Lisp with a non-nil
+optional argument COPY-CONTENTS, copy the contents of DIRECTORY
+directly into NEWNAME instead."
   (interactive
    (let ((dir (read-directory-name
                "Copy directory: " default-directory default-directory t nil)))
@@ -4848,7 +4851,7 @@ this happens by default."
            (read-file-name
             (format "Copy directory %s to: " dir)
             default-directory default-directory nil nil)
-           current-prefix-arg t)))
+           current-prefix-arg t nil)))
   ;; If default-directory is a remote directory, make sure we find its
   ;; copy-directory handler.
   (let ((handler (or (find-file-name-handler directory 'copy-directory)
@@ -4860,21 +4863,22 @@ this happens by default."
       (setq directory (directory-file-name (expand-file-name directory))
             newname   (directory-file-name (expand-file-name newname)))
 
-      (if (not (file-directory-p newname))
-          ;; If NEWNAME is not an existing directory, create it; that
-          ;; is where we will copy the files of DIRECTORY.
-          (make-directory newname parents)
-        ;; If NEWNAME is an existing directory, we will copy into
-        ;; NEWNAME/[DIRECTORY-BASENAME].
-        (setq newname (expand-file-name
-                       (file-name-nondirectory
-                        (directory-file-name directory))
-                       newname))
-        (and (file-exists-p newname)
-             (not (file-directory-p newname))
-             (error "Cannot overwrite non-directory %s with a directory"
-                    newname))
-        (make-directory newname t))
+      (cond ((not (file-directory-p newname))
+             ;; If NEWNAME is not an existing directory, create it;
+             ;; that is where we will copy the files of DIRECTORY.
+             (make-directory newname parents))
+            ;; If NEWNAME is an existing directory and COPY-CONTENTS
+            ;; is nil, copy into NEWNAME/[DIRECTORY-BASENAME].
+            ((not copy-contents)
+             (setq newname (expand-file-name
+                            (file-name-nondirectory
+                             (directory-file-name directory))
+                            newname))
+             (and (file-exists-p newname)
+                  (not (file-directory-p newname))
+                  (error "Cannot overwrite non-directory %s with a directory"
+                         newname))
+             (make-directory newname t)))
 
       ;; Copy recursively.
       (dolist (file
diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el
index f726304704b..427d9d17746 100644
--- a/lisp/mail/smtpmail.el
+++ b/lisp/mail/smtpmail.el
@@ -77,7 +77,7 @@
 (autoload 'netrc-machine "netrc")
 (autoload 'netrc-get "netrc")
 (autoload 'password-read "password-cache")
-(autoload 'auth-source-user-or-password "auth-source")
+(autoload 'auth-source-search "auth-source")
 
 ;;;
 (defgroup smtpmail nil
@@ -538,10 +538,14 @@ The list is in preference order.")
 (defun smtpmail-try-auth-methods (process supported-extensions host port)
   (let* ((mechs (cdr-safe (assoc 'auth supported-extensions)))
          (mech (car (smtpmail-intersection mechs smtpmail-auth-supported)))
-         (auth-user (auth-source-user-or-password
-                     "login" host (or port "smtp")))
-         (auth-pass (auth-source-user-or-password
-                     "password" host (or port "smtp")))
+         (auth-info (auth-source-search :max 1
+                                        :host host
+                                        :port (or port "smtp")))
+         (auth-user (plist-get (nth 0 auth-info) :user))
+         (auth-pass (plist-get (nth 0 auth-info) :secret))
+         (auth-pass (if (functionp auth-pass)
+                        (funcall auth-pass)
+                      auth-pass))
          (cred (if (and auth-user auth-pass) ; try user-auth-* before netrc-*
                    (list host port auth-user auth-pass)
                  ;; else, if auth-source didn't return them...
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 1b42ee1f2ce..3c8628c9cfa 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -196,6 +196,10 @@ You should give VAR a non-nil `risky-local-variable' property."
           (setq ,var (,fun)))
         ,var))))
 
+(defun completion-table-case-fold (table string pred action)
+  (let ((completion-ignore-case t))
+    (complete-with-action action table string pred)))
+
 (defun completion-table-with-context (prefix table string pred action)
   ;; TODO: add `suffix' maybe?
   ;; Notice that `pred' may not be a function in some abusive cases.
diff --git a/lisp/net/imap-hash.el b/lisp/net/imap-hash.el
index d21b714d950..a07277cee68 100644
--- a/lisp/net/imap-hash.el
+++ b/lisp/net/imap-hash.el
@@ -43,7 +43,7 @@
 (require 'imap)
 (require 'sendmail)                     ; for mail-header-separator
 (require 'message)
-(autoload 'auth-source-user-or-password "auth-source")
+(autoload 'auth-source-search "auth-source")
 
 ;; retrieve these headers
 (defvar imap-hash-headers
@@ -267,13 +267,14 @@ The function is passed the message headers (see `imap-hash-get-headers')."
                               (imap-hash-password iht))))
          ;; this will not be needed if auth-need is t
          (auth-info (when auth-need
-                      (auth-source-user-or-password
-                       '("login" "password")
-                       server port)))
+                      (nth 0 (auth-source-search :host server :port port))))
          (auth-user (or (imap-hash-user iht)
-                        (nth 0 auth-info)))
+                        (plist-get auth-info :user)))
          (auth-passwd (or (imap-hash-password iht)
-                          (nth 1 auth-info)))
+                          (plist-get auth-info :secret)))
+         (auth-passwd (if (functionp auth-passwd)
+                          (funcall auth-passwd)
+                        auth-passwd))
          (imap-logout-timeout nil))
 
         ;; (debug "opening server: opened+state" (imap-opened) imap-state)
diff --git a/lisp/net/tramp-imap.el b/lisp/net/tramp-imap.el
index 3a536103c3d..4157265b0e1 100644
--- a/lisp/net/tramp-imap.el
+++ b/lisp/net/tramp-imap.el
@@ -56,7 +56,7 @@
 (require 'assoc)
 (require 'tramp)
 
-(autoload 'auth-source-user-or-password "auth-source")
+(autoload 'auth-source-search "auth-source")
 (autoload 'epg-context-operation "epg")
 (autoload 'epg-context-set-armor "epg")
 (autoload 'epg-context-set-passphrase-callback "epg")
@@ -639,8 +639,14 @@ HANDBACK is just carried through.
 KEY-ID can be 'SYM or 'PIN among others."
   (let* ((server tramp-current-host)
          (port "tramp-imap")            ; this is NOT the server password!
-         (auth-passwd
-          (auth-source-user-or-password "password" server port)))
+         (auth-passwd (plist-get
+                       (nth 0 (auth-source-search :max 1
+                                                  :host server
+                                                  :port port))
+                       :secret))
+         (auth-passwd (if (functionp auth-passwd)
+                          (funcall auth-passwd)
+                        auth-passwd)))
     (or
      (copy-sequence auth-passwd)
      ;; If we cache the passphrase and we have one.
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 8584d4ddc92..5d0f3935884 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -297,6 +297,7 @@ shouldn't return t when it isn't."
          (executable-find "pscp"))
     (if (or (fboundp 'password-read)
             (fboundp 'auth-source-user-or-password)
+            (fboundp 'auth-source-search)
             ;; Pageant is running.
             (tramp-compat-process-running-p "Pageant"))
         "pscp"
@@ -307,6 +308,7 @@ shouldn't return t when it isn't."
      ((tramp-detect-ssh-controlmaster) "scpc")
      ((or (fboundp 'password-read)
           (fboundp 'auth-source-user-or-password)
+          (fboundp 'auth-source-search)
           ;; ssh-agent is running.
           (getenv "SSH_AUTH_SOCK")
           (getenv "SSH_AGENT_PID"))
@@ -3519,7 +3521,8 @@ Invokes `password-read' if available, `read-passwd' else."
           (or prompt
               (with-current-buffer (process-buffer proc)
                 (tramp-check-for-regexp proc tramp-password-prompt-regexp)
-                (format "%s for %s " (capitalize (match-string 1)) key)))))
+                (format "%s for %s " (capitalize (match-string 1)) key))))
+         auth-info auth-passwd)
     (with-parsed-tramp-file-name key nil
       (prog1
           (or
@@ -3527,9 +3530,22 @@ Invokes `password-read' if available, `read-passwd' else."
            (and (boundp 'auth-sources)
                 (tramp-get-connection-property v "first-password-request" nil)
                 ;; Try with Tramp's current method.
-                (tramp-compat-funcall
-                 'auth-source-user-or-password
-                 "password" tramp-current-host tramp-current-method))
+                (if (fboundp 'auth-source-search)
+                    (progn
+                      (setq auth-info
+                            (tramp-compat-funcall
+                             'auth-source-search
+                             :max 1
+                             :user (or tramp-current-user t)
+                             :host tramp-current-host
+                             :port tramp-current-method))
+                      (setq auth-passwd (plist-get (nth 0 auth-info) :secret))
+                      (setq auth-passwd (if (functionp auth-passwd)
+                                            (funcall auth-passwd)
+                                          auth-passwd)))
+                  (tramp-compat-funcall
+                   'auth-source-user-or-password
+                   "password" tramp-current-host tramp-current-method)))
            ;; Try the password cache.
            (when (functionp 'password-read)
              (unless (tramp-get-connection-property
diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog
index 742a3cfb9b5..3c7b8b6abe7 100644
--- a/lisp/url/ChangeLog
+++ b/lisp/url/ChangeLog
@@ -1,3 +1,13 @@
+2011-02-12  Teodor Zlatanov  <tzz@lifelogs.com>
+
+        * url-parse.el (url-bit-for-url, url-user-for-url)
+        (url-password-for-url): Use `auto-source-search' instead of
+        `auto-source-user-or-password'.
+
+        * url-auth.el: Autoload `auto-source-search' instead of
+        `auto-source-user-or-password'.
+        (url-basic-auth, url-digest-auth, url-do-auth-source-search): Use it.
+
 2011-02-03  Lars Ingebrigtsen  <larsi@gnus.org>
 
         * url-http.el (url-http-wait-for-headers-change-function): Don't
diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el
index 842e2a3be8d..5261302a15c 100644
--- a/lisp/url/url-auth.el
+++ b/lisp/url/url-auth.el
@@ -24,7 +24,7 @@
 (require 'url-vars)
 (require 'url-parse)
 (autoload 'url-warn "url")
-(autoload 'auth-source-user-or-password "auth-source")
+(autoload 'auth-source-search "auth-source")
 
 (defsubst url-auth-user-prompt (url realm)
   "String to usefully prompt for a username."
@@ -81,11 +81,11 @@ instead of the filename inheritance method."
     (cond
      ((and prompt (not byserv))
       (setq user (or
-                  (auth-source-user-or-password "login" server type)
+                  (url-do-auth-source-search server type :user)
                   (read-string (url-auth-user-prompt url realm)
                                (or user (user-real-login-name))))
             pass (or
-                  (auth-source-user-or-password "password" server type)
+                  (url-do-auth-source-search server type :secret)
                   (read-passwd "Password: " nil (or pass ""))))
       (set url-basic-auth-storage
            (cons (list server
@@ -110,11 +110,11 @@ instead of the filename inheritance method."
       (if (or (and (not retval) prompt) overwrite)
           (progn
             (setq user (or
-                        (auth-source-user-or-password "login" server type)
+                        (url-do-auth-source-search server type :user)
                         (read-string (url-auth-user-prompt url realm)
                                      (user-real-login-name)))
                   pass (or
-                        (auth-source-user-or-password "password" server type)
+                        (url-do-auth-source-search server type :secret)
                         (read-passwd "Password: "))
                   retval (base64-encode-string (format "%s:%s" user pass))
                   byserv (assoc server (symbol-value url-basic-auth-storage)))
@@ -173,11 +173,11 @@ instead of hostname:portnum."
         (cond
          ((and prompt (not byserv))
           (setq user (or
-                      (auth-source-user-or-password "login" server type)
+                      (url-do-auth-source-search server type :user)
                       (read-string (url-auth-user-prompt url realm)
                                    (user-real-login-name)))
                 pass (or
-                      (auth-source-user-or-password "password" server type)
+                      (url-do-auth-source-search server type :secret)
                       (read-passwd "Password: "))
                 url-digest-auth-storage
                 (cons (list server
@@ -204,11 +204,11 @@ instead of hostname:portnum."
           (if overwrite
               (if (and (not retval) prompt)
                   (setq user (or
-                              (auth-source-user-or-password "login" server type)
+                              (url-do-auth-source-search server type :user)
                               (read-string (url-auth-user-prompt url realm)
                                            (user-real-login-name)))
                         pass (or
-                              (auth-source-user-or-password "password" server type)
+                              (url-do-auth-source-search server type :secret)
                               (read-passwd "Password: "))
                         retval (setq retval
                                      (cons user
@@ -244,6 +244,13 @@ instead of hostname:portnum."
   "A list of the registered authorization schemes and various and sundry
 information associated with them.")
 
+(defun url-do-auth-source-search (server type parameter)
+  (let* ((auth-info (auth-source-search :max 1 :host server :port type))
+         (auth-info (nth 0 auth-info))
+         (token (plist-get auth-info parameter))
+         (token (if (functionp token) (funcall token) token)))
+    token))
+
 ;;;###autoload
 (defun url-get-authentication (url realm type prompt &optional args)
   "Return an authorization string suitable for use in the WWW-Authenticate
diff --git a/lisp/url/url-parse.el b/lisp/url/url-parse.el
index 950f666e9c7..71c03bf1edd 100644
--- a/lisp/url/url-parse.el
+++ b/lisp/url/url-parse.el
@@ -178,20 +178,25 @@ TYPE USER PASSWORD HOST PORTSPEC FILENAME TARGET ATTRIBUTES FULLNESS."
   `(let* ((urlobj (url-generic-parse-url url))
           (bit (funcall ,method urlobj))
           (methods (list 'url-recreate-url
-                         'url-host)))
+                         'url-host))
+          auth-info)
      (while (and (not bit) (> (length methods) 0))
-       (setq bit
-             (auth-source-user-or-password
-              ,lookfor (funcall (pop methods) urlobj) (url-type urlobj))))
+       (setq auth-info (auth-source-search
+                        :max 1
+                        :host (funcall (pop methods) urlobj)
+                        :port (url-type urlobj)))
+       (setq bit (plist-get (nth 0 auth-info) ,lookfor))
+       (when (functionp bit)
+         (setq bit (funcall bit))))
      bit))
 
 (defun url-user-for-url (url)
   "Attempt to use .authinfo to find a user for this URL."
-  (url-bit-for-url 'url-user "login" url))
+  (url-bit-for-url 'url-user :user url))
 
 (defun url-password-for-url (url)
   "Attempt to use .authinfo to find a password for this URL."
-  (url-bit-for-url 'url-password "password" url))
+  (url-bit-for-url 'url-password :secret url))
 
 (provide 'url-parse)