Merge remote-tracking branch 'origin/master' into feature/android

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
 

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)

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

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)