diff options
Diffstat (limited to 'lisp/gnus/mail-source.el')
| -rw-r--r-- | lisp/gnus/mail-source.el | 146 |
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) |