emacs
/
mu
mirror of https://github.com/djcb/mu.git
1
0
Fork 0
Code Issues Releases Wiki Activity
mu/mu4e/mu4e-mime-parts.el

487 lines
19 KiB
EmacsLisp
Raw Permalink Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;; mu4e-mime-parts.el --- Dealing with MIME-parts & URLs -*- 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 (mm-handle-filename part))
(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) ", ")))))
(defvar mu4e-view-completion-minor-mode-map
(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)
"Keybindings for mu4e-view completion.")
(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 mu4e-view-completion-minor-mode-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 the handler returns
;; - 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
Reference in New Issue View Git Blame Copy Permalink