mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-24 06:20:43 -08:00
Code Issues Projects Releases Wiki Activity

* lisp/gnus/message.el: Give non-nil defaults for function vars

Browse source 
Also prefer #' to quote functions.

(message-send-rename-function, message-reply-to-function)
(message-wide-reply-to-function, message-followup-to-function):
Use a non-nil default value so it can be used with `add-function`.
(message-do-send-housekeeping): Tweak accordingly.
(message-get-reply-headers): Simplify by η-reduction.
This commit is contained in:
Stefan Monnier 2021-04-11 22:55:18 -04:00
parent a89da3f008
commit ccfd6a975e
1 changed files with 83 additions and 83 deletions
Download patch file Download diff file Expand all files Collapse all files

166
lisp/gnus/message.el
View file

@ -120,12 +120,13 @@
:group 'message-buffers :group 'message-buffers
:type 'integer) :type 'integer)
(defcustom message-send-rename-function nil (defcustom message-send-rename-function #'message-default-send-rename-function
"Function called to rename the buffer after sending it." "Function called to rename the buffer after sending it."
:group 'message-buffers :group 'message-buffers
:type '(choice function (const nil))) :version "28.1"
:type 'function)
(defcustom message-fcc-handler-function 'message-output (defcustom message-fcc-handler-function #'message-output
"A function called to save outgoing articles. "A function called to save outgoing articles.
This function will be called with the name of the file to store the This function will be called with the name of the file to store the
article in. The default function is `message-output' which saves in Unix article in. The default function is `message-output' which saves in Unix
@ -418,7 +419,7 @@ you can explicitly override this setting by calling
:type 'string :type 'string
:group 'message-various) :group 'message-various)
(defcustom message-cross-post-note-function 'message-cross-post-insert-note (defcustom message-cross-post-note-function #'message-cross-post-insert-note
"Function to use to insert note about Crosspost or Followup-To. "Function to use to insert note about Crosspost or Followup-To.
The function will be called with four arguments. The function should not only The function will be called with four arguments. The function should not only
insert a note, but also ensure old notes are deleted. See the documentation insert a note, but also ensure old notes are deleted. See the documentation
@ -756,7 +757,7 @@ See also `send-mail-function'."
:link '(custom-manual "(message)Mail Variables") :link '(custom-manual "(message)Mail Variables")
:group 'message-mail) :group 'message-mail)
(defcustom message-send-news-function 'message-send-news (defcustom message-send-news-function #'message-send-news
"Function to call to send the current buffer as news. "Function to call to send the current buffer as news.
The headers should be delimited by a line whose contents match the The headers should be delimited by a line whose contents match the
variable `mail-header-separator'." variable `mail-header-separator'."
@ -765,29 +766,32 @@ variable `mail-header-separator'."
:link '(custom-manual "(message)News Variables") :link '(custom-manual "(message)News Variables")
:type 'function) :type 'function)
(defcustom message-reply-to-function nil (defcustom message-reply-to-function #'ignore
"If non-nil, function that should return a list of headers. "If non-nil, function that should return a list of headers.
This function should pick out addresses from the To, Cc, and From headers This function should pick out addresses from the To, Cc, and From headers
and respond with new To and Cc headers." and respond with new To and Cc headers."
:group 'message-interface :group 'message-interface
:link '(custom-manual "(message)Reply") :link '(custom-manual "(message)Reply")
:type '(choice function (const nil))) :version "28.1"
:type 'function)
(defcustom message-wide-reply-to-function nil (defcustom message-wide-reply-to-function #'ignore
"If non-nil, function that should return a list of headers. "If non-nil, function that should return a list of headers.
This function should pick out addresses from the To, Cc, and From headers This function should pick out addresses from the To, Cc, and From headers
and respond with new To and Cc headers." and respond with new To and Cc headers."
:group 'message-interface :group 'message-interface
:link '(custom-manual "(message)Wide Reply") :link '(custom-manual "(message)Wide Reply")
:type '(choice function (const nil))) :version "28.1"
:type 'function)
(defcustom message-followup-to-function nil (defcustom message-followup-to-function #'ignore
"If non-nil, function that should return a list of headers. "If non-nil, function that should return a list of headers.
This function should pick out addresses from the To, Cc, and From headers This function should pick out addresses from the To, Cc, and From headers
and respond with new To and Cc headers." and respond with new To and Cc headers."
:group 'message-interface :group 'message-interface
:link '(custom-manual "(message)Followup") :link '(custom-manual "(message)Followup")
:type '(choice function (const nil))) :version "28.1"
:type 'function)
(defcustom message-extra-wide-headers nil (defcustom message-extra-wide-headers nil
"If non-nil, a list of additional address headers. "If non-nil, a list of additional address headers.
@ -1021,7 +1025,7 @@ the signature is inserted."
:version "22.1" :version "22.1"
:group 'message-various) :group 'message-various)
(defcustom message-citation-line-function 'message-insert-citation-line (defcustom message-citation-line-function #'message-insert-citation-line
"Function called to insert the \"Whomever writes:\" line. "Function called to insert the \"Whomever writes:\" line.
Predefined functions include `message-insert-citation-line' and Predefined functions include `message-insert-citation-line' and
@ -1103,7 +1107,7 @@ Used by `message-yank-original' via `message-yank-cite'."
:link '(custom-manual "(message)Insertion Variables") :link '(custom-manual "(message)Insertion Variables")
:type 'integer) :type 'integer)
(defcustom message-cite-function 'message-cite-original-without-signature (defcustom message-cite-function #'message-cite-original-without-signature
"Function for citing an original message. "Function for citing an original message.
Predefined functions include `message-cite-original' and Predefined functions include `message-cite-original' and
`message-cite-original-without-signature'. `message-cite-original-without-signature'.
@ -1116,7 +1120,7 @@ Note that these functions use `mail-citation-hook' if that is non-nil."
:version "22.3" ;; Gnus 5.10.12 (changed default) :version "22.3" ;; Gnus 5.10.12 (changed default)
:group 'message-insertion) :group 'message-insertion)
(defcustom message-indent-citation-function 'message-indent-citation (defcustom message-indent-citation-function #'message-indent-citation
"Function for modifying a citation just inserted in the mail buffer. "Function for modifying a citation just inserted in the mail buffer.
This can also be a list of functions. Each function can find the This can also be a list of functions. Each function can find the
citation between (point) and (mark t). And each function should leave citation between (point) and (mark t). And each function should leave
@ -2847,79 +2851,79 @@ Consider adding this function to `message-header-setup-hook'"
(unless message-mode-map (unless message-mode-map
(setq message-mode-map (make-keymap)) (setq message-mode-map (make-keymap))
(set-keymap-parent message-mode-map text-mode-map) (set-keymap-parent message-mode-map text-mode-map)
(define-key message-mode-map "\C-c?" 'describe-mode) (define-key message-mode-map "\C-c?" #'describe-mode)
(define-key message-mode-map "\C-c\C-f\C-t" 'message-goto-to) (define-key message-mode-map "\C-c\C-f\C-t" #'message-goto-to)
(define-key message-mode-map "\C-c\C-f\C-o" 'message-goto-from) (define-key message-mode-map "\C-c\C-f\C-o" #'message-goto-from)
(define-key message-mode-map "\C-c\C-f\C-b" 'message-goto-bcc) (define-key message-mode-map "\C-c\C-f\C-b" #'message-goto-bcc)
(define-key message-mode-map "\C-c\C-f\C-w" 'message-goto-fcc) (define-key message-mode-map "\C-c\C-f\C-w" #'message-goto-fcc)
(define-key message-mode-map "\C-c\C-f\C-c" 'message-goto-cc) (define-key message-mode-map "\C-c\C-f\C-c" #'message-goto-cc)
(define-key message-mode-map "\C-c\C-f\C-s" 'message-goto-subject) (define-key message-mode-map "\C-c\C-f\C-s" #'message-goto-subject)
(define-key message-mode-map "\C-c\C-f\C-r" 'message-goto-reply-to) (define-key message-mode-map "\C-c\C-f\C-r" #'message-goto-reply-to)
(define-key message-mode-map "\C-c\C-f\C-n" 'message-goto-newsgroups) (define-key message-mode-map "\C-c\C-f\C-n" #'message-goto-newsgroups)
(define-key message-mode-map "\C-c\C-f\C-d" 'message-goto-distribution) (define-key message-mode-map "\C-c\C-f\C-d" #'message-goto-distribution)
(define-key message-mode-map "\C-c\C-f\C-f" 'message-goto-followup-to) (define-key message-mode-map "\C-c\C-f\C-f" #'message-goto-followup-to)
(define-key message-mode-map "\C-c\C-f\C-m" 'message-goto-mail-followup-to) (define-key message-mode-map "\C-c\C-f\C-m" #'message-goto-mail-followup-to)
(define-key message-mode-map "\C-c\C-f\C-k" 'message-goto-keywords) (define-key message-mode-map "\C-c\C-f\C-k" #'message-goto-keywords)
(define-key message-mode-map "\C-c\C-f\C-u" 'message-goto-summary) (define-key message-mode-map "\C-c\C-f\C-u" #'message-goto-summary)
(define-key message-mode-map "\C-c\C-f\C-i" (define-key message-mode-map "\C-c\C-f\C-i"
'message-insert-or-toggle-importance) #'message-insert-or-toggle-importance)
(define-key message-mode-map "\C-c\C-f\C-a" (define-key message-mode-map "\C-c\C-f\C-a"
'message-generate-unsubscribed-mail-followup-to) #'message-generate-unsubscribed-mail-followup-to)
;; modify headers (and insert notes in body) ;; modify headers (and insert notes in body)
(define-key message-mode-map "\C-c\C-fs" 'message-change-subject) (define-key message-mode-map "\C-c\C-fs" #'message-change-subject)
;; ;;
(define-key message-mode-map "\C-c\C-fx" 'message-cross-post-followup-to) (define-key message-mode-map "\C-c\C-fx" #'message-cross-post-followup-to)
;; prefix+message-cross-post-followup-to = same w/o cross-post ;; prefix+message-cross-post-followup-to = same w/o cross-post
(define-key message-mode-map "\C-c\C-ft" 'message-reduce-to-to-cc) (define-key message-mode-map "\C-c\C-ft" #'message-reduce-to-to-cc)
(define-key message-mode-map "\C-c\C-fa" 'message-add-archive-header) (define-key message-mode-map "\C-c\C-fa" #'message-add-archive-header)
;; mark inserted text ;; mark inserted text
(define-key message-mode-map "\C-c\M-m" 'message-mark-inserted-region) (define-key message-mode-map "\C-c\M-m" #'message-mark-inserted-region)
(define-key message-mode-map "\C-c\M-f" 'message-mark-insert-file) (define-key message-mode-map "\C-c\M-f" #'message-mark-insert-file)
(define-key message-mode-map "\C-c\C-b" 'message-goto-body) (define-key message-mode-map "\C-c\C-b" #'message-goto-body)
(define-key message-mode-map "\C-c\C-i" 'message-goto-signature) (define-key message-mode-map "\C-c\C-i" #'message-goto-signature)
(define-key message-mode-map "\C-c\C-t" 'message-insert-to) (define-key message-mode-map "\C-c\C-t" #'message-insert-to)
(define-key message-mode-map "\C-c\C-fw" 'message-insert-wide-reply) (define-key message-mode-map "\C-c\C-fw" #'message-insert-wide-reply)
(define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups) (define-key message-mode-map "\C-c\C-n" #'message-insert-newsgroups)
(define-key message-mode-map "\C-c\C-l" 'message-to-list-only) (define-key message-mode-map "\C-c\C-l" #'message-to-list-only)
(define-key message-mode-map "\C-c\C-f\C-e" 'message-insert-expires) (define-key message-mode-map "\C-c\C-f\C-e" #'message-insert-expires)
(define-key message-mode-map "\C-c\C-u" 'message-insert-or-toggle-importance) (define-key message-mode-map "\C-c\C-u" #'message-insert-or-toggle-importance)
(define-key message-mode-map "\C-c\M-n" (define-key message-mode-map "\C-c\M-n"
'message-insert-disposition-notification-to) #'message-insert-disposition-notification-to)
(define-key message-mode-map "\C-c\C-y" 'message-yank-original) (define-key message-mode-map "\C-c\C-y" #'message-yank-original)
(define-key message-mode-map "\C-c\M-\C-y" 'message-yank-buffer) (define-key message-mode-map "\C-c\M-\C-y" #'message-yank-buffer)
(define-key message-mode-map "\C-c\C-q" 'message-fill-yanked-message) (define-key message-mode-map "\C-c\C-q" #'message-fill-yanked-message)
(define-key message-mode-map "\C-c\C-w" 'message-insert-signature) (define-key message-mode-map "\C-c\C-w" #'message-insert-signature)
(define-key message-mode-map "\C-c\M-h" 'message-insert-headers) (define-key message-mode-map "\C-c\M-h" #'message-insert-headers)
(define-key message-mode-map "\C-c\C-r" 'message-caesar-buffer-body) (define-key message-mode-map "\C-c\C-r" #'message-caesar-buffer-body)
(define-key message-mode-map "\C-c\C-o" 'message-sort-headers) (define-key message-mode-map "\C-c\C-o" #'message-sort-headers)
(define-key message-mode-map "\C-c\M-r" 'message-rename-buffer) (define-key message-mode-map "\C-c\M-r" #'message-rename-buffer)
(define-key message-mode-map "\C-c\C-c" 'message-send-and-exit) (define-key message-mode-map "\C-c\C-c" #'message-send-and-exit)
(define-key message-mode-map "\C-c\C-s" 'message-send) (define-key message-mode-map "\C-c\C-s" #'message-send)
(define-key message-mode-map "\C-c\C-k" 'message-kill-buffer) (define-key message-mode-map "\C-c\C-k" #'message-kill-buffer)
(define-key message-mode-map "\C-c\C-d" 'message-dont-send) (define-key message-mode-map "\C-c\C-d" #'message-dont-send)
(define-key message-mode-map "\C-c\n" 'gnus-delay-article) (define-key message-mode-map "\C-c\n" #'gnus-delay-article)
(define-key message-mode-map "\C-c\M-k" 'message-kill-address) (define-key message-mode-map "\C-c\M-k" #'message-kill-address)
(define-key message-mode-map "\C-c\C-e" 'message-elide-region) (define-key message-mode-map "\C-c\C-e" #'message-elide-region)
(define-key message-mode-map "\C-c\C-v" 'message-delete-not-region) (define-key message-mode-map "\C-c\C-v" #'message-delete-not-region)
(define-key message-mode-map "\C-c\C-z" 'message-kill-to-signature) (define-key message-mode-map "\C-c\C-z" #'message-kill-to-signature)
(define-key message-mode-map "\M-\r" 'message-newline-and-reformat) (define-key message-mode-map "\M-\r" #'message-newline-and-reformat)
(define-key message-mode-map [remap split-line] 'message-split-line) (define-key message-mode-map [remap split-line] #'message-split-line)
(define-key message-mode-map "\C-c\C-a" 'mml-attach-file) (define-key message-mode-map "\C-c\C-a" #'mml-attach-file)
(define-key message-mode-map "\C-c\C-p" 'message-insert-screenshot) (define-key message-mode-map "\C-c\C-p" #'message-insert-screenshot)
(define-key message-mode-map "\C-a" 'message-beginning-of-line) (define-key message-mode-map "\C-a" #'message-beginning-of-line)
(define-key message-mode-map "\t" 'message-tab) (define-key message-mode-map "\t" #'message-tab)
(define-key message-mode-map "\M-n" 'message-display-abbrev)) (define-key message-mode-map "\M-n" #'message-display-abbrev))
(easy-menu-define (easy-menu-define
message-mode-menu message-mode-map "Message Menu." message-mode-menu message-mode-map "Message Menu."
@ -3169,14 +3173,13 @@ Like `text-mode', but with these additional commands:
;; `electric-pair-mode', and C-M-* navigation by syntactically ;; `electric-pair-mode', and C-M-* navigation by syntactically
;; excluding citations and other artifacts. ;; excluding citations and other artifacts.
;; ;;
(setq-local syntax-propertize-function 'message--syntax-propertize) (setq-local syntax-propertize-function #'message--syntax-propertize)
(setq-local parse-sexp-ignore-comments t) (setq-local parse-sexp-ignore-comments t)
(setq-local message-encoded-mail-cache nil)) (setq-local message-encoded-mail-cache nil))
(defun message-setup-fill-variables () (defun message-setup-fill-variables ()
"Setup message fill variables." "Setup message fill variables."
(setq-local fill-paragraph-function #'message-fill-paragraph) (setq-local fill-paragraph-function #'message-fill-paragraph)
(make-local-variable 'adaptive-fill-first-line-regexp)
(let ((quote-prefix-regexp (let ((quote-prefix-regexp
;; User should change message-cite-prefix-regexp if ;; User should change message-cite-prefix-regexp if
;; message-yank-prefix is set to an abnormal value. ;; message-yank-prefix is set to an abnormal value.
@ -3287,7 +3290,7 @@ Like `text-mode', but with these additional commands:
(push-mark) (push-mark)
(message-position-on-field "Summary" "Subject")) (message-position-on-field "Summary" "Subject"))
(define-obsolete-function-alias 'message-goto-body-1 'message-goto-body "27.1") (define-obsolete-function-alias 'message-goto-body-1 #'message-goto-body "27.1")
(defun message-goto-body (&optional interactive) (defun message-goto-body (&optional interactive)
"Move point to the beginning of the message body. "Move point to the beginning of the message body.
Returns point." Returns point."
@ -6662,9 +6665,8 @@ moved to the beginning "
(not (buffer-modified-p buffer))) (not (buffer-modified-p buffer)))
(kill-buffer buffer)))) (kill-buffer buffer))))
;; Rename the buffer. ;; Rename the buffer.
(if message-send-rename-function (funcall (or message-send-rename-function
(funcall message-send-rename-function) #'message-default-send-rename-function))
(message-default-send-rename-function))
;; Push the current buffer onto the list. ;; Push the current buffer onto the list.
(when message-max-buffers (when message-max-buffers
(setq message-buffer-list (setq message-buffer-list
@ -6763,8 +6765,9 @@ are not included."
(defun message-setup-1 (headers &optional yank-action actions return-action) (defun message-setup-1 (headers &optional yank-action actions return-action)
(dolist (action actions) (dolist (action actions)
(condition-case nil (condition-case nil
;; FIXME: Use functions rather than expressions!
(add-to-list 'message-send-actions (add-to-list 'message-send-actions
`(apply ',(car action) ',(cdr action))))) `(apply #',(car action) ',(cdr action)))))
(setq message-return-action return-action) (setq message-return-action return-action)
(setq message-reply-buffer (setq message-reply-buffer
(if (and (consp yank-action) (if (and (consp yank-action)
@ -6903,7 +6906,7 @@ are not included."
;;;###autoload ;;;###autoload
(defun message-mail (&optional to subject other-headers continue (defun message-mail (&optional to subject other-headers continue
switch-function yank-action send-actions switch-function yank-action send-actions
return-action &rest ignored) return-action &rest _)
"Start editing a mail message to be sent. "Start editing a mail message to be sent.
OTHER-HEADERS is an alist of header/value pairs. CONTINUE says whether OTHER-HEADERS is an alist of header/value pairs. CONTINUE says whether
to continue editing a message already being composed. SWITCH-FUNCTION to continue editing a message already being composed. SWITCH-FUNCTION
@ -7127,15 +7130,12 @@ want to get rid of this query permanently.")))
;; specific, and just Cc-in the rest. ;; specific, and just Cc-in the rest.
(setq follow-to (list (setq follow-to (list
(cons 'To (cons 'To
(mapconcat (mapconcat #'cdr recipients ", "))))
(lambda (addr)
(cdr addr)) recipients ", "))))
;; Put the first recipient in the To header. ;; Put the first recipient in the To header.
(setq follow-to (list (cons 'To (cdr (pop recipients))))) (setq follow-to (list (cons 'To (cdr (pop recipients)))))
;; Put the rest of the recipients in Cc. ;; Put the rest of the recipients in Cc.
(when recipients (when recipients
(setq recipients (mapconcat (setq recipients (mapconcat #'cdr recipients ", "))
(lambda (addr) (cdr addr)) recipients ", "))
(if (string-match "^ +" recipients) (if (string-match "^ +" recipients)
(setq recipients (substring recipients (match-end 0)))) (setq recipients (substring recipients (match-end 0))))
(push (cons 'Cc recipients) follow-to))))) (push (cons 'Cc recipients) follow-to)))))
@ -7862,7 +7862,7 @@ is for the internal use."
(interactive) (interactive)
(setq rmail-enable-mime-composing t) (setq rmail-enable-mime-composing t)
(setq rmail-insert-mime-forwarded-message-function (setq rmail-insert-mime-forwarded-message-function
'message-forward-rmail-make-body)) #'message-forward-rmail-make-body))
;;;###autoload ;;;###autoload
(defun message-resend (address) (defun message-resend (address)