mirror of https://github.com/djcb/mu.git
mu4e: split off mime-handling from mu4e-view & improve
Split off the MIME-handling from mu4e-view.el into its own mu4e-mime-parts.el Improve the implementation, updating completions with annotations. Support "Pick all" for completing attachments and MIME-types. Both attachment/inline disposition MIME-type with a file name are considered "attachment" now. Allow MIME-part actions to target multiple MIME-parts.
This commit is contained in:
parent
3b93863f15
commit
993f16522a
|
@ -45,6 +45,7 @@ mu4e_srcs=[
|
||||||
'mu4e-main.el',
|
'mu4e-main.el',
|
||||||
'mu4e-mark.el',
|
'mu4e-mark.el',
|
||||||
'mu4e-message.el',
|
'mu4e-message.el',
|
||||||
|
'mu4e-mime-parts.el',
|
||||||
'mu4e-modeline.el',
|
'mu4e-modeline.el',
|
||||||
'mu4e-notification.el',
|
'mu4e-notification.el',
|
||||||
'mu4e-obsolete.el',
|
'mu4e-obsolete.el',
|
||||||
|
|
|
@ -0,0 +1,485 @@
|
||||||
|
;;; mu4e-mime-parts.el -- part of mu4e -*- lexical-binding: t -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2023 Dirk-Jan C. Binnema
|
||||||
|
|
||||||
|
;; Author: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||||
|
;; Maintainer: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||||
|
|
||||||
|
;; 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:
|
||||||
|
|
||||||
|
;; Implements functions and variables for dealing with MIME-parts and URLs.
|
||||||
|
|
||||||
|
|
||||||
|
;;; TODO:
|
||||||
|
;; [~] mime part candidate sorting -> is his even possible generally?
|
||||||
|
;; [ ] URL support
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
|
||||||
|
(require 'mu4e-vars)
|
||||||
|
(require 'mu4e-folders)
|
||||||
|
(require 'gnus-art)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
(defcustom mu4e-view-open-program
|
||||||
|
(pcase system-type
|
||||||
|
('darwin "open")
|
||||||
|
('cygwin "cygstart")
|
||||||
|
(_ "xdg-open"))
|
||||||
|
"Tool to open the correct program for a given file or MIME-type.
|
||||||
|
May also be a function of a single argument, the file to be
|
||||||
|
opened.
|
||||||
|
|
||||||
|
In the function-valued case a likely candidate is
|
||||||
|
`mailcap-view-file' although note that there was an Emacs bug up
|
||||||
|
to Emacs 29 which prevented opening a file if `mailcap-mime-data'
|
||||||
|
specified a function as viewer."
|
||||||
|
:type '(choice string function)
|
||||||
|
:group 'mu4e-view)
|
||||||
|
|
||||||
|
|
||||||
|
;; remember the mime-handles, so we can clean them up when
|
||||||
|
;; we quit this buffer.
|
||||||
|
(defvar-local mu4e~gnus-article-mime-handles nil)
|
||||||
|
(put 'mu4e~gnus-article-mime-handles 'permanent-local t)
|
||||||
|
|
||||||
|
(defun mu4e--view-kill-mime-handles ()
|
||||||
|
"Kill cached MIME-handles, if any."
|
||||||
|
(when mu4e~gnus-article-mime-handles
|
||||||
|
(mm-destroy-parts mu4e~gnus-article-mime-handles)
|
||||||
|
(setq mu4e~gnus-article-mime-handles nil)))
|
||||||
|
|
||||||
|
|
||||||
|
;;; MIME-parts
|
||||||
|
(defvar-local mu4e--view-mime-parts nil
|
||||||
|
"Cached MIME parts for this message.")
|
||||||
|
|
||||||
|
|
||||||
|
(defun mu4e-view-mime-parts()
|
||||||
|
"Get the list of MIME parts for this message.
|
||||||
|
The list is a list of plists, one for each MIME-part.
|
||||||
|
|
||||||
|
The plists have the properties:
|
||||||
|
|
||||||
|
:part-index : Gnus index number
|
||||||
|
:mime-type : MIME-type (string) or nil
|
||||||
|
:encoding : Content encoding (string) or nil
|
||||||
|
:disposition : Content disposition (attachment\" or inline\") or nil
|
||||||
|
:filename : The file name if it has one, or an invented one
|
||||||
|
otherwise
|
||||||
|
|
||||||
|
There are some internal fields as well, e.g. ; subject to change:
|
||||||
|
|
||||||
|
:target-dir : Target directory for saving
|
||||||
|
:attachment-like : When it has a filename, we can save it
|
||||||
|
:handle : Gnus handle."
|
||||||
|
(or mu4e--view-mime-parts
|
||||||
|
(setq
|
||||||
|
mu4e--view-mime-parts
|
||||||
|
(let ((parts) (indices))
|
||||||
|
(save-excursion
|
||||||
|
(goto-char (point-min))
|
||||||
|
(while (not (eobp))
|
||||||
|
(when-let ((part (get-text-property (point) 'gnus-data))
|
||||||
|
(index (get-text-property (point) 'gnus-part)))
|
||||||
|
(when (and part (numberp index) (not (member index indices)))
|
||||||
|
(let* ((disp (mm-handle-disposition part))
|
||||||
|
(fname (cdr-safe
|
||||||
|
(and disp (assoc 'filename (cdr disp)))))
|
||||||
|
(mime-type (mm-handle-media-type part))
|
||||||
|
(info
|
||||||
|
`(:part-index ,index
|
||||||
|
:mime-type ,mime-type
|
||||||
|
:encoding ,(mm-handle-encoding part)
|
||||||
|
:disposition ,(car-safe disp)
|
||||||
|
|
||||||
|
;; if there's no file-name, invent one
|
||||||
|
;; XXX perhaps guess extension based on mime-type
|
||||||
|
:filename ,(or fname
|
||||||
|
(format "mime-part-%02d" index))
|
||||||
|
|
||||||
|
;; below are internal
|
||||||
|
|
||||||
|
:target-dir ,(mu4e-determine-attachment-dir
|
||||||
|
fname mime-type)
|
||||||
|
;; 'attachment-like' just means it has its own
|
||||||
|
;; filename an we thus we can save it through
|
||||||
|
;; `mu4e-view-save-attachments', even if it has an
|
||||||
|
;; 'inline' disposition.
|
||||||
|
:attachment-like ,(if fname t nil)
|
||||||
|
:handle ,part)))
|
||||||
|
(push index indices)
|
||||||
|
(push info parts))))
|
||||||
|
(goto-char (or (next-single-property-change (point) 'gnus-part)
|
||||||
|
(point-max)))))
|
||||||
|
;; sort by the GNU's part-index, so the order is the same as
|
||||||
|
;; in the message on screen
|
||||||
|
(seq-sort (lambda (p1 p2) (< (plist-get p1 :part-index)
|
||||||
|
(plist-get p2 :part-index))) parts)))))
|
||||||
|
|
||||||
|
;; https://emacs.stackexchange.com/questions/74547/completing-read-search-also-in-annotationsxc
|
||||||
|
|
||||||
|
(defun mu4e--uniqify-file-name (fname)
|
||||||
|
"Return a non-yet-existing filename based on FNAME.
|
||||||
|
If FNAME does not yet exist, return it unchanged.
|
||||||
|
Otherwise, return a file with a unique number appended to the base-name."
|
||||||
|
(let ((num 1) (orig-name fname))
|
||||||
|
(while (file-exists-p fname)
|
||||||
|
(setq fname (format "%s(%d)%s%s"
|
||||||
|
(file-name-sans-extension orig-name)
|
||||||
|
num
|
||||||
|
(if (file-name-extension orig-name) "." "")
|
||||||
|
(file-name-extension orig-name)))
|
||||||
|
(cl-incf num)))
|
||||||
|
fname)
|
||||||
|
|
||||||
|
(defvar mu4e--completions-table nil)
|
||||||
|
|
||||||
|
(defun mu4e-view-complete-all ()
|
||||||
|
"Pick all current candidates."
|
||||||
|
(interactive)
|
||||||
|
(if (bound-and-true-p helm-mode)
|
||||||
|
(mu4e-warn "Not supported with helm")
|
||||||
|
(when mu4e--completions-table
|
||||||
|
(insert (string-join
|
||||||
|
(seq-map #'car mu4e--completions-table) ", ")))))
|
||||||
|
|
||||||
|
(define-minor-mode mu4e-view-completion-minor-mode
|
||||||
|
"Minor-mode for completing mu4e mime parts."
|
||||||
|
:global nil
|
||||||
|
:init-value nil ;; disabled by default
|
||||||
|
:group 'mu4e
|
||||||
|
:lighter ""
|
||||||
|
:keymap
|
||||||
|
(let ((map (make-sparse-keymap)))
|
||||||
|
(define-key map (kbd "C-c C-a") #'mu4e-view-complete-all)
|
||||||
|
;; XXX perhaps a binding for clearing all?
|
||||||
|
map))
|
||||||
|
|
||||||
|
|
||||||
|
(defun mu4e--part-annotation (candidate part type longest-filename)
|
||||||
|
"Calculate the annotation candidates as per
|
||||||
|
`:annotation-function' (see `completion-extra-properties')
|
||||||
|
|
||||||
|
CANDIDATE is the value to annotate.
|
||||||
|
|
||||||
|
PART is the matching MIME-part for the annotation, (as per
|
||||||
|
`mu4e-view-mime-part').
|
||||||
|
|
||||||
|
TYPE is the of what to annotate, a symbol, either ATTACHMENT or
|
||||||
|
MIME-PART.
|
||||||
|
|
||||||
|
LONGEST-FILENAME is the length of the longest filename; this
|
||||||
|
information' is used for alignment."
|
||||||
|
(let* ((filename (propertize (or (plist-get part :filename) "")
|
||||||
|
'face 'mu4e-header-key-face))
|
||||||
|
(mimetype (propertize (or (plist-get part :mime-type) "")
|
||||||
|
'face 'mu4e-header-value-face))
|
||||||
|
(target (propertize (or (plist-get part :target-dir) "")
|
||||||
|
'face 'mu4e-system-face)))
|
||||||
|
|
||||||
|
;; Sadly, we need too align by hand; this makes some assumptions
|
||||||
|
;; such a mono-type font and enough space in the minibuffer; and
|
||||||
|
;; mixing values and representation; ideally Emacs would allow
|
||||||
|
;; just take some columns and align them (since it knows the display
|
||||||
|
;; details).
|
||||||
|
|
||||||
|
(pcase type
|
||||||
|
('attachment
|
||||||
|
;; in case we're annotating an attachment, the filename is
|
||||||
|
;; the candidate (completion), so we don't need it in the
|
||||||
|
;; the annotation. We just need to but some space at beginning
|
||||||
|
;; for alignment
|
||||||
|
(concat
|
||||||
|
(make-string (- (+ longest-filename 2)
|
||||||
|
(length (format "%s" candidate))) ?\s)
|
||||||
|
(format "%20s" mimetype)
|
||||||
|
" "
|
||||||
|
(format "%s" (concat "-> " target))))
|
||||||
|
('mime-part
|
||||||
|
;; when we're annotating a mime-part, the candidate is just a number,
|
||||||
|
;; and the filename is part of the annotation.
|
||||||
|
(concat
|
||||||
|
" "
|
||||||
|
filename
|
||||||
|
(make-string (- (+ longest-filename 2)
|
||||||
|
(length filename)) ?\s)
|
||||||
|
(format "%20s" mimetype)
|
||||||
|
" "
|
||||||
|
(format "%s" (concat "-> " target))))
|
||||||
|
(_ (mu4e-error "Unsupported annotation type %s" type)))))
|
||||||
|
|
||||||
|
|
||||||
|
(defvar helm-comp-read-use-marked)
|
||||||
|
(defun mu4e--completing-read-real (prompt candidates multi)
|
||||||
|
"Call the appropriate completion-read function.
|
||||||
|
- PROMPT is a string informing the user what to complete
|
||||||
|
- CANDIDATES is an alist of candidates of the form
|
||||||
|
(id . part)
|
||||||
|
- MULTI if t, allow for completing _multiple_ candidates."
|
||||||
|
(cond
|
||||||
|
((bound-and-true-p helm-mode)
|
||||||
|
;; tweaks for "helm"; it's not nice to have to special-case for
|
||||||
|
;; completion frameworks, but this has been supported for while.
|
||||||
|
;; basically, with helm, helm-comp-read-use-marked + completing-read
|
||||||
|
;; is preferred over completing-read-multiple
|
||||||
|
(let ((helm-comp-read-use-marked t))
|
||||||
|
(completing-read prompt candidates)))
|
||||||
|
(multi
|
||||||
|
(completing-read-multiple prompt candidates))
|
||||||
|
(t
|
||||||
|
(completing-read prompt candidates))))
|
||||||
|
|
||||||
|
(defun mu4e--completing-read (prompt candidates type &optional multi)
|
||||||
|
"Read the part-id of some MIME-type in this message.
|
||||||
|
|
||||||
|
Presents the user with completions for the MIME-parts in
|
||||||
|
the current message.
|
||||||
|
|
||||||
|
- PROMPT is a string informing the user what to complete
|
||||||
|
- CANDIDATES is an alist of candidates of the form
|
||||||
|
(id . part)
|
||||||
|
- TYPE is the annotation type to uses as per `mu4e--part-annotation'.
|
||||||
|
Optionally,
|
||||||
|
- MULTI if t, allow for completing _multiple_ candidates."
|
||||||
|
(cl-assert candidates)
|
||||||
|
(let* ((longest-filename (seq-max
|
||||||
|
(seq-map (lambda (c)
|
||||||
|
(length (plist-get (cdr c) :filename)))
|
||||||
|
candidates)))
|
||||||
|
(annotation-func (lambda (candidate)
|
||||||
|
(mu4e--part-annotation candidate
|
||||||
|
(cdr-safe
|
||||||
|
(assoc candidate candidates))
|
||||||
|
type longest-filename)))
|
||||||
|
(completion-extra-properties
|
||||||
|
`(;; :affixation-function requires emacs 28
|
||||||
|
:annotation-function ,annotation-func
|
||||||
|
:exit-function (lambda (_a _b) (setq mu4e--completions-table nil)))))
|
||||||
|
(setq mu4e--completions-table candidates)
|
||||||
|
(minibuffer-with-setup-hook
|
||||||
|
(lambda ()
|
||||||
|
(mu4e-view-completion-minor-mode))
|
||||||
|
(mu4e--completing-read-real prompt candidates multi))))
|
||||||
|
|
||||||
|
(defun mu4e-view-save-attachments (&optional ask-dir)
|
||||||
|
"Save files from the current view buffer.
|
||||||
|
This applies to all MIME-parts that are \"attachment-like\" (have a filename),
|
||||||
|
regardless of their disposition.
|
||||||
|
|
||||||
|
With ASK-DIR is non-nil, user can specify the target-directory; otherwise
|
||||||
|
one is determined using `mu4e-attachment-dir'."
|
||||||
|
(interactive "P")
|
||||||
|
(let* ((parts (mu4e-view-mime-parts))
|
||||||
|
(candidates (seq-map
|
||||||
|
(lambda (fpart)
|
||||||
|
(cons ;; (filename . annotation)
|
||||||
|
(plist-get fpart :filename)
|
||||||
|
fpart))
|
||||||
|
(seq-filter
|
||||||
|
(lambda (part) (plist-get part :attachment-like))
|
||||||
|
parts)))
|
||||||
|
(candidates (or candidates
|
||||||
|
(mu4e-warn "No attachments for this message")))
|
||||||
|
(files (mu4e--completing-read "Save file(s): " candidates
|
||||||
|
'attachment 'multi))
|
||||||
|
(custom-dir (when ask-dir (read-directory-name
|
||||||
|
"Save to directory: "))))
|
||||||
|
;; we have determined what files to save, and where.
|
||||||
|
(seq-do (lambda (fname)
|
||||||
|
(let* ((part (cdr (assoc fname candidates)))
|
||||||
|
(path (mu4e--uniqify-file-name
|
||||||
|
(mu4e-join-paths
|
||||||
|
(or custom-dir (plist-get part :target-dir))
|
||||||
|
(plist-get part :filename)))))
|
||||||
|
(mm-save-part-to-file (plist-get part :handle) path)))
|
||||||
|
files)))
|
||||||
|
|
||||||
|
(defvar mu4e-view-mime-part-actions
|
||||||
|
'(
|
||||||
|
;;
|
||||||
|
;; some basic ones
|
||||||
|
;;
|
||||||
|
|
||||||
|
;; save MIME-part to a file
|
||||||
|
(:name "save" :handler gnus-article-save-part :receives index)
|
||||||
|
;; pipe MIME-part to some arbitrary shell command
|
||||||
|
(:name "|pipe" :handler gnus-article-pipe-part :receives index)
|
||||||
|
;; open with the default handler, if any
|
||||||
|
(:name "open" :handler mu4e--view-open-file :receives temp)
|
||||||
|
;; open with some custom file.
|
||||||
|
(:name "wopen-with" :handler (lambda (file)(mu4e--view-open-file file t))
|
||||||
|
:receives temp)
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; some more examples
|
||||||
|
;;
|
||||||
|
|
||||||
|
;; import GPG key
|
||||||
|
(:name "gpg" :handler epa-import-keys :receives temp)
|
||||||
|
;; open in this emacs instance; tries to use the attachment name,
|
||||||
|
;; so emacs can use specific modes etc.
|
||||||
|
(:name "emacs" :handler find-file-read-only :receives temp)
|
||||||
|
;; open in this emacs instance, "raw"
|
||||||
|
(:name "raw" :handler (lambda (str)
|
||||||
|
(let ((tmpbuf
|
||||||
|
(get-buffer-create " *mu4e-raw-mime*")))
|
||||||
|
(with-current-buffer tmpbuf
|
||||||
|
(insert str)
|
||||||
|
(view-mode)
|
||||||
|
(goto-char (point-min)))
|
||||||
|
(display-buffer tmpbuf))) :receives pipe))
|
||||||
|
|
||||||
|
"Specifies actions for MIME-parts.
|
||||||
|
|
||||||
|
Each of the actions is a plist with keys
|
||||||
|
`(:name <name> ;; name of the action; shortcut is first letter of name
|
||||||
|
|
||||||
|
:handler ;; one of:
|
||||||
|
;; - a function receiving the index/temp/pipe
|
||||||
|
;; - a string, which is taken as a shell command
|
||||||
|
|
||||||
|
:receives ;; a symbol specifying what the handler receives
|
||||||
|
;; - index: the index number of the mime part (default)
|
||||||
|
;; - temp: the full path to the mime part in a
|
||||||
|
;; temporary file, which is deleted immediately
|
||||||
|
;; after invoking handler
|
||||||
|
;; - pipe: the attachment is piped to some shell command
|
||||||
|
;; or as a string parameter to a function
|
||||||
|
).")
|
||||||
|
|
||||||
|
|
||||||
|
(defun mu4e--view-mime-part-to-temp-file (handle)
|
||||||
|
"Write MIME-part HANDLE to a temporary file and return the file name.
|
||||||
|
The filename is deduced from the MIME-part's filename, or
|
||||||
|
otherwise random; the result is placed in a temporary directory
|
||||||
|
with a unique name. Returns the full path for the file created.
|
||||||
|
The directory and file are self-destructed."
|
||||||
|
(let* ((tmpdir (make-temp-file "mu4e-temp-" t))
|
||||||
|
(fname (mm-handle-filename handle))
|
||||||
|
(fname (and fname
|
||||||
|
(gnus-map-function mm-file-name-rewrite-functions
|
||||||
|
(file-name-nondirectory fname))))
|
||||||
|
(fname (if fname
|
||||||
|
(concat tmpdir "/" (replace-regexp-in-string "/" "-" fname))
|
||||||
|
(let ((temporary-file-directory tmpdir))
|
||||||
|
(make-temp-file "mimepart")))))
|
||||||
|
(mm-save-part-to-file handle fname)
|
||||||
|
(run-at-time "30 sec" nil
|
||||||
|
(lambda () (ignore-errors (delete-directory tmpdir t))))
|
||||||
|
fname))
|
||||||
|
|
||||||
|
(defun mu4e--view-open-file (file &optional force-ask)
|
||||||
|
"Open FILE with default handler, if any.
|
||||||
|
Otherwise, or if FORCE-ASK is set, ask user for the program to
|
||||||
|
open with."
|
||||||
|
(if (and (not force-ask)
|
||||||
|
(functionp mu4e-view-open-program))
|
||||||
|
(funcall mu4e-view-open-program file)
|
||||||
|
(let ((opener
|
||||||
|
(or (and (not force-ask) mu4e-view-open-program
|
||||||
|
(executable-find mu4e-view-open-program))
|
||||||
|
(read-shell-command "Open MIME-part with: "))))
|
||||||
|
(call-process opener nil 0 nil file))))
|
||||||
|
|
||||||
|
(defun mu4e-view-mime-part-action (&optional n)
|
||||||
|
"Apply some action to MIME-part N in the current message.
|
||||||
|
If N is not specified, ask for it. For instance, '3 A o' opens
|
||||||
|
the third MIME-part."
|
||||||
|
;; (interactive
|
||||||
|
;; (list (read-number "Number of MIME-part: ")))
|
||||||
|
(interactive)
|
||||||
|
(let* ((parts (mu4e-view-mime-parts))
|
||||||
|
(candidates (seq-map
|
||||||
|
(lambda (part)
|
||||||
|
(cons (number-to-string
|
||||||
|
(plist-get part :part-index)) part))
|
||||||
|
parts))
|
||||||
|
(candidates (or candidates
|
||||||
|
(mu4e-warn "No MIME-parts for this message")))
|
||||||
|
(ids (seq-map #'string-to-number
|
||||||
|
(if n (list (number-to-string n))
|
||||||
|
(mu4e--completing-read "MIME-part(s) to operate on: "
|
||||||
|
candidates
|
||||||
|
'mime-part 'multi))))
|
||||||
|
(options
|
||||||
|
(mapcar (lambda (action) `(,(plist-get action :name) . ,action))
|
||||||
|
mu4e-view-mime-part-actions))
|
||||||
|
(action
|
||||||
|
(or (and options (mu4e-read-option "Action: " options))
|
||||||
|
(mu4e-error "No such action")))
|
||||||
|
(handler
|
||||||
|
(or (plist-get action :handler)
|
||||||
|
(mu4e-error "No :handler item found for action %S" action)))
|
||||||
|
(receives
|
||||||
|
(or (plist-get action :receives)
|
||||||
|
(mu4e-error "No :receives item found for action %S" action))))
|
||||||
|
|
||||||
|
;; Apply the action to all selected MIME-parts
|
||||||
|
(seq-do (lambda (id)
|
||||||
|
(cl-assert (numberp id))
|
||||||
|
(let* ((part (or (cdr-safe (assoc (number-to-string id) candidates))
|
||||||
|
(mu4e-error "No part found for id %s" id)))
|
||||||
|
(handle (plist-get part :handle)))
|
||||||
|
(save-excursion
|
||||||
|
(cond
|
||||||
|
((functionp handler)
|
||||||
|
(cond
|
||||||
|
((eq receives 'index) (funcall handler id))
|
||||||
|
((eq receives 'pipe)
|
||||||
|
(funcall handler (mm-with-unibyte-buffer
|
||||||
|
(mm-insert-part handle)
|
||||||
|
(buffer-string))))
|
||||||
|
((eq receives 'temp)
|
||||||
|
(funcall handler
|
||||||
|
(mu4e--view-mime-part-to-temp-file handle)))
|
||||||
|
(t (mu4e-error "Invalid :receive for %S" action))))
|
||||||
|
((stringp handler)
|
||||||
|
(cond
|
||||||
|
((eq receives 'index)
|
||||||
|
(shell-command
|
||||||
|
(concat handler " " (shell-quote-argument id))))
|
||||||
|
((eq receives 'pipe)
|
||||||
|
(progn
|
||||||
|
(mm-pipe-part handle handler)))
|
||||||
|
((eq receives 'temp)
|
||||||
|
(shell-command
|
||||||
|
(shell-command
|
||||||
|
(concat
|
||||||
|
handler " "
|
||||||
|
(shell-quote-argument
|
||||||
|
(mu4e--view-mime-part-to-temp-file handle))))))
|
||||||
|
(t (mu4e-error "Invalid action %S" action))))))))
|
||||||
|
ids)))
|
||||||
|
|
||||||
|
(defun mu4e-process-file-through-pipe (path pipecmd)
|
||||||
|
"Process file at PATH through a pipe with PIPECMD."
|
||||||
|
(let ((buf (get-buffer-create "*mu4e-output")))
|
||||||
|
(with-current-buffer buf
|
||||||
|
(let ((inhibit-read-only t))
|
||||||
|
(erase-buffer)
|
||||||
|
(call-process-shell-command pipecmd path t t)
|
||||||
|
(view-mode)))
|
||||||
|
(display-buffer buf)))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
(provide 'mu4e-mime-parts)
|
||||||
|
;;; mu4e-mime-parts.el ends here
|
|
@ -1,4 +1,4 @@
|
||||||
;;; mu4e-view.el -- part of mu4e, the mu mail user agent -*- lexical-binding: t -*-
|
;;; mu4e-view.el -- part of mu4et -*- lexical-binding: t -*-
|
||||||
|
|
||||||
;; Copyright (C) 2021-2023 Dirk-Jan C. Binnema
|
;; Copyright (C) 2021-2023 Dirk-Jan C. Binnema
|
||||||
|
|
||||||
|
@ -45,7 +45,9 @@
|
||||||
(require 'mu4e-message)
|
(require 'mu4e-message)
|
||||||
(require 'mu4e-server)
|
(require 'mu4e-server)
|
||||||
(require 'mu4e-search)
|
(require 'mu4e-search)
|
||||||
;; utility functions
|
(require 'mu4e-mime-parts)
|
||||||
|
|
||||||
|
;; utility functions
|
||||||
(require 'mu4e-contacts)
|
(require 'mu4e-contacts)
|
||||||
(require 'mu4e-vars)
|
(require 'mu4e-vars)
|
||||||
|
|
||||||
|
@ -90,22 +92,6 @@ The first letter of NAME is used as a shortcut character."
|
||||||
:group 'mu4e-view
|
:group 'mu4e-view
|
||||||
:type '(alist :key-type string :value-type function))
|
:type '(alist :key-type string :value-type function))
|
||||||
|
|
||||||
(defcustom mu4e-view-open-program
|
|
||||||
(pcase system-type
|
|
||||||
('darwin "open")
|
|
||||||
('cygwin "cygstart")
|
|
||||||
(_ "xdg-open"))
|
|
||||||
"Tool to open the correct program for a given file.
|
|
||||||
May also be a function of a single argument, the file to be
|
|
||||||
opened.
|
|
||||||
|
|
||||||
In the function-valued case a likely candidate is
|
|
||||||
`mailcap-view-file' although note that there was an Emacs bug up
|
|
||||||
to Emacs 29 which prevented opening a file if `mailcap-mime-data'
|
|
||||||
specified a function as viewer."
|
|
||||||
:type '(choice string function)
|
|
||||||
:group 'mu4e-view)
|
|
||||||
|
|
||||||
(defcustom mu4e-view-max-specpdl-size 4096
|
(defcustom mu4e-view-max-specpdl-size 4096
|
||||||
"The value of `max-specpdl-size' for displaying messages with Gnus."
|
"The value of `max-specpdl-size' for displaying messages with Gnus."
|
||||||
:type 'integer
|
:type 'integer
|
||||||
|
@ -467,7 +453,6 @@ If the url is mailto link, start writing an email to that address."
|
||||||
(browse-url-mail url)
|
(browse-url-mail url)
|
||||||
(browse-url url)))))
|
(browse-url url)))))
|
||||||
|
|
||||||
|
|
||||||
(defun mu4e--view-get-property-from-event (prop)
|
(defun mu4e--view-get-property-from-event (prop)
|
||||||
"Get the property PROP at point, or the location of the mouse.
|
"Get the property PROP at point, or the location of the mouse.
|
||||||
The action is chosen based on the `last-command-event'.
|
The action is chosen based on the `last-command-event'.
|
||||||
|
@ -557,7 +542,7 @@ URLs. The urls are fetched to `mu4e-attachment-dir'."
|
||||||
(mu4e--view-handle-urls
|
(mu4e--view-handle-urls
|
||||||
"URL to fetch" multi
|
"URL to fetch" multi
|
||||||
(lambda (url)
|
(lambda (url)
|
||||||
(let ((target (concat (mu4e~get-attachment-dir url) "/"
|
(let ((target (concat (mu4e-determine-attachment-dir url) "/"
|
||||||
(file-name-nondirectory url))))
|
(file-name-nondirectory url))))
|
||||||
(url-copy-file url target)
|
(url-copy-file url target)
|
||||||
(mu4e-message "Fetched %s -> %s" url target)))))
|
(mu4e-message "Fetched %s -> %s" url target)))))
|
||||||
|
@ -610,14 +595,8 @@ message."
|
||||||
;;; Variables
|
;;; Variables
|
||||||
|
|
||||||
(defvar gnus-icalendar-additional-identities)
|
(defvar gnus-icalendar-additional-identities)
|
||||||
(defvar helm-comp-read-use-marked)
|
|
||||||
(defvar-local mu4e--view-rendering nil)
|
(defvar-local mu4e--view-rendering nil)
|
||||||
|
|
||||||
;; remember the mime-handles, so we can clean them up when
|
|
||||||
;; we quit this buffer.
|
|
||||||
(defvar-local mu4e~gnus-article-mime-handles nil)
|
|
||||||
(put 'mu4e~gnus-article-mime-handles 'permanent-local t)
|
|
||||||
|
|
||||||
(defun mu4e-view (msg)
|
(defun mu4e-view (msg)
|
||||||
"Display the message MSG in a new buffer, and keep in sync with HDRSBUF.
|
"Display the message MSG in a new buffer, and keep in sync with HDRSBUF.
|
||||||
\"In sync\" here means that moving to the next/previous message
|
\"In sync\" here means that moving to the next/previous message
|
||||||
|
@ -653,7 +632,8 @@ As a side-effect, a message that is being viewed loses its
|
||||||
(insert-file-contents-literally
|
(insert-file-contents-literally
|
||||||
(mu4e-message-readable-path msg) nil nil nil t)
|
(mu4e-message-readable-path msg) nil nil nil t)
|
||||||
(setq-local mu4e--view-message msg)
|
(setq-local mu4e--view-message msg)
|
||||||
(mu4e--view-render-buffer msg))
|
(mu4e--view-render-buffer msg)
|
||||||
|
(setq-local mu4e--view-mime-part-cached nil))
|
||||||
(mu4e-loading-mode 0)))
|
(mu4e-loading-mode 0)))
|
||||||
(unless (mu4e--view-detached-p gnus-article-buffer)
|
(unless (mu4e--view-detached-p gnus-article-buffer)
|
||||||
(with-current-buffer mu4e-linked-headers-buffer
|
(with-current-buffer mu4e-linked-headers-buffer
|
||||||
|
@ -732,6 +712,7 @@ determine which browser function to use."
|
||||||
(gnus-buttonized-mime-types
|
(gnus-buttonized-mime-types
|
||||||
(append (list "multipart/signed" "multipart/encrypted")
|
(append (list "multipart/signed" "multipart/encrypted")
|
||||||
gnus-buttonized-mime-types))
|
gnus-buttonized-mime-types))
|
||||||
|
(gnus-inhibit-mime-unbuttonizing t)
|
||||||
(gnus-newsgroup-charset
|
(gnus-newsgroup-charset
|
||||||
(if (and charset (coding-system-p charset)) charset
|
(if (and charset (coding-system-p charset)) charset
|
||||||
(detect-coding-region (point-min) (point-max) t)))
|
(detect-coding-region (point-min) (point-max) t)))
|
||||||
|
@ -753,12 +734,6 @@ determine which browser function to use."
|
||||||
(mu4e-warn "EPG error: %s; fall back to raw view"
|
(mu4e-warn "EPG error: %s; fall back to raw view"
|
||||||
(error-message-string err))))))
|
(error-message-string err))))))
|
||||||
|
|
||||||
(defun mu4e--view-kill-mime-handles ()
|
|
||||||
"Kill cached MIME-handles, if any."
|
|
||||||
(when mu4e~gnus-article-mime-handles
|
|
||||||
(mm-destroy-parts mu4e~gnus-article-mime-handles)
|
|
||||||
(setq mu4e~gnus-article-mime-handles nil)))
|
|
||||||
|
|
||||||
(defun mu4e-view-refresh ()
|
(defun mu4e-view-refresh ()
|
||||||
"Refresh the message view."
|
"Refresh the message view."
|
||||||
(interactive)
|
(interactive)
|
||||||
|
@ -1110,219 +1085,7 @@ Article Treatment' for more options."
|
||||||
(interactive)
|
(interactive)
|
||||||
(funcall (mu4e-read-option "Massage: " mu4e-view-massage-options)))
|
(funcall (mu4e-read-option "Massage: " mu4e-view-massage-options)))
|
||||||
|
|
||||||
;;; MIME-parts
|
|
||||||
(defvar-local mu4e--view-mime-parts nil
|
|
||||||
"MIME parts for this message.")
|
|
||||||
|
|
||||||
(defun mu4e--view-gather-mime-parts ()
|
|
||||||
"Gather all MIME parts as an alist.
|
|
||||||
The alist uniquely maps the number to the gnus-part."
|
|
||||||
(let ((parts '()))
|
|
||||||
(save-excursion
|
|
||||||
(goto-char (point-min))
|
|
||||||
(while (not (eobp))
|
|
||||||
(let ((part (get-text-property (point) 'gnus-data))
|
|
||||||
(index (get-text-property (point) 'gnus-part)))
|
|
||||||
(when (and part (numberp index) (not (assoc index parts)))
|
|
||||||
(push `(,index . ,part) parts))
|
|
||||||
(goto-char (or (next-single-property-change (point) 'gnus-part)
|
|
||||||
(point-max))))))
|
|
||||||
parts))
|
|
||||||
|
|
||||||
|
|
||||||
(defun mu4e-view-save-attachments (&optional arg)
|
|
||||||
"Save MIME-parts from current mu4e gnus view buffer.
|
|
||||||
|
|
||||||
When helm-mode is enabled provide completion on attachments and
|
|
||||||
possibility to mark candidates to save, otherwise completion on
|
|
||||||
attachments is done with `completing-read-multiple', in this case
|
|
||||||
use \",\" to separate candidate, completion is provided after
|
|
||||||
each \",\".
|
|
||||||
|
|
||||||
ARG is specific for the handler, see below.
|
|
||||||
|
|
||||||
Note, currently this does not work well with file names
|
|
||||||
containing commas."
|
|
||||||
(interactive "P")
|
|
||||||
(cl-assert (and (eq major-mode 'mu4e-view-mode)
|
|
||||||
(derived-mode-p 'gnus-article-mode)))
|
|
||||||
(let* ((parts (mu4e--view-gather-mime-parts))
|
|
||||||
(handles '())
|
|
||||||
(files '())
|
|
||||||
(compfn (if (and (boundp 'helm-mode) helm-mode)
|
|
||||||
#'completing-read
|
|
||||||
;; Fallback to `completing-read-multiple' with poor
|
|
||||||
;; completion
|
|
||||||
#'completing-read-multiple))
|
|
||||||
dir)
|
|
||||||
(dolist (part parts)
|
|
||||||
(let ((fname (or (cdr (assoc 'filename (assoc "attachment" (cdr part))))
|
|
||||||
(cl-loop for item in part
|
|
||||||
for name = (and (listp item)
|
|
||||||
(assoc-default 'name item))
|
|
||||||
thereis (and (stringp name) name)))))
|
|
||||||
(when fname
|
|
||||||
(push `(,fname . ,(cdr part)) handles)
|
|
||||||
(push fname files))))
|
|
||||||
(if files
|
|
||||||
(progn
|
|
||||||
(setq files (let ((helm-comp-read-use-marked t))
|
|
||||||
(funcall compfn "Save part(s): " files))
|
|
||||||
dir (if arg (read-directory-name "Save to directory: ")
|
|
||||||
mu4e-attachment-dir))
|
|
||||||
(cl-loop for (f . h) in handles
|
|
||||||
when (member f files)
|
|
||||||
do (mm-save-part-to-file
|
|
||||||
h (let ((file (expand-file-name f dir)))
|
|
||||||
(if (file-exists-p file)
|
|
||||||
(let (newname (count 1))
|
|
||||||
(while (and
|
|
||||||
(setq newname
|
|
||||||
(concat
|
|
||||||
(file-name-sans-extension file)
|
|
||||||
(format "(%s)" count)
|
|
||||||
(file-name-extension file t)))
|
|
||||||
(file-exists-p newname))
|
|
||||||
(cl-incf count))
|
|
||||||
newname)
|
|
||||||
file)))))
|
|
||||||
(mu4e-message "No attached files found"))))
|
|
||||||
|
|
||||||
|
|
||||||
(defvar mu4e-view-mime-part-actions
|
|
||||||
'(
|
|
||||||
;;
|
|
||||||
;; some basic ones
|
|
||||||
;;
|
|
||||||
|
|
||||||
;; save MIME-part to a file
|
|
||||||
(:name "save" :handler gnus-article-save-part :receives index)
|
|
||||||
;; pipe MIME-part to some arbitrary shell command
|
|
||||||
(:name "|pipe" :handler gnus-article-pipe-part :receives index)
|
|
||||||
;; open with the default handler, if any
|
|
||||||
(:name "open" :handler mu4e--view-open-file :receives temp)
|
|
||||||
;; open with some custom file.
|
|
||||||
(:name "wopen-with" :handler (lambda (file)(mu4e--view-open-file file t))
|
|
||||||
:receives temp)
|
|
||||||
|
|
||||||
;;
|
|
||||||
;; some more examples
|
|
||||||
;;
|
|
||||||
|
|
||||||
;; import GPG key
|
|
||||||
(:name "gpg" :handler epa-import-keys :receives temp)
|
|
||||||
;; count the number of lines in a MIME-part
|
|
||||||
(:name "line-count" :handler "wc -l" :receives pipe)
|
|
||||||
;; open in this emacs instance; tries to use the attachment name,
|
|
||||||
;; so emacs can use specific modes etc.
|
|
||||||
(:name "emacs" :handler find-file-read-only :receives temp)
|
|
||||||
;; open in this emacs instance, "raw"
|
|
||||||
(:name "raw" :handler (lambda (str)
|
|
||||||
(let ((tmpbuf
|
|
||||||
(get-buffer-create " *mu4e-raw-mime*")))
|
|
||||||
(with-current-buffer tmpbuf
|
|
||||||
(insert str)
|
|
||||||
(view-mode)
|
|
||||||
(goto-char (point-min)))
|
|
||||||
(display-buffer tmpbuf))) :receives pipe))
|
|
||||||
|
|
||||||
"Specifies actions for MIME-parts.
|
|
||||||
|
|
||||||
Each of the actions is a plist with keys
|
|
||||||
`(:name <name> ;; name of the action; shortcut is first letter of name
|
|
||||||
|
|
||||||
:handler ;; one of:
|
|
||||||
;; - a function receiving the index/temp/pipe
|
|
||||||
;; - a string, which is taken as a shell command
|
|
||||||
|
|
||||||
:receives ;; a symbol specifying what the handler receives
|
|
||||||
;; - index: the index number of the mime part (default)
|
|
||||||
;; - temp: the full path to the mime part in a
|
|
||||||
;; temporary file, which is deleted immediately
|
|
||||||
;; after invoking handler
|
|
||||||
;; - pipe: the attachment is piped to some shell command
|
|
||||||
;; or as a string parameter to a function
|
|
||||||
).")
|
|
||||||
|
|
||||||
|
|
||||||
(defun mu4e--view-mime-part-to-temp-file (handle)
|
|
||||||
"Write MIME-part HANDLE to a temporary file and return the file name.
|
|
||||||
The filename is deduced from the MIME-part's filename, or
|
|
||||||
otherwise random; the result is placed in a temporary directory
|
|
||||||
with a unique name. Returns the full path for the file created.
|
|
||||||
The directory and file are self-destructed."
|
|
||||||
(let* ((tmpdir (make-temp-file "mu4e-temp-" t))
|
|
||||||
(fname (mm-handle-filename handle))
|
|
||||||
(fname (and fname
|
|
||||||
(gnus-map-function mm-file-name-rewrite-functions
|
|
||||||
(file-name-nondirectory fname))))
|
|
||||||
(fname (if fname
|
|
||||||
(concat tmpdir "/" (replace-regexp-in-string "/" "-" fname))
|
|
||||||
(let ((temporary-file-directory tmpdir))
|
|
||||||
(make-temp-file "mimepart")))))
|
|
||||||
(mm-save-part-to-file handle fname)
|
|
||||||
(run-at-time "30 sec" nil
|
|
||||||
(lambda () (ignore-errors (delete-directory tmpdir t))))
|
|
||||||
fname))
|
|
||||||
|
|
||||||
|
|
||||||
(defun mu4e--view-open-file (file &optional force-ask)
|
|
||||||
"Open FILE with default handler, if any.
|
|
||||||
Otherwise, or if FORCE-ASK is set, ask user for the program to
|
|
||||||
open with."
|
|
||||||
(if (and (not force-ask)
|
|
||||||
(functionp mu4e-view-open-program))
|
|
||||||
(funcall mu4e-view-open-program file)
|
|
||||||
(let ((opener
|
|
||||||
(or (and (not force-ask) mu4e-view-open-program
|
|
||||||
(executable-find mu4e-view-open-program))
|
|
||||||
(read-shell-command "Open MIME-part with: "))))
|
|
||||||
(call-process opener nil 0 nil file))))
|
|
||||||
|
|
||||||
(defun mu4e-view-mime-part-action (&optional n)
|
|
||||||
"Apply some action to MIME-part N in the current messsage.
|
|
||||||
If N is not specified, ask for it. For instance, '3 A o' opens
|
|
||||||
the third MIME-part."
|
|
||||||
(interactive "NNumber of MIME-part: ")
|
|
||||||
(let* ((parts (mu4e--view-gather-mime-parts))
|
|
||||||
(options
|
|
||||||
(mapcar (lambda (action) `(,(plist-get action :name) . ,action))
|
|
||||||
mu4e-view-mime-part-actions))
|
|
||||||
(handle
|
|
||||||
(or (cdr-safe (seq-find (lambda (part) (eq (car part) n)) parts))
|
|
||||||
(mu4e-error "MIME-part %s not found" n)))
|
|
||||||
(action
|
|
||||||
(or (and options (mu4e-read-option "Action on MIME-part: " options))
|
|
||||||
(mu4e-error "No such action")))
|
|
||||||
(handler
|
|
||||||
(or (plist-get action :handler)
|
|
||||||
(mu4e-error "No :handler item found for action %S" action)))
|
|
||||||
(receives
|
|
||||||
(or (plist-get action :receives)
|
|
||||||
(mu4e-error "No :receives item found for action %S" action))))
|
|
||||||
(save-excursion
|
|
||||||
(cond
|
|
||||||
((functionp handler)
|
|
||||||
(cond
|
|
||||||
((eq receives 'index) (funcall handler n))
|
|
||||||
((eq receives 'pipe) (funcall handler (mm-with-unibyte-buffer
|
|
||||||
(mm-insert-part handle)
|
|
||||||
(buffer-string))))
|
|
||||||
((eq receives 'temp)
|
|
||||||
(funcall handler (mu4e--view-mime-part-to-temp-file handle)))
|
|
||||||
(t (mu4e-error "Invalid :receive for %S" action))))
|
|
||||||
((stringp handler)
|
|
||||||
(cond
|
|
||||||
((eq receives 'index)
|
|
||||||
(shell-command (concat handler " " (shell-quote-argument n))))
|
|
||||||
((eq receives 'pipe) (mm-pipe-part handle handler))
|
|
||||||
((eq receives 'temp)
|
|
||||||
(shell-command
|
|
||||||
(shell-command (concat handler " "
|
|
||||||
(shell-quote-argument
|
|
||||||
(mu4e--view-mime-part-to-temp-file handle))))))
|
|
||||||
(t (mu4e-error "Invalid action %S" action))))))))
|
|
||||||
|
|
||||||
(defun mu4e-view-toggle-html ()
|
(defun mu4e-view-toggle-html ()
|
||||||
"Toggle html-display of the first html-part found."
|
"Toggle html-display of the first html-part found."
|
||||||
(interactive)
|
(interactive)
|
||||||
|
@ -1331,24 +1094,16 @@ the third MIME-part."
|
||||||
(save-excursion
|
(save-excursion
|
||||||
(if-let ((html-part
|
(if-let ((html-part
|
||||||
(seq-find (lambda (handle)
|
(seq-find (lambda (handle)
|
||||||
(equal (mm-handle-media-type (cdr handle)) "text/html"))
|
(equal (mm-handle-media-type (cdr handle))
|
||||||
|
"text/html"))
|
||||||
gnus-article-mime-handle-alist))
|
gnus-article-mime-handle-alist))
|
||||||
(text-part
|
(text-part
|
||||||
(seq-find (lambda (handle)
|
(seq-find (lambda (handle)
|
||||||
(equal (mm-handle-media-type (cdr handle)) "text/plain"))
|
(equal (mm-handle-media-type (cdr handle))
|
||||||
|
"text/plain"))
|
||||||
gnus-article-mime-handle-alist)))
|
gnus-article-mime-handle-alist)))
|
||||||
(gnus-article-inline-part (car html-part))
|
(gnus-article-inline-part (car html-part))
|
||||||
(mu4e-warn "Cannot switch; no html and/or text part in this message"))))
|
(mu4e-warn "Cannot switch; no html and/or text part in this message"))))
|
||||||
|
|
||||||
(defun mu4e-process-file-through-pipe (path pipecmd)
|
|
||||||
"Process file at PATH through a pipe with PIPECMD."
|
|
||||||
(let ((buf (get-buffer-create "*mu4e-output")))
|
|
||||||
(with-current-buffer buf
|
|
||||||
(let ((inhibit-read-only t))
|
|
||||||
(erase-buffer)
|
|
||||||
(call-process-shell-command pipecmd path t t)
|
|
||||||
(view-mode)))
|
|
||||||
(display-buffer buf)))
|
|
||||||
|
|
||||||
;;; Bug Reference mode support
|
;;; Bug Reference mode support
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue