mirror of https://github.com/djcb/mu.git
Merge branch 'view-list-archives'
This commit is contained in:
commit
91fea8e16e
|
@ -28,6 +28,7 @@
|
||||||
;;; Code:
|
;;; Code:
|
||||||
|
|
||||||
(require 'ido)
|
(require 'ido)
|
||||||
|
(require 'browse-url)
|
||||||
|
|
||||||
(require 'mu4e-helpers)
|
(require 'mu4e-helpers)
|
||||||
(require 'mu4e-message)
|
(require 'mu4e-message)
|
||||||
|
@ -247,6 +248,22 @@ the message."
|
||||||
nil nil nil
|
nil nil nil
|
||||||
msgid (and (eq major-mode 'mu4e-view-mode)
|
msgid (and (eq major-mode 'mu4e-view-mode)
|
||||||
(not (eq mu4e-split-view 'single-window))))))))
|
(not (eq mu4e-split-view 'single-window))))))))
|
||||||
|
|
||||||
|
(defun mu4e-actions-browse-list-archive (msg)
|
||||||
|
"Browse the archive for a mailing list message MSG.
|
||||||
|
See `mu4e-list-archives-resolve'."
|
||||||
|
(interactive (list (mu4e-message-at-point)))
|
||||||
|
(when-let ((url (mu4e-list-archives-resolve msg)))
|
||||||
|
(browse-url url)))
|
||||||
|
|
||||||
|
(defun mu4e-actions-kill-list-archive (msg)
|
||||||
|
"Kill the archive url for a mailing list message MSG.
|
||||||
|
See `mu4e-list-archives-resolve'."
|
||||||
|
(interactive (list (mu4e-message-at-point)))
|
||||||
|
(let ((url (mu4e-list-archives-resolve msg)))
|
||||||
|
(if (stringp url) (kill-new url)
|
||||||
|
(user-error "Cannot get url for this message"))))
|
||||||
|
|
||||||
;;; _
|
;;; _
|
||||||
(provide 'mu4e-actions)
|
(provide 'mu4e-actions)
|
||||||
;;; mu4e-actions.el ends here
|
;;; mu4e-actions.el ends here
|
||||||
|
|
|
@ -237,15 +237,18 @@ Must have the same length as `mu4e-headers-thread-connection-prefix'.")
|
||||||
|
|
||||||
;;;; Various
|
;;;; Various
|
||||||
|
|
||||||
(defvar mu4e-headers-actions
|
(defcustom mu4e-headers-actions
|
||||||
'( ("capture message" . mu4e-action-capture-message)
|
'( ("capture message" . mu4e-action-capture-message)
|
||||||
|
("browse online archive" . mu4e-actions-browse-list-archive)
|
||||||
("show this thread" . mu4e-action-show-thread))
|
("show this thread" . mu4e-action-show-thread))
|
||||||
"List of actions to perform on messages in the headers list.
|
"List of actions to perform on messages in the headers list.
|
||||||
The actions are cons-cells of the form (NAME . FUNC) where:
|
The actions are cons-cells of the form (NAME . FUNC) where:
|
||||||
* NAME is the name of the action (e.g. \"Count lines\")
|
* NAME is the name of the action (e.g. \"Count lines\")
|
||||||
* FUNC is a function which receives a message plist as an argument.
|
* FUNC is a function which receives a message plist as an argument.
|
||||||
|
|
||||||
The first character of NAME is used as the shortcut.")
|
The first character of NAME is used as the shortcut."
|
||||||
|
:group 'mu4e-headers
|
||||||
|
:type '(alist :key-type string :value-type function))
|
||||||
|
|
||||||
(defvar mu4e-headers-custom-markers
|
(defvar mu4e-headers-custom-markers
|
||||||
'(("Older than"
|
'(("Older than"
|
||||||
|
|
|
@ -0,0 +1,206 @@
|
||||||
|
;;; mu4e-list-archives.el --- Locate online mailing list archives -*- lexical-binding: t; -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2023 Ruijie Yu
|
||||||
|
|
||||||
|
;; Author: Ruijie Yu <ruijie@netyu.xyz>
|
||||||
|
|
||||||
|
;; This file is not part of GNU Emacs.
|
||||||
|
|
||||||
|
;; mu4e is free software: you can redistribute it and/or modify
|
||||||
|
;; it under the terms of the GNU General Public License as published by
|
||||||
|
;; the Free Software Foundation, either version 3 of the License, or
|
||||||
|
;; (at your option) any later version.
|
||||||
|
|
||||||
|
;; mu4e is distributed in the hope that it will be useful,
|
||||||
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
;; GNU General Public License for more details.
|
||||||
|
|
||||||
|
;; You should have received a copy of the GNU General Public License
|
||||||
|
;; along with mu4e. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; Commentary:
|
||||||
|
|
||||||
|
;; In this file, we attempt to locate an online archive for a mailing list
|
||||||
|
;; message.
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
(eval-when-compile (require 'subr-x)) ; for `thread-last'
|
||||||
|
(require 'cl-lib)
|
||||||
|
(require 'mu4e-lists)
|
||||||
|
|
||||||
|
(defgroup mu4e-list-archives nil
|
||||||
|
"Configuration group for retrieving online mailing list archives."
|
||||||
|
:group 'mu4e-lists)
|
||||||
|
|
||||||
|
(defcustom mla-user-actions nil
|
||||||
|
"An alist with cells (MAILING-LIST-ID . ARCHIVE-ACTION).
|
||||||
|
This variable is consulted before `mla-actions' when
|
||||||
|
determining the archive URL of a given mailing list.
|
||||||
|
|
||||||
|
ARCHIVE-ACTION can take one of the following three forms:
|
||||||
|
|
||||||
|
- nil: this mailing list has no online archive. This is useful
|
||||||
|
to override a default setting in `mla-actions'.
|
||||||
|
|
||||||
|
- a string: it should contain a single `format' \"%s\" parameter,
|
||||||
|
where the message ID is substituted.
|
||||||
|
|
||||||
|
- a function: the function should take one argument: the message
|
||||||
|
object as returned by `mu4e-message-at-point', and return
|
||||||
|
either nil to indicate no archive, or a string that will be
|
||||||
|
treated as the archive URL for the current message."
|
||||||
|
:type '(alist :key-type (string :tag "Mailing List ID")
|
||||||
|
:value-type
|
||||||
|
(choice (const :tag "No online archive" nil)
|
||||||
|
(string :tag "URL format with one \"%s\" parameter")
|
||||||
|
(function :tag "Function returning URL or nil"))))
|
||||||
|
|
||||||
|
(defun mla--get-recipients (msg)
|
||||||
|
"Helper function to retrieve a list of recipients from MSG."
|
||||||
|
(delete-dups
|
||||||
|
(delq nil (mapcar (lambda (c) (plist-get c :email))
|
||||||
|
(apply #'append
|
||||||
|
(mapcar (apply-partially #'plist-get msg)
|
||||||
|
'(:to :cc :bcc)))))))
|
||||||
|
|
||||||
|
(defun mla-resolve-debbug (base-url &optional debbug-mail-domain)
|
||||||
|
"Return an ARCHIVE-ACTION function for debbug, based on BASE-URL.
|
||||||
|
This function sequentially checks that one of the following
|
||||||
|
conditions is true, and returns the url based on the found bug
|
||||||
|
number if possible, returning nil if all have failed.
|
||||||
|
|
||||||
|
1. That the subject contains \"bug#xxxxx\" (case-insensitive).
|
||||||
|
|
||||||
|
2. When DEBBUG-MAIL-DOMAIN is non-nil, that one of the recipients
|
||||||
|
has address <xxxxx@DEBBUG-MAIL-DOMAIN>.
|
||||||
|
|
||||||
|
See `mu4e-list-archives-actions' for details on ARCHIVE-ACTION."
|
||||||
|
(lambda (msg)
|
||||||
|
"Returned by `mu4e-list-archives-resolve-debbug', which see."
|
||||||
|
(and-let*
|
||||||
|
((match-subject (rx bow "bug#" (group-n 1 (+ digit))))
|
||||||
|
(match-recipient (if debbug-mail-domain
|
||||||
|
(rx (group-n 1 (+ digit))
|
||||||
|
?@ (literal debbug-mail-domain))
|
||||||
|
(rx unmatchable)))
|
||||||
|
(bug (cond
|
||||||
|
((let ((case-fold-search nil)) ; (1)
|
||||||
|
(save-match-data
|
||||||
|
(and-let* ((subject (plist-get msg :subject))
|
||||||
|
((string-match match-subject subject)))
|
||||||
|
(match-string 1 subject)))))
|
||||||
|
(debbug-mail-domain ; (2)
|
||||||
|
(save-match-data
|
||||||
|
(seq-drop-while
|
||||||
|
(lambda (recipient)
|
||||||
|
(and-let* (((string-match match-recipient recipient)))
|
||||||
|
(match-string 1 recipient)))
|
||||||
|
(mla--get-recipients msg)))))))
|
||||||
|
(format "%s?bug=%s" base-url bug))))
|
||||||
|
|
||||||
|
(defun mla--resolve-namazu (search-url-fmt url-base msg)
|
||||||
|
"Resolve the actual archive page from the namazu search result.
|
||||||
|
Return the actual url or nil if not found.
|
||||||
|
|
||||||
|
SEARCH-URL-FMT is a url format satisfying the second definition
|
||||||
|
of ARCHIVE-ACTION.
|
||||||
|
|
||||||
|
MSG is a plist returned by `mu4e-message-at-point'.
|
||||||
|
|
||||||
|
URL-BASE is the base url string."
|
||||||
|
(defvar url-asynchronous)
|
||||||
|
(let ((url-asynchronous nil))
|
||||||
|
(and-let* (((libxml-available-p))
|
||||||
|
(msgid (plist-get msg :message-id))
|
||||||
|
(search-url (format search-url-fmt (url-hexify-string msgid)))
|
||||||
|
(buf (url-retrieve search-url #'ignore)))
|
||||||
|
(with-current-buffer buf
|
||||||
|
(while (process-live-p (get-buffer-process buf))
|
||||||
|
(sit-for 0.1 t))
|
||||||
|
(save-excursion
|
||||||
|
(save-match-data
|
||||||
|
(goto-char 1)
|
||||||
|
(and-let* (((re-search-forward (rx bol eol) nil t))
|
||||||
|
(url (thread-last
|
||||||
|
;; emacs#63291
|
||||||
|
(libxml-parse-html-region (point) (point-max))
|
||||||
|
(alist-get 'body) ; get body
|
||||||
|
(alist-get 'dl) ; get first dl
|
||||||
|
(alist-get 'dt) ; get first dt
|
||||||
|
(alist-get 'strong) ; get first strong
|
||||||
|
(alist-get 'a) ; get first aref
|
||||||
|
(car) ; peel the nested list
|
||||||
|
(alist-get 'href))) ; might be relative url
|
||||||
|
(url (url-generic-parse-url url))
|
||||||
|
(url-base (url-generic-parse-url url-base)))
|
||||||
|
(prog2 (url-default-expander url url-base)
|
||||||
|
(url-recreate-url url)))))))))
|
||||||
|
|
||||||
|
(defcustom mla-resolve-namazu-search t
|
||||||
|
"Whether to resolve namazu search page.
|
||||||
|
On mailman+namazu system, currently there is no direct way to get
|
||||||
|
the actual url for a given message id. The only way is to
|
||||||
|
perform a \"search\" on namazu.
|
||||||
|
|
||||||
|
Enabling this option makes it to look into the structure of the
|
||||||
|
search page, and to locate the only match. Requires enabling
|
||||||
|
libxml support at compile time."
|
||||||
|
:type 'boolean
|
||||||
|
:safe #'booleanp)
|
||||||
|
|
||||||
|
(defun mla-resolve-mailman-namazu (url-base internal-list-id)
|
||||||
|
"Return an ARCHIVE-ACTION for mailman namazu.
|
||||||
|
URL-BASE is the base url such that \"URL-BASE/namazu.cgi\" is the search page.
|
||||||
|
|
||||||
|
INTERNAL-LIST-ID is the internal name for the list id, which is
|
||||||
|
usually the first part of the list id."
|
||||||
|
(let ((search-url-fmt
|
||||||
|
(format "%s/namazu.cgi?%s"
|
||||||
|
url-base
|
||||||
|
(string-join
|
||||||
|
(list "submit=Search%%21"
|
||||||
|
(format "idxname=%s" internal-list-id)
|
||||||
|
(format "query=%s:%%s" "%%2bmessage-id"))
|
||||||
|
"&"))))
|
||||||
|
(lambda (msg)
|
||||||
|
(cond
|
||||||
|
((and (libxml-available-p)
|
||||||
|
mla-resolve-namazu-search
|
||||||
|
;; This may fail. Fallback if failed.
|
||||||
|
(mla--resolve-namazu search-url-fmt url-base msg)))
|
||||||
|
;; fallback
|
||||||
|
((format search-url-fmt (plist-get msg :message-id)))))))
|
||||||
|
|
||||||
|
(defconst mla-actions
|
||||||
|
`(("bug-gnu-emacs.gnu.org" . ,(mla-resolve-debbug
|
||||||
|
"https://debbugs.gnu.org/cgi/bugreport.cgi"))
|
||||||
|
("emacs-orgmode.gnu.org" . "https://list.orgmode.org/%s")
|
||||||
|
("help-gnu-emacs.gnu.org"
|
||||||
|
. ,(mla-resolve-mailman-namazu
|
||||||
|
"https://lists.gnu.org/archive/cgi-bin" "help-gnu-emacs")))
|
||||||
|
"An alist with cells (MAILING-LIST-ID . ARCHIVE-ACTION).
|
||||||
|
See `mu4e-list-archives-user-actions' for further details.")
|
||||||
|
|
||||||
|
(defun mla-resolve (msg)
|
||||||
|
"Return the archive url for a mailing list message MSG, or nil.
|
||||||
|
Based on `mu4e-lists-user-archive-urls' and
|
||||||
|
`mu4e-lists-archive-urls', in this order."
|
||||||
|
(and-let* (msg
|
||||||
|
(list-id (plist-get msg :list))
|
||||||
|
(msg-id (plist-get msg :message-id))
|
||||||
|
(archive-action
|
||||||
|
(let ((get (lambda (actions)
|
||||||
|
(alist-get list-id actions nil nil #'string=))))
|
||||||
|
(or (funcall get mu4e-list-archives-user-actions)
|
||||||
|
(funcall get mu4e-list-archives-actions)))))
|
||||||
|
(pcase archive-action
|
||||||
|
((pred stringp) (format archive-action msg-id))
|
||||||
|
((pred functionp) (funcall archive-action msg)))))
|
||||||
|
|
||||||
|
(provide 'mu4e-list-archives)
|
||||||
|
;;; mu4e-list-archives.el ends here.
|
||||||
|
|
||||||
|
;; Local Variables:
|
||||||
|
;; read-symbol-shorthands: (("mla" . "mu4e-list-archives"))
|
||||||
|
;; End:
|
|
@ -67,6 +67,9 @@
|
||||||
- `:list-id' - the mailing list id
|
- `:list-id' - the mailing list id
|
||||||
- `:name' - the display name.")
|
- `:name' - the display name.")
|
||||||
|
|
||||||
|
(defgroup mu4e-lists nil "Configuration for mailing lists."
|
||||||
|
:group 'mu4e)
|
||||||
|
|
||||||
(defcustom mu4e-user-mailing-lists nil
|
(defcustom mu4e-user-mailing-lists nil
|
||||||
"A list with plists like `mu4e-mailing-lists'.
|
"A list with plists like `mu4e-mailing-lists'.
|
||||||
These are used in addition to the built-in list
|
These are used in addition to the built-in list
|
||||||
|
|
|
@ -73,12 +73,12 @@ etc., see the gnus documentation for details."
|
||||||
:group 'mu4e-view)
|
:group 'mu4e-view)
|
||||||
|
|
||||||
(defcustom mu4e-view-actions
|
(defcustom mu4e-view-actions
|
||||||
(seq-filter #'identity
|
(delq nil `(("capture message" . mu4e-action-capture-message)
|
||||||
`( ("capture message" . mu4e-action-capture-message)
|
("view in browser" . mu4e-action-view-in-browser)
|
||||||
("view in browser" . mu4e-action-view-in-browser)
|
("browse online archive" . mu4e-actions-browse-list-archive)
|
||||||
,(when (fboundp 'xwidget-webkit-browse-url)
|
,(when (fboundp 'xwidget-webkit-browse-url)
|
||||||
'("xview in xwidget" . mu4e-action-view-in-xwidget))
|
'("xview in xwidget" . mu4e-action-view-in-xwidget))
|
||||||
("show this thread" . mu4e-action-show-thread)))
|
("show this thread" . mu4e-action-show-thread)))
|
||||||
"List of actions to perform on messages in view mode.
|
"List of actions to perform on messages in view mode.
|
||||||
The actions are cons-cells of the form:
|
The actions are cons-cells of the form:
|
||||||
(NAME . FUNC)
|
(NAME . FUNC)
|
||||||
|
|
Loading…
Reference in New Issue