mirror of https://github.com/djcb/mu.git
Merge branch 'view-list-archives'
This commit is contained in:
Dirk-Jan C. Binnema
commit
91fea8e16e
|
|
@ -28,6 +28,7 @@
|
|||
;;; Code:
|
||||
|
||||
(require 'ido)
|
||||
(require 'browse-url)
|
||||
|
||||
(require 'mu4e-helpers)
|
||||
(require 'mu4e-message)
|
||||
|
|
@ -247,6 +248,22 @@ the message."
|
|||
nil nil nil
|
||||
msgid (and (eq major-mode 'mu4e-view-mode)
|
||||
(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)
|
||||
;;; mu4e-actions.el ends here
|
||||
|
|
|
|||
|
|
@ -237,15 +237,18 @@ Must have the same length as `mu4e-headers-thread-connection-prefix'.")
|
|||
|
||||
;;;; Various
|
||||
|
||||
(defvar mu4e-headers-actions
|
||||
(defcustom mu4e-headers-actions
|
||||
'( ("capture message" . mu4e-action-capture-message)
|
||||
("browse online archive" . mu4e-actions-browse-list-archive)
|
||||
("show this thread" . mu4e-action-show-thread))
|
||||
"List of actions to perform on messages in the headers list.
|
||||
The actions are cons-cells of the form (NAME . FUNC) where:
|
||||
* NAME is the name of the action (e.g. \"Count lines\")
|
||||
* 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
|
||||
'(("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
|
||||
- `:name' - the display name.")
|
||||
|
||||
(defgroup mu4e-lists nil "Configuration for mailing lists."
|
||||
:group 'mu4e)
|
||||
|
||||
(defcustom mu4e-user-mailing-lists nil
|
||||
"A list with plists like `mu4e-mailing-lists'.
|
||||
These are used in addition to the built-in list
|
||||
|
|
|
|||
|
|
@ -73,12 +73,12 @@ etc., see the gnus documentation for details."
|
|||
:group 'mu4e-view)
|
||||
|
||||
(defcustom mu4e-view-actions
|
||||
(seq-filter #'identity
|
||||
`( ("capture message" . mu4e-action-capture-message)
|
||||
("view in browser" . mu4e-action-view-in-browser)
|
||||
,(when (fboundp 'xwidget-webkit-browse-url)
|
||||
'("xview in xwidget" . mu4e-action-view-in-xwidget))
|
||||
("show this thread" . mu4e-action-show-thread)))
|
||||
(delq nil `(("capture message" . mu4e-action-capture-message)
|
||||
("view in browser" . mu4e-action-view-in-browser)
|
||||
("browse online archive" . mu4e-actions-browse-list-archive)
|
||||
,(when (fboundp 'xwidget-webkit-browse-url)
|
||||
'("xview in xwidget" . mu4e-action-view-in-xwidget))
|
||||
("show this thread" . mu4e-action-show-thread)))
|
||||
"List of actions to perform on messages in view mode.
|
||||
The actions are cons-cells of the form:
|
||||
(NAME . FUNC)
|
||||
|
|
|
|||
Loading…
Reference in New Issue