Merge remote-tracking branch 'savannah/master' into HEAD

1 files changed, 68 insertions, 78 deletions

diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el
index 52470196f62..af0a1983766 100644
--- a/lisp/gnus/mail-source.el
+++ b/lisp/gnus/mail-source.el
@@ -1,4 +1,4 @@
-;;; mail-source.el --- functions for fetching mail
+;;; mail-source.el --- functions for fetching mail  -*- lexical-binding: t; -*-
 
 ;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
 
@@ -56,7 +56,6 @@
   "Where the mail backends will look for incoming mail.
 This variable is a list of mail source specifiers.
 See Info node `(gnus)Mail Source Specifiers'."
-  :group 'mail-source
   :version "24.4"
   :link '(custom-manual "(gnus)Mail Source Specifiers")
   :type `(choice
@@ -230,33 +229,27 @@ Leave mails for this many days" :value 14)))))
 If nil, the user will be prompted when an error occurs.  If non-nil,
 the error will be ignored."
   :version "22.1"
-  :group 'mail-source
   :type 'boolean)
 
 (defcustom mail-source-primary-source nil
   "Primary source for incoming mail.
 If non-nil, this maildrop will be checked periodically for new mail."
-  :group 'mail-source
   :type 'sexp)
 
 (defcustom mail-source-flash t
   "If non-nil, flash periodically when mail is available."
-  :group 'mail-source
   :type 'boolean)
 
 (defcustom mail-source-crash-box "~/.emacs-mail-crash-box"
   "File where mail will be stored while processing it."
-  :group 'mail-source
   :type 'file)
 
 (defcustom mail-source-directory message-directory
   "Directory where incoming mail source files (if any) will be stored."
-  :group 'mail-source
   :type 'directory)
 
 (defcustom mail-source-default-file-modes 384
   "Set the mode bits of all new mail files to this integer."
-  :group 'mail-source
   :type 'integer)
 
 (defcustom mail-source-delete-incoming
@@ -270,7 +263,6 @@ Removing of old files happens in `mail-source-callback', i.e. no
 old incoming files will be deleted unless you receive new mail.
 You may also set this variable to nil and call
 `mail-source-delete-old-incoming' interactively."
-  :group 'mail-source
   :version "22.2" ;; No Gnus / Gnus 5.10.10 (default changed)
   :type '(choice (const :tag "immediately" t)
 		 (const :tag "never" nil)
@@ -281,28 +273,23 @@ You may also set this variable to nil and call
 This variable only applies when `mail-source-delete-incoming' is a positive
 number."
   :version "22.2" ;; No Gnus / Gnus 5.10.10 (default changed)
-  :group 'mail-source
   :type 'boolean)
 
 (defcustom mail-source-incoming-file-prefix "Incoming"
   "Prefix for file name for storing incoming mail."
-  :group 'mail-source
   :type 'string)
 
 (defcustom mail-source-report-new-mail-interval 5
   "Interval in minutes between checks for new mail."
-  :group 'mail-source
   :type 'number)
 
 (defcustom mail-source-idle-time-delay 5
   "Number of idle seconds to wait before checking for new mail."
-  :group 'mail-source
   :type 'number)
 
 (defcustom mail-source-movemail-program "movemail"
   "If non-nil, name of program for fetching new mail."
   :version "26.2"
-  :group 'mail-source
   :type '(choice (const nil) string))
 
 ;;; Internal variables.
@@ -393,13 +380,10 @@ All keywords that can be used must be listed here."))
 ;; suitable for usage in a `let' form
 (eval-and-compile
   (defun mail-source-bind-1 (type)
-    (let* ((defaults (cdr (assq type mail-source-keyword-map)))
-	   default bind)
-      (while (setq default (pop defaults))
-	(push (list (mail-source-strip-keyword (car default))
-		    nil)
-	      bind))
-      bind)))
+    (mapcar (lambda (default)
+	      (list (mail-source-strip-keyword (car default))
+		    nil))
+	    (cdr (assq type mail-source-keyword-map)))))
 
 (defmacro mail-source-bind (type-source &rest body)
   "Return a `let' form that binds all variables in source TYPE.
@@ -418,18 +402,20 @@ of the second `let' form.
 
 The variables bound and their default values are described by
 the `mail-source-keyword-map' variable."
-  `(let* ,(mail-source-bind-1 (car type-source))
-     (mail-source-set-1 ,(cadr type-source))
-     ,@body))
-
-(put 'mail-source-bind 'lisp-indent-function 1)
-(put 'mail-source-bind 'edebug-form-spec '(sexp body))
+  (declare (indent 1) (debug (sexp body)))
+  ;; FIXME: Use lexical vars, i.e. don't initialize the vars inside
+  ;; `mail-source-set-1' via `set'.
+  (let ((bindings (mail-source-bind-1 (car type-source))))
+    `(with-suppressed-warnings ((lexical ,@(mapcar #'car bindings)))
+       (dlet ,bindings
+         (mail-source-set-1 ,(cadr type-source))
+         ,@body))))
 
 (defun mail-source-set-1 (source)
   (let* ((type (pop source))
          (defaults (cdr (assq type mail-source-keyword-map)))
          (search '(:max 1))
-         found default value keyword auth-info user-auth pass-auth)
+         found default value keyword user-auth pass-auth) ;; auth-info
 
     ;; append to the search the useful info from the source and the defaults:
     ;; user, host, and port
@@ -463,21 +449,23 @@ the `mail-source-keyword-map' variable."
            (cond
             ((and
              (eq keyword :user)
-             (setq user-auth (plist-get
-                              ;; cache the search result in `found'
-                              (or found
-                                  (setq found (nth 0 (apply 'auth-source-search
-                                                            search))))
-                              :user)))
+             (setq user-auth
+                   (plist-get
+                    ;; cache the search result in `found'
+                    (or found
+                        (setq found (nth 0 (apply #'auth-source-search
+                                                  search))))
+                    :user)))
              user-auth)
             ((and
               (eq keyword :password)
-              (setq pass-auth (plist-get
-                               ;; cache the search result in `found'
-                               (or found
-                                   (setq found (nth 0 (apply 'auth-source-search
-                                                             search))))
-                               :secret)))
+              (setq pass-auth
+                    (plist-get
+                     ;; cache the search result in `found'
+                     (or found
+                         (setq found (nth 0 (apply #'auth-source-search
+                                                   search))))
+                     :secret)))
              ;; maybe set the password to the return of the :secret function
              (if (functionp pass-auth)
                  (setq pass-auth (funcall pass-auth))
@@ -488,20 +476,16 @@ the `mail-source-keyword-map' variable."
 
 (eval-and-compile
   (defun mail-source-bind-common-1 ()
-    (let* ((defaults mail-source-common-keyword-map)
-	   default bind)
-      (while (setq default (pop defaults))
-	(push (list (mail-source-strip-keyword (car default))
-		    nil)
-	      bind))
-      bind)))
+    (mapcar (lambda (default)
+	      (list (mail-source-strip-keyword (car default))
+		    nil))
+	    mail-source-common-keyword-map)))
 
 (defun mail-source-set-common-1 (source)
   (let* ((type (pop source))
-	 (defaults mail-source-common-keyword-map)
 	 (defaults-1 (cdr (assq type mail-source-keyword-map)))
-	 default value keyword)
-    (while (setq default (pop defaults))
+	 value keyword)
+    (dolist (default mail-source-common-keyword-map)
       (set (mail-source-strip-keyword (setq keyword (car default)))
 	   (if (setq value (plist-get source keyword))
 	       (mail-source-value value)
@@ -512,12 +496,14 @@ the `mail-source-keyword-map' variable."
 (defmacro mail-source-bind-common (source &rest body)
   "Return a `let' form that binds all common variables.
 See `mail-source-bind'."
-  `(let ,(mail-source-bind-common-1)
-     (mail-source-set-common-1 source)
-     ,@body))
-
-(put 'mail-source-bind-common 'lisp-indent-function 1)
-(put 'mail-source-bind-common 'edebug-form-spec '(sexp body))
+  (declare (indent 1) (debug (sexp body)))
+  ;; FIXME: AFAICT this is a Rube Goldberg'esque way to bind and initialize the
+  ;; `plugged` variable.
+  (let ((bindings (mail-source-bind-common-1)))
+    `(with-suppressed-warnings ((lexical ,@(mapcar #'car bindings)))
+       (dlet ,bindings
+         (mail-source-set-common-1 ,source)
+         ,@body))))
 
 (defun mail-source-value (value)
   "Return the value of VALUE."
@@ -527,7 +513,7 @@ See `mail-source-bind'."
     value)
    ;; Function
    ((and (listp value) (symbolp (car value)) (fboundp (car value)))
-    (eval value))
+    (eval value t))
    ;; Just return the value.
    (t
     value)))
@@ -688,7 +674,7 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
 		      ;; find "our" movemail in exec-directory.
 		      ;; Bug#31737
 		      (apply
-		       'call-process
+		       #'call-process
 		       (append
 			(list
 			 mail-source-movemail-program
@@ -742,12 +728,13 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
 (declare-function gnus-get-buffer-create "gnus" (name))
 (defun mail-source-call-script (script)
   (require 'gnus)
-  (let ((background nil)
+  (let (;; (background nil)
 	(stderr (gnus-get-buffer-create " *mail-source-stderr*"))
 	result)
     (when (string-match "& *$" script)
       (setq script (substring script 0 (match-beginning 0))
-	    background 0))
+	    ;; background 0
+	    ))
     (setq result
 	  (call-process shell-file-name nil stderr nil
 			shell-command-switch script))
@@ -831,14 +818,14 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
 	     ;; The default is to use pop3.el.
 	     (t
 	      (require 'pop3)
-	      (let ((pop3-password password)
-		    (pop3-maildrop user)
-		    (pop3-mailhost server)
-		    (pop3-port port)
-		    (pop3-authentication-scheme
-		     (if (eq authentication 'apop) 'apop 'pass))
-		    (pop3-stream-type stream)
-		    (pop3-leave-mail-on-server leave))
+	      (dlet ((pop3-password password)
+		     (pop3-maildrop user)
+		     (pop3-mailhost server)
+		     (pop3-port port)
+		     (pop3-authentication-scheme
+		      (if (eq authentication 'apop) 'apop 'pass))
+		     (pop3-stream-type stream)
+		     (pop3-leave-mail-on-server leave))
 		(if (or debug-on-quit debug-on-error)
 		    (save-excursion (pop3-movemail mail-source-crash-box))
 		  (condition-case err
@@ -898,12 +885,12 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
 	     ;; The default is to use pop3.el.
 	     (t
 	      (require 'pop3)
-	      (let ((pop3-password password)
-		    (pop3-maildrop user)
-		    (pop3-mailhost server)
-		    (pop3-port port)
-		    (pop3-authentication-scheme
-		     (if (eq authentication 'apop) 'apop 'pass)))
+	      (dlet ((pop3-password password)
+		     (pop3-maildrop user)
+		     (pop3-mailhost server)
+		     (pop3-port port)
+		     (pop3-authentication-scheme
+		      (if (eq authentication 'apop) 'apop 'pass)))
 		(if (or debug-on-quit debug-on-error)
 		    (save-excursion (pop3-get-message-count))
 		  (condition-case err
@@ -933,7 +920,7 @@ authentication.  To do that, you need to set the
 `message-send-mail-function' variable as `message-smtpmail-send-it'
 and put the following line in your ~/.gnus.el file:
 
-\(add-hook \\='message-send-mail-hook \\='mail-source-touch-pop)
+\(add-hook \\='message-send-mail-hook #\\='mail-source-touch-pop)
 
 See the Gnus manual for details."
   (let ((sources (if mail-source-primary-source
@@ -977,6 +964,8 @@ See the Gnus manual for details."
     ;; (element 0 of the vector is nil if the timer is active).
     (aset mail-source-report-new-mail-idle-timer 0 nil)))
 
+(declare-function display-time-event-handler "time" ())
+
 (defun mail-source-report-new-mail (arg)
   "Toggle whether to report when new mail is available.
 This only works when `display-time' is enabled."
@@ -1005,11 +994,11 @@ This only works when `display-time' is enabled."
 		 #'mail-source-start-idle-timer))
 	  ;; When you get new mail, clear "Mail" from the mode line.
 	  (add-hook 'nnmail-post-get-new-mail-hook
-		    'display-time-event-handler)
+		    #'display-time-event-handler)
 	  (message "Mail check enabled"))
       (setq display-time-mail-function nil)
       (remove-hook 'nnmail-post-get-new-mail-hook
-		   'display-time-event-handler)
+		   #'display-time-event-handler)
       (message "Mail check disabled"))))
 
 (defun mail-source-fetch-maildir (source callback)
@@ -1089,7 +1078,8 @@ This only works when `display-time' is enabled."
       (if (and (imap-open server port stream authentication buf)
 	       (imap-authenticate
 		user (or (cdr (assoc from mail-source-password-cache))
-                         password) buf))
+                         password)
+                buf))
           (let ((mailbox-list (if (listp mailbox) mailbox (list mailbox))))
             (dolist (mailbox mailbox-list)
               (when (imap-mailbox-select mailbox nil buf)