From: Eli Zaretskii Date: Sun, 21 May 2023 10:57:14 +0000 (+0300) Subject: New Rmail commands for reading mailing-lists X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=71622d70e8bd0f4289df098a8d9b3ab06f4bdcc0;p=emacs.git New Rmail commands for reading mailing-lists * lisp/mail/rmail.el (rmail--mailing-list-message): New internal function. (rmail-mailing-list-help, rmail-mailing-list-post) (rmail-mailing-list-unsubscribe, rmail-mailing-list-archive): New commands. (rmail-mode-map): Add menu items for the new commands. * etc/NEWS: Announce the new Rmail commands. --- diff --git a/etc/NEWS b/etc/NEWS index 04ef976a8d1..7729dbc79fa 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -333,6 +333,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/mail/rmail.el b/lisp/mail/rmail.el index d07a1fda901..872299c2415 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] @@ -4765,6 +4792,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)