procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

New Rmail commands for reading mailing-lists

Browse source 
* 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.
This commit is contained in:
Eli Zaretskii 2023-05-21 13:57:14 +03:00
parent f8cdb9e050
commit 71622d70e8
2 changed files with 100 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
etc/NEWS
View file

@ -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

92
lisp/mail/rmail.el
View file

@ -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)