diff --git a/etc/NEWS b/etc/NEWS index 71d20e9da82..ce4c3100f78 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -351,6 +351,15 @@ instead of: *** New ':vc' keyword. This keyword enables the user to install packages using 'package-vc'. +** Rmail + +--- +*** New commands for reading mailing lists. +The new Rmail commands 'rmail-mailing-list-post', +'rmail-mailing-list-unsubscribe', 'rmail-mailing-list-help', and +'rmail-mailing-list-archive allow to, respectively, post to, +unsubscribe from, request help about, and browse the archives, of the +mailing list from which the current email message was delivered. * New Modes and Packages in Emacs 30.1 diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index b8d7b63a81a..ac040799a22 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -3590,6 +3590,7 @@ lambda-expression." (delq 2) (delete 2) (delete-dups 1) (delete-consecutive-dups 1) (plist-put 1) + (assoc-delete-all 2) (assq-delete-all 2) (rassq-delete-all 2) (fillarray 1) (store-substring 1) (clear-string 1) diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 1e8ab4ad46d..8c44a4fb0a0 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -137,11 +137,11 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), :eval (assoc-string "foo" '(("foo" . "bar") ("zot" "baz")))) "Manipulating Alists" (assoc-delete-all - :eval (assoc-delete-all "foo" '(("foo" . "bar") ("zot" . "baz")) #'equal)) + :eval (assoc-delete-all "b" (list '("a" . a) '("b" . b) '("b" . c)))) (assq-delete-all - :eval (assq-delete-all 'foo '((foo . bar) (zot . baz)))) + :eval (assq-delete-all 2 (list '(1 . a) '(2 . b) '(2 . c)))) (rassq-delete-all - :eval (rassq-delete-all 'bar '((foo . bar) (zot . baz)))) + :eval (rassq-delete-all 'b (list '(1 . a) '(2 . b) '(2 . c)))) (alist-get :eval (let ((foo '((bar . baz)))) (setf (alist-get 'bar foo) 'zot) @@ -705,10 +705,12 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), :eval (assoc-default 2 '((1 . a) (2 . b) #'=))) (copy-alist :eval (copy-alist '((1 . a) (2 . b)))) - (assq-delete-all - :eval (assq-delete-all 2 (list '(1 . a) '(2 . b) '(2 . c)))) (assoc-delete-all :eval (assoc-delete-all "b" (list '("a" . a) '("b" . b) '("b" . c)))) + (assq-delete-all + :eval (assq-delete-all 2 (list '(1 . a) '(2 . b) '(2 . c)))) + (rassq-delete-all + :eval (rassq-delete-all 'b (list '(1 . a) '(2 . b) '(2 . c)))) "Property Lists" (plist-get :eval (plist-get '(a 1 b 2 c 3) 'b)) diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 379e345bef1..716848dc34f 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -40,6 +40,7 @@ (require 'mail-utils) (require 'rfc2047) (require 'auth-source) +(require 'rfc6068) (declare-function compilation--message->loc "compile" (cl-x) t) (declare-function epa--find-coding-system-for-mime-charset "epa" (mime-charset)) @@ -1120,10 +1121,36 @@ The buffer is expected to be narrowed to just the header of the message." (define-key map [menu-bar mail] (cons "Mail" (make-sparse-keymap "Mail"))) + (define-key map [menu-bar mail mailing-list] + (cons "Mailing List" (make-sparse-keymap "Mailing List"))) + + (define-key map [menu-bar mail mailing-list list-help] + '(menu-item "Mailing List Help" rmail-mailing-list-help + :enable (rmail-get-header "List-Help") + :help "Compose email requesting help about this mailing list")) + + (define-key map [menu-bar mail mailing-list list-archive] + '(menu-item "Mailing List Archive" rmail-mailing-list-archive + :enable (rmail-get-header "List-Archive") + :help "Browse the archive of this mailing list")) + + (define-key map [menu-bar mail mailing-list list-unsubscribe] + '(menu-item "Unsubscribe From List" rmail-mailing-list-unsubscribe + :enable (rmail-get-header "List-Unsubscribe") + :help "Compose email to unsubscribe from this mailing list")) + + (define-key map [menu-bar mail mailing-list list-post] + '(menu-item "Post To List" rmail-mailing-list-post + :enable (rmail-get-header "List-Post") + :help "Compose email to post to this mailing list")) + + (define-key map [menu-bar mail lambda1] + '("----")) + (define-key map [menu-bar mail rmail-get-new-mail] '("Get New Mail" . rmail-get-new-mail)) - (define-key map [menu-bar mail lambda] + (define-key map [menu-bar mail lambda2] '("----")) (define-key map [menu-bar mail continue] @@ -4767,6 +4794,69 @@ Content-Transfer-Encoding: base64\n") (setq buffer-file-coding-system rmail-message-encoding)))) (add-hook 'after-save-hook 'rmail-after-save-hook) + +;;; Mailing list support +(defun rmail--mailing-list-message (which) + "Send a message to mailing list whose purpose is identified by WHICH. +WHICH is a symbol, one of `help', `unsubscribe', or `post'." + (let ((header + (cond ((eq which 'help) "List-Help") + ((eq which 'unsubscribe) "List-Unsubscribe") + ((eq which 'post) "List-Post"))) + (msg + (cond ((eq which 'post) + "Write Subject and body, then type \\[%s] to send the message.") + (t + "Type \\[%s] to send the message."))) + address header-list to subject) + (setq address (rmail-get-header header)) + (cond ((and address (string-match "<\\(mailto:[^>]*\\)>" address)) + (setq address (match-string 1 address)) + (setq header-list (rfc6068-parse-mailto-url address) + to (cdr (assoc-string "To" header-list t)) + subject (or (cdr (assoc-string "Subject" header-list t)) "")) + (rmail-start-mail nil to subject nil nil rmail-buffer) + (message (substitute-command-keys + (format msg (get mail-user-agent 'sendfunc))))) + (t + (user-error "This message does not specify \"%s\" address" + header))))) + +(defun rmail-mailing-list-help () + "Send Help request to the mailing list which delivered the current message. +This command starts composing an email message to the mailing list +requesting help about the list. When the message is ready, send it +as usual, via your MUA's send-email command." + (interactive nil rmail-mode) + (rmail--mailing-list-message 'help)) + +(defun rmail-mailing-list-post () + "Post a message to the mailing list which delivered the current message. +This command starts composing an email message to the mailing list. +Fill the Subject and the body of the message. When the message is +ready, send it as usual, via your MUA's send-email command." + (interactive nil rmail-mode) + (rmail--mailing-list-message 'post)) + +(defun rmail-mailing-list-unsubscribe () + "Send unsubscribe request to the mailing list which delivered current message. +This command starts composing an email message to the mailing list +requesting to unsubscribe you from the list. When the message is +ready, send it as usual, via your MUA's send-email command." + (interactive nil rmail-mode) + (rmail--mailing-list-message 'unsubscribe)) + +(defun rmail-mailing-list-archive () + "Browse the archive of the mailing list which delivered the current message." + (interactive nil rmail-mode) + (let* ((header (rmail-get-header "List-Archive")) + (url (and (stringp header) + (string-match " *<\\([^>]*\\)>" header) + (match-string 1 header)))) + (if url + (browse-url url) + (user-error + "This message does not specify a valid \"List-Archive\" URL")))) (provide 'rmail)