mirror of https://github.com/djcb/mu.git
1098 lines
46 KiB
EmacsLisp
1098 lines
46 KiB
EmacsLisp
|
;;; mu4e-view-old.el -- part of mu4e, the mu mail user agent -*- lexical-binding: t -*-
|
|||
|
|
|
|||
|
|
;; Copyright (C) 2011-2020 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:
|
|||
|
|
|
|||
|
|
;; In this file we define mu4e-view-mode (+ helper functions), which is used for
|
|||
|
|
;; viewing e-mail messages
|
|||
|
|
|
|||
|
|
;;; Code:
|
|||
|
|
|
|||
|
|
(require 'cl-lib)
|
|||
|
|
(require 'mu4e-view-common)
|
|||
|
|
|
|||
|
|
(declare-function mu4e-view "mu4e-view")
|
|||
|
|
|
|||
|
|
;;; Internal variables
|
|||
|
|
|
|||
|
|
(defvar mu4e-view-fill-headers t
|
|||
|
|
"If non-nil, automatically fill the headers when viewing them.")
|
|||
|
|
|
|||
|
|
(defvar mu4e~view-cited-hidden nil "Whether cited lines are hidden.")
|
|||
|
|
(put 'mu4e~view-cited-hidden 'permanent-local t)
|
|||
|
|
|
|||
|
|
(defvar mu4e~path-parent-docid-map (make-hash-table :test 'equal)
|
|||
|
|
"A map of msg paths --> parent-docids.
|
|||
|
|
This is to determine what is the parent docid for embedded
|
|||
|
|
message extracted at some path.")
|
|||
|
|
(put 'mu4e~path-parent-docid-map 'permanent-local t)
|
|||
|
|
|
|||
|
|
(defvar mu4e~view-attach-map nil
|
|||
|
|
"A mapping of user-visible attachment number to the actual part index.")
|
|||
|
|
(put 'mu4e~view-attach-map 'permanent-local t)
|
|||
|
|
|
|||
|
|
(defvar mu4e~view-rendering nil)
|
|||
|
|
|
|||
|
|
(defvar mu4e~view-html-text nil
|
|||
|
|
"Should we prefer html or text just this once? A symbol `text'
|
|||
|
|
or `html' or nil.")
|
|||
|
|
|
|||
|
|
;;; Main
|
|||
|
|
|
|||
|
|
(defun mu4e~view-custom-field (msg field)
|
|||
|
|
"Show some custom header field, or raise an error if it is not
|
|||
|
|
found."
|
|||
|
|
(let* ((item (or (assoc field mu4e-header-info-custom)
|
|||
|
|
(mu4e-error "field %S not found" field)))
|
|||
|
|
(func (or (plist-get (cdr-safe item) :function)
|
|||
|
|
(mu4e-error "no :function defined for field %S %S"
|
|||
|
|
field (cdr item)))))
|
|||
|
|
(funcall func msg)))
|
|||
|
|
|
|||
|
|
(defun mu4e-view-message-text (msg)
|
|||
|
|
"Return the message to display (as a string), based on the MSG plist."
|
|||
|
|
(concat
|
|||
|
|
(mapconcat
|
|||
|
|
(lambda (field)
|
|||
|
|
(let ((fieldval (mu4e-message-field msg field)))
|
|||
|
|
(cl-case field
|
|||
|
|
(:subject (mu4e~view-construct-header field fieldval))
|
|||
|
|
(:path (mu4e~view-construct-header field fieldval))
|
|||
|
|
(:maildir (mu4e~view-construct-header field fieldval))
|
|||
|
|
(:user-agent (mu4e~view-construct-header field fieldval))
|
|||
|
|
((:flags :tags) (mu4e~view-construct-flags-tags-header
|
|||
|
|
field fieldval))
|
|||
|
|
|
|||
|
|
;; contact fields
|
|||
|
|
(:to (mu4e~view-construct-contacts-header msg field))
|
|||
|
|
(:from (mu4e~view-construct-contacts-header msg field))
|
|||
|
|
(:cc (mu4e~view-construct-contacts-header msg field))
|
|||
|
|
(:bcc (mu4e~view-construct-contacts-header msg field))
|
|||
|
|
|
|||
|
|
;; if we (`user-mail-address' are the From, show To, otherwise,
|
|||
|
|
;; show From
|
|||
|
|
(:from-or-to
|
|||
|
|
(let* ((from (mu4e-message-field msg :from))
|
|||
|
|
(from (and from (cdar from))))
|
|||
|
|
(if (mu4e-personal-address-p from)
|
|||
|
|
(mu4e~view-construct-contacts-header msg :to)
|
|||
|
|
(mu4e~view-construct-contacts-header msg :from))))
|
|||
|
|
;; date
|
|||
|
|
(:date
|
|||
|
|
(let ((datestr
|
|||
|
|
(when fieldval (format-time-string mu4e-view-date-format
|
|||
|
|
fieldval))))
|
|||
|
|
(if datestr (mu4e~view-construct-header field datestr) "")))
|
|||
|
|
;; size
|
|||
|
|
(:size
|
|||
|
|
(mu4e~view-construct-header field (mu4e-display-size fieldval)))
|
|||
|
|
(:mailing-list
|
|||
|
|
(mu4e~view-construct-header field fieldval))
|
|||
|
|
(:message-id
|
|||
|
|
(mu4e~view-construct-header field fieldval))
|
|||
|
|
;; attachments
|
|||
|
|
(:attachments (mu4e~view-construct-attachments-header msg))
|
|||
|
|
;; pgp-signatures
|
|||
|
|
(:signature (mu4e~view-construct-signature-header msg))
|
|||
|
|
;; pgp-decryption
|
|||
|
|
(:decryption (mu4e~view-construct-decryption-header msg))
|
|||
|
|
(t (mu4e~view-construct-header field
|
|||
|
|
(mu4e~view-custom-field msg field))))))
|
|||
|
|
mu4e-view-fields "")
|
|||
|
|
"\n"
|
|||
|
|
(let* ((prefer-html
|
|||
|
|
(cond
|
|||
|
|
((eq mu4e~view-html-text 'html) t)
|
|||
|
|
((eq mu4e~view-html-text 'text) nil)
|
|||
|
|
(t mu4e-view-prefer-html)))
|
|||
|
|
(body (mu4e-message-body-text msg prefer-html)))
|
|||
|
|
(setq mu4e~view-html-text nil)
|
|||
|
|
(when (fboundp 'add-face-text-property)
|
|||
|
|
(add-face-text-property 0 (length body) 'mu4e-view-body-face t body))
|
|||
|
|
body)))
|
|||
|
|
|
|||
|
|
(defun mu4e~view-embedded-winbuf ()
|
|||
|
|
"Get a buffer (shown in a window) for the embedded message."
|
|||
|
|
(let* ((buf (get-buffer-create mu4e~view-embedded-buffer-name))
|
|||
|
|
(win (or (get-buffer-window buf) (split-window-vertically))))
|
|||
|
|
(select-window win)
|
|||
|
|
(switch-to-buffer buf)))
|
|||
|
|
|
|||
|
|
(defun mu4e~delete-all-overlays ()
|
|||
|
|
"`delete-all-overlays' with compatibility fallback."
|
|||
|
|
(if (functionp 'delete-all-overlays)
|
|||
|
|
(delete-all-overlays)
|
|||
|
|
(remove-overlays)))
|
|||
|
|
|
|||
|
|
(defun mu4e~view-old (msg)
|
|||
|
|
"Display MSG using mu4e's internal view mode."
|
|||
|
|
(let* ((embedded ;; is it as an embedded msg (ie. message/rfc822 att)?
|
|||
|
|
(when (gethash (mu4e-message-field msg :path)
|
|||
|
|
mu4e~path-parent-docid-map) t))
|
|||
|
|
(buf (if embedded
|
|||
|
|
(mu4e~view-embedded-winbuf)
|
|||
|
|
(get-buffer-create mu4e~view-buffer-name))))
|
|||
|
|
|
|||
|
|
;; XXX(djcb): only called for the side-effect of setting up
|
|||
|
|
;; `mu4e~view-attach-map'. Instead, we should split that function
|
|||
|
|
;; into setting up the map, and actually producing the header.
|
|||
|
|
(mu4e~view-construct-attachments-header msg)
|
|||
|
|
|
|||
|
|
(with-current-buffer buf
|
|||
|
|
(let ((inhibit-read-only t))
|
|||
|
|
(erase-buffer)
|
|||
|
|
(mu4e~delete-all-overlays)
|
|||
|
|
(insert (mu4e-view-message-text msg))
|
|||
|
|
(goto-char (point-min))
|
|||
|
|
(mu4e~fontify-cited)
|
|||
|
|
(mu4e~fontify-signature)
|
|||
|
|
(mu4e~view-activate-urls)
|
|||
|
|
(mu4e~view-show-images-maybe msg)
|
|||
|
|
(when (not embedded) (setq mu4e~view-message msg))
|
|||
|
|
(mu4e-view-mode)
|
|||
|
|
(when embedded (local-set-key "q" 'kill-buffer-and-window)))
|
|||
|
|
(switch-to-buffer buf))))
|
|||
|
|
|
|||
|
|
|
|||
|
|
(defun mu4e~view-construct-header (field val &optional dont-propertize-val)
|
|||
|
|
"Return header field FIELD (as in `mu4e-header-info') with value
|
|||
|
|
VAL if VAL is non-nil. If DONT-PROPERTIZE-VAL is non-nil, do not
|
|||
|
|
add text-properties to VAL."
|
|||
|
|
(let* ((info (cdr (assoc field
|
|||
|
|
(append mu4e-header-info mu4e-header-info-custom))))
|
|||
|
|
(key (plist-get info :name))
|
|||
|
|
(val (if val (propertize val 'field 'mu4e-header-field-value
|
|||
|
|
'front-sticky '(field))))
|
|||
|
|
(help (plist-get info :help)))
|
|||
|
|
(if (and val (> (length val) 0))
|
|||
|
|
(with-temp-buffer
|
|||
|
|
(insert (propertize (concat key ":")
|
|||
|
|
'field 'mu4e-header-field-key
|
|||
|
|
'front-sticky '(field)
|
|||
|
|
'keymap mu4e-view-header-field-keymap
|
|||
|
|
'face 'mu4e-header-key-face
|
|||
|
|
'help-echo help) " "
|
|||
|
|
(if dont-propertize-val
|
|||
|
|
val
|
|||
|
|
(propertize val 'face 'mu4e-header-value-face)) "\n")
|
|||
|
|
(when mu4e-view-fill-headers
|
|||
|
|
;; temporarily set the fill column <margin> positions to the right, so
|
|||
|
|
;; we can indent the following lines correctly
|
|||
|
|
(let* ((margin 1)
|
|||
|
|
(fill-column (max (- fill-column margin) 0)))
|
|||
|
|
(fill-region (point-min) (point-max))
|
|||
|
|
(goto-char (point-min))
|
|||
|
|
(while (and (zerop (forward-line 1)) (not (looking-at "^$")))
|
|||
|
|
(indent-to-column margin))))
|
|||
|
|
(buffer-string))
|
|||
|
|
"")))
|
|||
|
|
|
|||
|
|
(defun mu4e~view-header-field-fold ()
|
|||
|
|
"Fold/unfold headers' value if there is more than one line."
|
|||
|
|
(interactive)
|
|||
|
|
(let ((name-pos (field-beginning))
|
|||
|
|
(value-pos (1+ (field-end))))
|
|||
|
|
(if (and name-pos value-pos
|
|||
|
|
(eq (get-text-property name-pos 'field) 'mu4e-header-field-key))
|
|||
|
|
(save-excursion
|
|||
|
|
(let* ((folded))
|
|||
|
|
(mapc (lambda (o)
|
|||
|
|
(when (overlay-get o 'mu4e~view-header-field-folded)
|
|||
|
|
(delete-overlay o)
|
|||
|
|
(setq folded t)))
|
|||
|
|
(overlays-at value-pos))
|
|||
|
|
(unless folded
|
|||
|
|
(let* ((o (make-overlay value-pos (field-end value-pos)))
|
|||
|
|
(vals (split-string (field-string value-pos) "\n" t))
|
|||
|
|
(val (if (= (length vals) 1)
|
|||
|
|
(car vals)
|
|||
|
|
(truncate-string-to-width (car vals)
|
|||
|
|
(- (length (car vals)) 1) 0 nil t))))
|
|||
|
|
(overlay-put o 'mu4e~view-header-field-folded t)
|
|||
|
|
(overlay-put o 'display val))))))))
|
|||
|
|
|
|||
|
|
(defun mu4e~view-compose-contact (&optional point)
|
|||
|
|
"Compose a message for the address at point."
|
|||
|
|
(interactive)
|
|||
|
|
(unless (get-text-property (or point (point)) 'email)
|
|||
|
|
(mu4e-error "No address at point"))
|
|||
|
|
(mu4e~compose-mail (get-text-property (or point (point)) 'long)))
|
|||
|
|
|
|||
|
|
(defun mu4e~view-copy-contact (&optional full)
|
|||
|
|
"Compose a message for the address at (point)."
|
|||
|
|
(interactive "P")
|
|||
|
|
(let ((email (get-text-property (point) 'email))
|
|||
|
|
(long (get-text-property (point) 'long)))
|
|||
|
|
(unless email (mu4e-error "No address at point"))
|
|||
|
|
(kill-new (if full long email))
|
|||
|
|
(mu4e-message "Address copied.")))
|
|||
|
|
|
|||
|
|
(defun mu4e~view-construct-contacts-header (msg field)
|
|||
|
|
"Add a header for a contact field (ie., :to, :from, :cc, :bcc)."
|
|||
|
|
(mu4e~view-construct-header field
|
|||
|
|
(mapconcat
|
|||
|
|
(lambda(c)
|
|||
|
|
(let* ((name (when (car c)
|
|||
|
|
(replace-regexp-in-string "[[:cntrl:]]" "" (car c))))
|
|||
|
|
(email (when (cdr c)
|
|||
|
|
(replace-regexp-in-string "[[:cntrl:]]" "" (cdr c))))
|
|||
|
|
(short (or name email)) ;; name may be nil
|
|||
|
|
(long (if name (format "%s <%s>" name email) email)))
|
|||
|
|
(propertize
|
|||
|
|
(if mu4e-view-show-addresses long short)
|
|||
|
|
'long long
|
|||
|
|
'short short
|
|||
|
|
'email email
|
|||
|
|
'keymap mu4e-view-contacts-header-keymap
|
|||
|
|
'face 'mu4e-contact-face
|
|||
|
|
'mouse-face 'highlight
|
|||
|
|
'help-echo (format "<%s>\n%s" email
|
|||
|
|
"[mouse-2] or C to compose a mail for this recipient"))))
|
|||
|
|
(mu4e-message-field msg field) ", ") t))
|
|||
|
|
|
|||
|
|
(defun mu4e~view-construct-flags-tags-header (field val)
|
|||
|
|
"Construct a Flags: header."
|
|||
|
|
(mu4e~view-construct-header
|
|||
|
|
field
|
|||
|
|
(mapconcat
|
|||
|
|
(lambda (flag)
|
|||
|
|
(propertize
|
|||
|
|
(if (symbolp flag)
|
|||
|
|
(symbol-name flag)
|
|||
|
|
flag)
|
|||
|
|
'face 'mu4e-special-header-value-face))
|
|||
|
|
val
|
|||
|
|
(propertize ", " 'face 'mu4e-header-value-face)) t))
|
|||
|
|
|
|||
|
|
(defun mu4e~view-construct-signature-header (msg)
|
|||
|
|
"Construct a Signature: header, if there are any signed parts."
|
|||
|
|
(let* ((parts (mu4e-message-field msg :parts))
|
|||
|
|
(verdicts
|
|||
|
|
(cl-remove-if 'null
|
|||
|
|
(mapcar (lambda (part) (mu4e-message-part-field part :signature))
|
|||
|
|
parts)))
|
|||
|
|
(signers
|
|||
|
|
(mapconcat 'identity
|
|||
|
|
(cl-remove-if 'null
|
|||
|
|
(mapcar (lambda (part) (mu4e-message-part-field part :signers))
|
|||
|
|
parts)) ", "))
|
|||
|
|
(val (when verdicts
|
|||
|
|
(mapconcat
|
|||
|
|
(lambda (v)
|
|||
|
|
(propertize (symbol-name v)
|
|||
|
|
'face (if (eq v 'verified)
|
|||
|
|
'mu4e-ok-face 'mu4e-warning-face)))
|
|||
|
|
verdicts ", ")))
|
|||
|
|
(btn (when val
|
|||
|
|
(with-temp-buffer
|
|||
|
|
(insert-text-button "Details"
|
|||
|
|
'action (lambda (b)
|
|||
|
|
(mu4e-view-verify-msg-popup
|
|||
|
|
(button-get b 'msg))))
|
|||
|
|
(buffer-string))))
|
|||
|
|
(val (when val (concat val " " signers " (" btn ")"))))
|
|||
|
|
(mu4e~view-construct-header :signature val t)))
|
|||
|
|
|
|||
|
|
(defun mu4e~view-construct-decryption-header (msg)
|
|||
|
|
"Construct a Decryption: header, if there are any encrypted parts."
|
|||
|
|
(let* ((parts (mu4e-message-field msg :parts))
|
|||
|
|
(verdicts
|
|||
|
|
(cl-remove-if 'null
|
|||
|
|
(mapcar (lambda (part)
|
|||
|
|
(mu4e-message-part-field part :decryption))
|
|||
|
|
parts)))
|
|||
|
|
(succeeded (cl-remove-if (lambda (v) (eq v 'failed)) verdicts))
|
|||
|
|
(failed (cl-remove-if (lambda (v) (eq v 'succeeded)) verdicts))
|
|||
|
|
(succ (when succeeded
|
|||
|
|
(propertize
|
|||
|
|
(concat (number-to-string (length succeeded))
|
|||
|
|
" part(s) decrypted")
|
|||
|
|
'face 'mu4e-ok-face)))
|
|||
|
|
(fail (when failed
|
|||
|
|
(propertize
|
|||
|
|
(concat (number-to-string (length failed))
|
|||
|
|
" part(s) failed")
|
|||
|
|
'face 'mu4e-warning-face)))
|
|||
|
|
(val (concat succ fail)))
|
|||
|
|
(mu4e~view-construct-header :decryption val t)))
|
|||
|
|
|
|||
|
|
(defun mu4e~view-open-attach-from-binding ()
|
|||
|
|
"Open the attachment at point, or click location."
|
|||
|
|
(interactive)
|
|||
|
|
(let* (( msg (mu4e~view-get-property-from-event 'mu4e-msg))
|
|||
|
|
( attnum (mu4e~view-get-property-from-event 'mu4e-attnum)))
|
|||
|
|
(when (and msg attnum)
|
|||
|
|
(mu4e-view-open-attachment msg attnum))))
|
|||
|
|
|
|||
|
|
(defun mu4e~view-save-attach-from-binding ()
|
|||
|
|
"Save the attachment at point, or click location."
|
|||
|
|
(interactive)
|
|||
|
|
(let* (( msg (mu4e~view-get-property-from-event 'mu4e-msg))
|
|||
|
|
( attnum (mu4e~view-get-property-from-event 'mu4e-attnum)))
|
|||
|
|
(when (and msg attnum)
|
|||
|
|
(mu4e-view-save-attachment-single msg attnum))))
|
|||
|
|
|
|||
|
|
(defun mu4e~view-construct-attachments-header (msg)
|
|||
|
|
"Display attachment information; the field looks like something like:
|
|||
|
|
:parts ((:index 1 :name \"1.part\" :mime-type \"text/plain\"
|
|||
|
|
:type (leaf) :attachment nil :size 228)
|
|||
|
|
(:index 2 :name \"analysis.doc\"
|
|||
|
|
:mime-type \"application/msword\"
|
|||
|
|
:type (leaf attachment) :attachment nil :size 605196))"
|
|||
|
|
(setq mu4e~view-attach-map ;; buffer local
|
|||
|
|
(make-hash-table :size 64 :weakness nil))
|
|||
|
|
(let* ((id 0)
|
|||
|
|
(partcount (length (mu4e-message-field msg :parts)))
|
|||
|
|
(attachments
|
|||
|
|
;; we only list parts that look like attachments, ie. that have a
|
|||
|
|
;; non-nil :attachment property; we record a mapping between
|
|||
|
|
;; user-visible numbers and the part indices
|
|||
|
|
(cl-remove-if-not
|
|||
|
|
(lambda (part)
|
|||
|
|
(let* ((mtype (or (mu4e-message-part-field part :mime-type)
|
|||
|
|
"application/octet-stream"))
|
|||
|
|
(partsize (or (mu4e-message-part-field part :size) 0))
|
|||
|
|
(attachtype (mu4e-message-part-field part :type))
|
|||
|
|
(isattach
|
|||
|
|
(or ;; we consider parts marked either
|
|||
|
|
;; "attachment" or "inline" as attachment.
|
|||
|
|
(member 'attachment attachtype)
|
|||
|
|
;; list inline parts as attachment (so they can be
|
|||
|
|
;; saved), unless they are text/plain, which are
|
|||
|
|
;; usually just message footers in mailing lists
|
|||
|
|
;;
|
|||
|
|
;; however, slow bigger text parts as attachments,
|
|||
|
|
;; except when they're the only part... it's
|
|||
|
|
;; complicated.
|
|||
|
|
(and (member 'inline attachtype)
|
|||
|
|
(or
|
|||
|
|
(and (> partcount 1) (> partsize 256))
|
|||
|
|
(not (string-match "^text/plain" mtype)))))))
|
|||
|
|
(or ;; remove if it's not an attach *or* if it's an
|
|||
|
|
;; image/audio/application type (but not a signature)
|
|||
|
|
isattach
|
|||
|
|
(string-match "^\\(image\\|audio\\)" mtype)
|
|||
|
|
(string= "message/rfc822" mtype)
|
|||
|
|
(string= "text/calendar" mtype)
|
|||
|
|
(and (string-match "^application" mtype)
|
|||
|
|
(not (string-match "signature" mtype))))))
|
|||
|
|
(mu4e-message-field msg :parts)))
|
|||
|
|
(attstr
|
|||
|
|
(mapconcat
|
|||
|
|
(lambda (part)
|
|||
|
|
(let ((index (mu4e-message-part-field part :index))
|
|||
|
|
(name (mu4e-message-part-field part :name))
|
|||
|
|
(size (mu4e-message-part-field part :size)))
|
|||
|
|
(cl-incf id)
|
|||
|
|
(puthash id index mu4e~view-attach-map)
|
|||
|
|
|
|||
|
|
(concat
|
|||
|
|
(propertize (format "[%d]" id)
|
|||
|
|
'face 'mu4e-attach-number-face)
|
|||
|
|
(propertize name 'face 'mu4e-link-face
|
|||
|
|
'keymap mu4e-view-attachments-header-keymap
|
|||
|
|
'mouse-face 'highlight
|
|||
|
|
'help-echo (concat
|
|||
|
|
"[mouse-1] or [M-RET] opens the attachment\n"
|
|||
|
|
"[mouse-2] or [S-RET] offers to save it")
|
|||
|
|
'mu4e-msg msg
|
|||
|
|
'mu4e-attnum id
|
|||
|
|
)
|
|||
|
|
(when (and size (> size 0))
|
|||
|
|
(propertize (format "(%s)" (mu4e-display-size size))
|
|||
|
|
'face 'mu4e-header-key-face)))))
|
|||
|
|
attachments ", ")))
|
|||
|
|
(when attachments
|
|||
|
|
(mu4e~view-construct-header :attachments attstr t))))
|
|||
|
|
|
|||
|
|
(defun mu4e-view-for-each-part (msg func)
|
|||
|
|
"Apply FUNC to each part in MSG.
|
|||
|
|
FUNC should be a function taking two arguments:
|
|||
|
|
1. the message MSG, and
|
|||
|
|
2. a plist describing the attachment. The plist looks like:
|
|||
|
|
(:index 1 :name \"test123.doc\"
|
|||
|
|
:mime-type \"application/msword\" :attachment t :size 1234)."
|
|||
|
|
(dolist (part (mu4e-msg-field msg :parts))
|
|||
|
|
(funcall func msg part)))
|
|||
|
|
|
|||
|
|
(defvar mu4e-view-mode-map nil
|
|||
|
|
"Keymap for \"*mu4e-view*\" buffers.")
|
|||
|
|
(unless mu4e-view-mode-map
|
|||
|
|
(setq mu4e-view-mode-map
|
|||
|
|
(let ((map (make-sparse-keymap)))
|
|||
|
|
|
|||
|
|
(define-key map (kbd "C-S-u") 'mu4e-update-mail-and-index)
|
|||
|
|
(define-key map (kbd "C-c C-u") 'mu4e-update-mail-and-index)
|
|||
|
|
|
|||
|
|
(define-key map "q" 'mu4e~view-quit-buffer)
|
|||
|
|
|
|||
|
|
;; note, 'z' is by-default bound to 'bury-buffer'
|
|||
|
|
;; but that's not very useful in this case
|
|||
|
|
(define-key map "z" 'ignore)
|
|||
|
|
|
|||
|
|
(define-key map "s" 'mu4e-headers-search)
|
|||
|
|
(define-key map "S" 'mu4e-view-search-edit)
|
|||
|
|
(define-key map "/" 'mu4e-view-search-narrow)
|
|||
|
|
|
|||
|
|
(define-key map (kbd "<M-left>") 'mu4e-headers-query-prev)
|
|||
|
|
(define-key map (kbd "<M-right>") 'mu4e-headers-query-next)
|
|||
|
|
|
|||
|
|
(define-key map "b" 'mu4e-headers-search-bookmark)
|
|||
|
|
(define-key map "B" 'mu4e-headers-search-bookmark-edit)
|
|||
|
|
|
|||
|
|
(define-key map "%" 'mu4e-view-mark-pattern)
|
|||
|
|
(define-key map "t" 'mu4e-view-mark-subthread)
|
|||
|
|
(define-key map "T" 'mu4e-view-mark-thread)
|
|||
|
|
|
|||
|
|
(define-key map "v" 'mu4e-view-verify-msg-popup)
|
|||
|
|
|
|||
|
|
(define-key map "j" 'mu4e~headers-jump-to-maildir)
|
|||
|
|
|
|||
|
|
(define-key map "g" 'mu4e-view-go-to-url)
|
|||
|
|
(define-key map "k" 'mu4e-view-save-url)
|
|||
|
|
(define-key map "f" 'mu4e-view-fetch-url)
|
|||
|
|
|
|||
|
|
(define-key map "F" 'mu4e-compose-forward)
|
|||
|
|
(define-key map "R" 'mu4e-compose-reply)
|
|||
|
|
(define-key map "C" 'mu4e-compose-new)
|
|||
|
|
(define-key map "E" 'mu4e-compose-edit)
|
|||
|
|
|
|||
|
|
(define-key map "." 'mu4e-view-raw-message)
|
|||
|
|
(define-key map "|" 'mu4e-view-pipe)
|
|||
|
|
(define-key map "a" 'mu4e-view-action)
|
|||
|
|
|
|||
|
|
(define-key map ";" 'mu4e-context-switch)
|
|||
|
|
|
|||
|
|
;; toggle header settings
|
|||
|
|
(define-key map "O" 'mu4e-headers-change-sorting)
|
|||
|
|
(define-key map "P" 'mu4e-headers-toggle-threading)
|
|||
|
|
(define-key map "Q" 'mu4e-headers-toggle-full-search)
|
|||
|
|
(define-key map "W" 'mu4e-headers-toggle-include-related)
|
|||
|
|
|
|||
|
|
;; change the number of headers
|
|||
|
|
(define-key map (kbd "C-+") 'mu4e-headers-split-view-grow)
|
|||
|
|
(define-key map (kbd "C--") 'mu4e-headers-split-view-shrink)
|
|||
|
|
(define-key map (kbd "<C-kp-add>") 'mu4e-headers-split-view-grow)
|
|||
|
|
(define-key map (kbd "<C-kp-subtract>") 'mu4e-headers-split-view-shrink)
|
|||
|
|
|
|||
|
|
;; intra-message navigation
|
|||
|
|
(define-key map (kbd "SPC") 'mu4e-view-scroll-up-or-next)
|
|||
|
|
(define-key map (kbd "RET") 'mu4e-scroll-up)
|
|||
|
|
(define-key map (kbd "<backspace>") 'mu4e-scroll-down)
|
|||
|
|
|
|||
|
|
;; navigation between messages
|
|||
|
|
(define-key map "p" 'mu4e-view-headers-prev)
|
|||
|
|
(define-key map "n" 'mu4e-view-headers-next)
|
|||
|
|
;; the same
|
|||
|
|
(define-key map (kbd "<M-down>") 'mu4e-view-headers-next)
|
|||
|
|
(define-key map (kbd "<M-up>") 'mu4e-view-headers-prev)
|
|||
|
|
|
|||
|
|
(define-key map (kbd "[") 'mu4e-view-headers-prev-unread)
|
|||
|
|
(define-key map (kbd "]") 'mu4e-view-headers-next-unread)
|
|||
|
|
|
|||
|
|
;; switching to view mode (if it's visible)
|
|||
|
|
(define-key map "y" 'mu4e-select-other-view)
|
|||
|
|
|
|||
|
|
;; attachments
|
|||
|
|
(define-key map "e" 'mu4e-view-save-attachment)
|
|||
|
|
(define-key map "o" 'mu4e-view-open-attachment)
|
|||
|
|
(define-key map "A" 'mu4e-view-attachment-action)
|
|||
|
|
|
|||
|
|
;; marking/unmarking
|
|||
|
|
(define-key map "d" 'mu4e-view-mark-for-trash)
|
|||
|
|
(define-key map (kbd "<delete>") 'mu4e-view-mark-for-delete)
|
|||
|
|
(define-key map (kbd "<deletechar>") 'mu4e-view-mark-for-delete)
|
|||
|
|
(define-key map (kbd "D") 'mu4e-view-mark-for-delete)
|
|||
|
|
(define-key map (kbd "m") 'mu4e-view-mark-for-move)
|
|||
|
|
(define-key map (kbd "r") 'mu4e-view-mark-for-refile)
|
|||
|
|
|
|||
|
|
(define-key map (kbd "?") 'mu4e-view-mark-for-unread)
|
|||
|
|
(define-key map (kbd "!") 'mu4e-view-mark-for-read)
|
|||
|
|
|
|||
|
|
(define-key map (kbd "+") 'mu4e-view-mark-for-flag)
|
|||
|
|
(define-key map (kbd "-") 'mu4e-view-mark-for-unflag)
|
|||
|
|
(define-key map (kbd "=") 'mu4e-view-mark-for-untrash)
|
|||
|
|
(define-key map (kbd "&") 'mu4e-view-mark-custom)
|
|||
|
|
|
|||
|
|
(define-key map (kbd "*") 'mu4e-view-mark-for-something)
|
|||
|
|
(define-key map (kbd "<kp-multiply>") 'mu4e-view-mark-for-something)
|
|||
|
|
(define-key map (kbd "<insert>") 'mu4e-view-mark-for-something)
|
|||
|
|
(define-key map (kbd "<insertchar>") 'mu4e-view-mark-for-something)
|
|||
|
|
|
|||
|
|
(define-key map (kbd "#") 'mu4e-mark-resolve-deferred-marks)
|
|||
|
|
|
|||
|
|
;; misc
|
|||
|
|
(define-key map "w" 'visual-line-mode)
|
|||
|
|
(define-key map "#" 'mu4e-view-toggle-hide-cited)
|
|||
|
|
(define-key map "h" 'mu4e-view-toggle-html)
|
|||
|
|
(define-key map (kbd "M-q") 'mu4e-view-fill-long-lines)
|
|||
|
|
|
|||
|
|
;; next 3 only warn user when attempt in the message view
|
|||
|
|
(define-key map "u" 'mu4e-view-unmark)
|
|||
|
|
(define-key map "U" 'mu4e-view-unmark-all)
|
|||
|
|
(define-key map "x" 'mu4e-view-marked-execute)
|
|||
|
|
|
|||
|
|
(define-key map "$" 'mu4e-show-log)
|
|||
|
|
(define-key map "H" 'mu4e-display-manual)
|
|||
|
|
|
|||
|
|
;; menu
|
|||
|
|
;;(define-key map [menu-bar] (make-sparse-keymap))
|
|||
|
|
(let ((menumap (make-sparse-keymap)))
|
|||
|
|
(define-key map [menu-bar headers] (cons "Mu4e" menumap))
|
|||
|
|
|
|||
|
|
(define-key menumap [quit-buffer]
|
|||
|
|
'("Quit view" . mu4e~view-quit-buffer))
|
|||
|
|
(define-key menumap [display-help] '("Help" . mu4e-display-manual))
|
|||
|
|
|
|||
|
|
(define-key menumap [sepa0] '("--"))
|
|||
|
|
(define-key menumap [wrap-lines]
|
|||
|
|
'("Toggle wrap lines" . visual-line-mode))
|
|||
|
|
(define-key menumap [toggle-html]
|
|||
|
|
'("Toggle view-html" . mu4e-view-toggle-html))
|
|||
|
|
(define-key menumap [raw-view]
|
|||
|
|
'("View raw message" . mu4e-view-raw-message))
|
|||
|
|
(define-key menumap [pipe]
|
|||
|
|
'("Pipe through shell" . mu4e-view-pipe))
|
|||
|
|
|
|||
|
|
(define-key menumap [sepa8] '("--"))
|
|||
|
|
(define-key menumap [open-att]
|
|||
|
|
'("Open attachment" . mu4e-view-open-attachment))
|
|||
|
|
(define-key menumap [extract-att]
|
|||
|
|
'("Extract attachment" . mu4e-view-save-attachment))
|
|||
|
|
(define-key menumap [save-url]
|
|||
|
|
'("Save URL to kill-ring" . mu4e-view-save-url))
|
|||
|
|
(define-key menumap [fetch-url]
|
|||
|
|
'("Fetch URL" . mu4e-view-fetch-url))
|
|||
|
|
(define-key menumap [goto-url]
|
|||
|
|
'("Visit URL" . mu4e-view-go-to-url))
|
|||
|
|
|
|||
|
|
(define-key menumap [sepa1] '("--"))
|
|||
|
|
(define-key menumap [mark-delete]
|
|||
|
|
'("Mark for deletion" . mu4e-view-mark-for-delete))
|
|||
|
|
(define-key menumap [mark-untrash]
|
|||
|
|
'("Mark for untrash" . mu4e-view-mark-for-untrash))
|
|||
|
|
(define-key menumap [mark-trash]
|
|||
|
|
'("Mark for trash" . mu4e-view-mark-for-trash))
|
|||
|
|
(define-key menumap [mark-move]
|
|||
|
|
'("Mark for move" . mu4e-view-mark-for-move))
|
|||
|
|
|
|||
|
|
(define-key menumap [sepa2] '("--"))
|
|||
|
|
(define-key menumap [resend] '("Resend" . mu4e-compose-resend))
|
|||
|
|
(define-key menumap [forward] '("Forward" . mu4e-compose-forward))
|
|||
|
|
(define-key menumap [reply] '("Reply" . mu4e-compose-reply))
|
|||
|
|
(define-key menumap [compose-new] '("Compose new" . mu4e-compose-new))
|
|||
|
|
(define-key menumap [sepa3] '("--"))
|
|||
|
|
|
|||
|
|
(define-key menumap [query-next]
|
|||
|
|
'("Next query" . mu4e-headers-query-next))
|
|||
|
|
(define-key menumap [query-prev]
|
|||
|
|
'("Previous query" . mu4e-headers-query-prev))
|
|||
|
|
(define-key menumap [narrow-search]
|
|||
|
|
'("Narrow search" . mu4e-headers-search-narrow))
|
|||
|
|
(define-key menumap [bookmark]
|
|||
|
|
'("Search bookmark" . mu4e-headers-search-bookmark))
|
|||
|
|
(define-key menumap [jump]
|
|||
|
|
'("Jump to maildir" . mu4e~headers-jump-to-maildir))
|
|||
|
|
(define-key menumap [search]
|
|||
|
|
'("Search" . mu4e-headers-search))
|
|||
|
|
|
|||
|
|
(define-key menumap [sepa4] '("--"))
|
|||
|
|
(define-key menumap [next] '("Next" . mu4e-view-headers-next))
|
|||
|
|
(define-key menumap [previous] '("Previous" . mu4e-view-headers-prev)))
|
|||
|
|
map))
|
|||
|
|
|
|||
|
|
(fset 'mu4e-view-mode-map mu4e-view-mode-map))
|
|||
|
|
|
|||
|
|
(defcustom mu4e-view-mode-hook nil
|
|||
|
|
"Hook run when entering Mu4e-View mode."
|
|||
|
|
:options '(turn-on-visual-line-mode)
|
|||
|
|
:type 'hook
|
|||
|
|
:group 'mu4e-view)
|
|||
|
|
|
|||
|
|
(defvar mu4e-view-mode-abbrev-table nil)
|
|||
|
|
|
|||
|
|
(defun mu4e~view-mode-body ()
|
|||
|
|
"Body of the mode-function."
|
|||
|
|
(use-local-map mu4e-view-mode-map)
|
|||
|
|
(mu4e-context-in-modeline)
|
|||
|
|
(setq buffer-undo-list t);; don't record undo info
|
|||
|
|
;; autopair mode gives error when pressing RET
|
|||
|
|
;; turn it off
|
|||
|
|
(when (boundp 'autopair-dont-activate)
|
|||
|
|
(setq autopair-dont-activate t)))
|
|||
|
|
|
|||
|
|
(define-derived-mode mu4e-view-mode special-mode "mu4e:oldview"
|
|||
|
|
"Major mode for viewing an e-mail message in mu4e."
|
|||
|
|
(mu4e~view-mode-body))
|
|||
|
|
|
|||
|
|
(defun mu4e~view-show-images-maybe (msg)
|
|||
|
|
"Show attached images, if `mu4e-show-images' is non-nil."
|
|||
|
|
(when (and (display-images-p) mu4e-view-show-images)
|
|||
|
|
(mu4e-view-for-each-part msg
|
|||
|
|
(lambda (_msg part)
|
|||
|
|
(when (string-match "^image/"
|
|||
|
|
(or (mu4e-message-part-field part :mime-type)
|
|||
|
|
"application/object-stream"))
|
|||
|
|
(let ((imgfile (mu4e-message-part-field part :temp)))
|
|||
|
|
(when (and imgfile (file-exists-p imgfile))
|
|||
|
|
(save-excursion
|
|||
|
|
(goto-char (point-max))
|
|||
|
|
(mu4e-display-image imgfile
|
|||
|
|
mu4e-view-image-max-width
|
|||
|
|
mu4e-view-image-max-height)))))))))
|
|||
|
|
|
|||
|
|
|
|||
|
|
(defun mu4e~view-hide-cited ()
|
|||
|
|
"Toggle hiding of cited lines in the message body."
|
|||
|
|
(save-excursion
|
|||
|
|
(let ((inhibit-read-only t))
|
|||
|
|
(goto-char (point-min))
|
|||
|
|
(flush-lines mu4e-cited-regexp)
|
|||
|
|
(setq mu4e~view-cited-hidden t))))
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;; Interactive functions
|
|||
|
|
|
|||
|
|
(defun mu4e-view-toggle-hide-cited ()
|
|||
|
|
"Toggle hiding of cited lines in the message body."
|
|||
|
|
(interactive)
|
|||
|
|
(if mu4e~view-cited-hidden
|
|||
|
|
(mu4e-view-refresh)
|
|||
|
|
(mu4e~view-hide-cited)))
|
|||
|
|
|
|||
|
|
(defun mu4e-view-toggle-html ()
|
|||
|
|
"Toggle html-display of the message body (if any)."
|
|||
|
|
(interactive)
|
|||
|
|
(setq mu4e~view-html-text
|
|||
|
|
(if mu4e~message-body-html 'text 'html))
|
|||
|
|
(mu4e-view-refresh))
|
|||
|
|
|
|||
|
|
(defun mu4e-view-refresh ()
|
|||
|
|
"Redisplay the current message."
|
|||
|
|
(interactive)
|
|||
|
|
(mu4e-view mu4e~view-message)
|
|||
|
|
(setq mu4e~view-cited-hidden nil))
|
|||
|
|
|
|||
|
|
;;; Wash functions
|
|||
|
|
|
|||
|
|
(defun mu4e-view-fill-long-lines ()
|
|||
|
|
"Fill lines that are wider than the window width or `fill-column'."
|
|||
|
|
(interactive)
|
|||
|
|
(with-current-buffer (mu4e-get-view-buffer)
|
|||
|
|
(save-excursion
|
|||
|
|
(let ((inhibit-read-only t)
|
|||
|
|
(width (window-width (get-buffer-window (current-buffer)))))
|
|||
|
|
(save-restriction
|
|||
|
|
(message-goto-body)
|
|||
|
|
(while (not (eobp))
|
|||
|
|
(end-of-line)
|
|||
|
|
(when (>= (current-column) (min fill-column width))
|
|||
|
|
(narrow-to-region (min (1+ (point)) (point-max))
|
|||
|
|
(point-at-bol))
|
|||
|
|
(let ((goback (point-marker)))
|
|||
|
|
(fill-paragraph nil)
|
|||
|
|
(goto-char (marker-position goback)))
|
|||
|
|
(widen))
|
|||
|
|
(forward-line 1)))))))
|
|||
|
|
|
|||
|
|
;;; Attachment handling
|
|||
|
|
|
|||
|
|
(defun mu4e~view-get-attach-num (prompt _msg &optional multi)
|
|||
|
|
"Ask the user with PROMPT for an attachment number for MSG, and
|
|||
|
|
ensure it is valid. The number is [1..n] for attachments
|
|||
|
|
\[0..(n-1)] in the message. If MULTI is nil, return the number for
|
|||
|
|
the attachment; otherwise (MULTI is non-nil), accept ranges of
|
|||
|
|
attachment numbers, as per `mu4e-split-ranges-to-numbers', and
|
|||
|
|
return the corresponding string."
|
|||
|
|
(let* ((count (hash-table-count mu4e~view-attach-map)) (def))
|
|||
|
|
(when (zerop count) (mu4e-warn "No attachments for this message"))
|
|||
|
|
(if (not multi)
|
|||
|
|
(if (= count 1)
|
|||
|
|
(read-number (mu4e-format "%s: " prompt) 1)
|
|||
|
|
(read-number (mu4e-format "%s (1-%d): " prompt count)))
|
|||
|
|
(progn
|
|||
|
|
(setq def (if (= count 1) "1" (format "1-%d" count)))
|
|||
|
|
(read-string (mu4e-format "%s (default %s): " prompt def)
|
|||
|
|
nil nil def)))))
|
|||
|
|
|
|||
|
|
(defun mu4e~view-get-attach (msg attnum)
|
|||
|
|
"Return the attachment plist in MSG corresponding to attachment
|
|||
|
|
number ATTNUM."
|
|||
|
|
(let* ((partid (gethash attnum mu4e~view-attach-map))
|
|||
|
|
(attach
|
|||
|
|
(cl-find-if
|
|||
|
|
(lambda (part)
|
|||
|
|
(eq (mu4e-message-part-field part :index) partid))
|
|||
|
|
(mu4e-message-field msg :parts))))
|
|||
|
|
(or attach (mu4e-error "Not a valid attachment"))))
|
|||
|
|
|
|||
|
|
(defun mu4e~view-request-attachment-path (fname path)
|
|||
|
|
"Ask the user where to save FNAME (default is PATH/FNAME)."
|
|||
|
|
(let ((fpath (expand-file-name
|
|||
|
|
(read-file-name
|
|||
|
|
(mu4e-format "Save as ")
|
|||
|
|
path nil nil fname) path)))
|
|||
|
|
(if (file-directory-p fpath)
|
|||
|
|
(expand-file-name fname fpath)
|
|||
|
|
fpath)))
|
|||
|
|
|
|||
|
|
(defun mu4e~view-request-attachments-dir (path)
|
|||
|
|
"Ask the user where to save multiple attachments (default is PATH)."
|
|||
|
|
(let ((fpath (expand-file-name
|
|||
|
|
(read-directory-name
|
|||
|
|
(mu4e-format "Save in directory ")
|
|||
|
|
path nil nil nil) path)))
|
|||
|
|
(if (file-directory-p fpath)
|
|||
|
|
fpath)))
|
|||
|
|
|
|||
|
|
(defun mu4e-view-save-attachment-single (&optional msg attnum)
|
|||
|
|
"Save attachment number ATTNUM from MSG.
|
|||
|
|
If MSG is nil use the message returned by `message-at-point'.
|
|||
|
|
If ATTNUM is nil ask for the attachment number."
|
|||
|
|
(interactive)
|
|||
|
|
(let* ((msg (or msg (mu4e-message-at-point)))
|
|||
|
|
(attnum (or attnum
|
|||
|
|
(mu4e~view-get-attach-num "Attachment to save" msg)))
|
|||
|
|
(att (mu4e~view-get-attach msg attnum))
|
|||
|
|
(fname (plist-get att :name))
|
|||
|
|
(mtype (plist-get att :mime-type))
|
|||
|
|
(path (concat
|
|||
|
|
(mu4e~get-attachment-dir fname mtype) "/"))
|
|||
|
|
(index (plist-get att :index))
|
|||
|
|
(retry t) (fpath))
|
|||
|
|
(while retry
|
|||
|
|
(setq fpath (mu4e~view-request-attachment-path fname path))
|
|||
|
|
(setq retry
|
|||
|
|
(and (file-exists-p fpath)
|
|||
|
|
(not (y-or-n-p (mu4e-format "Overwrite '%s'?" fpath))))))
|
|||
|
|
(mu4e~proc-extract
|
|||
|
|
'save (mu4e-message-field msg :docid)
|
|||
|
|
index mu4e-decryption-policy fpath)))
|
|||
|
|
|
|||
|
|
(defun mu4e-view-save-attachment-multi (&optional msg)
|
|||
|
|
"Offer to save multiple email attachments from the current message.
|
|||
|
|
Default is to save all messages, [1..n], where n is the number of
|
|||
|
|
attachments. You can type multiple values separated by space, e.g.
|
|||
|
|
1 3-6 8
|
|||
|
|
will save attachments 1,3,4,5,6 and 8.
|
|||
|
|
|
|||
|
|
Furthermore, there is a shortcut \"a\" which so means all
|
|||
|
|
attachments, but as this is the default, you may not need it."
|
|||
|
|
(interactive)
|
|||
|
|
(let* ((msg (or msg (mu4e-message-at-point)))
|
|||
|
|
(attachstr (mu4e~view-get-attach-num
|
|||
|
|
"Attachment number range (or 'a' for 'all')" msg t))
|
|||
|
|
(count (hash-table-count mu4e~view-attach-map))
|
|||
|
|
(attachnums (mu4e-split-ranges-to-numbers attachstr count)))
|
|||
|
|
(if mu4e-save-multiple-attachments-without-asking
|
|||
|
|
(let* ((path (concat (mu4e~get-attachment-dir) "/"))
|
|||
|
|
(attachdir (mu4e~view-request-attachments-dir path)))
|
|||
|
|
(dolist (num attachnums)
|
|||
|
|
(let* ((att (mu4e~view-get-attach msg num))
|
|||
|
|
(fname (plist-get att :name))
|
|||
|
|
(index (plist-get att :index))
|
|||
|
|
(retry t)
|
|||
|
|
fpath)
|
|||
|
|
(while retry
|
|||
|
|
(setq fpath (expand-file-name (concat attachdir fname) path))
|
|||
|
|
(setq retry
|
|||
|
|
(and (file-exists-p fpath)
|
|||
|
|
(not (y-or-n-p
|
|||
|
|
(mu4e-format "Overwrite '%s'?" fpath))))))
|
|||
|
|
(mu4e~proc-extract
|
|||
|
|
'save (mu4e-message-field msg :docid)
|
|||
|
|
index mu4e-decryption-policy fpath))))
|
|||
|
|
(dolist (num attachnums)
|
|||
|
|
(mu4e-view-save-attachment-single msg num)))))
|
|||
|
|
|
|||
|
|
(defun mu4e-view-save-attachment ()
|
|||
|
|
"Save mime parts from current mu4e-view buffer."
|
|||
|
|
(interactive)
|
|||
|
|
(call-interactively #'mu4e-view-save-attachment-multi))
|
|||
|
|
|
|||
|
|
(defun mu4e-view-open-attachment (&optional msg attnum)
|
|||
|
|
"Open attachment number ATTNUM from MSG.
|
|||
|
|
If MSG is nil use the message returned by `message-at-point'. If
|
|||
|
|
ATTNUM is nil ask for the attachment number."
|
|||
|
|
(interactive)
|
|||
|
|
(let* ((msg (or msg (mu4e-message-at-point)))
|
|||
|
|
(attnum (or attnum
|
|||
|
|
(progn
|
|||
|
|
(unless mu4e~view-attach-map
|
|||
|
|
(mu4e~view-construct-attachments-header msg))
|
|||
|
|
(mu4e~view-get-attach-num "Attachment to open" msg))))
|
|||
|
|
(att (or (mu4e~view-get-attach msg attnum)))
|
|||
|
|
(index (plist-get att :index))
|
|||
|
|
(docid (mu4e-message-field msg :docid))
|
|||
|
|
(mimetype (plist-get att :mime-type)))
|
|||
|
|
(if (and mimetype (string= mimetype "message/rfc822"))
|
|||
|
|
;; special handling for message-attachments; we open them in mu4e. we also
|
|||
|
|
;; send the docid as parameter (4th arg); we'll get this back from the
|
|||
|
|
;; server, and use it to determine the parent message (ie., the current
|
|||
|
|
;; message) when showing the embedded message/rfc822, and return to the
|
|||
|
|
;; current message when quitting that one.
|
|||
|
|
(mu4e~view-temp-action docid index 'mu4e (format "%s" docid))
|
|||
|
|
;; otherwise, open with the default program (handled in mu-server
|
|||
|
|
(mu4e~proc-extract 'open docid index mu4e-decryption-policy))))
|
|||
|
|
|
|||
|
|
(defun mu4e~view-temp-action (docid index what &optional param)
|
|||
|
|
"Open attachment INDEX for message with DOCID, and invoke ACTION."
|
|||
|
|
(interactive)
|
|||
|
|
(mu4e~proc-extract 'temp docid index mu4e-decryption-policy nil what param ))
|
|||
|
|
|
|||
|
|
(defvar mu4e~view-open-with-hist nil "History list for the open-with argument.")
|
|||
|
|
|
|||
|
|
(defun mu4e-view-open-attachment-with (msg attachnum &optional cmd)
|
|||
|
|
"Open MSG's attachment ATTACHNUM with CMD.
|
|||
|
|
If CMD is nil, ask user for it."
|
|||
|
|
(let* ((att (mu4e~view-get-attach msg attachnum))
|
|||
|
|
(ext (file-name-extension (plist-get att :name)))
|
|||
|
|
(cmd (or cmd
|
|||
|
|
(read-string
|
|||
|
|
(mu4e-format "Shell command to open it with: ")
|
|||
|
|
(assoc-default ext mu4e-view-attachment-assoc)
|
|||
|
|
'mu4e~view-open-with-hist)))
|
|||
|
|
(index (plist-get att :index)))
|
|||
|
|
(mu4e~view-temp-action
|
|||
|
|
(mu4e-message-field msg :docid) index 'open-with cmd)))
|
|||
|
|
|
|||
|
|
(defvar mu4e~view-pipe-hist nil
|
|||
|
|
"History list for the pipe argument.")
|
|||
|
|
|
|||
|
|
(defun mu4e-view-pipe-attachment (msg attachnum &optional pipecmd)
|
|||
|
|
"Feed MSG's attachment ATTACHNUM through pipe PIPECMD.
|
|||
|
|
If PIPECMD is nil, ask user for it."
|
|||
|
|
(let* ((att (mu4e~view-get-attach msg attachnum))
|
|||
|
|
(pipecmd (or pipecmd
|
|||
|
|
(read-string
|
|||
|
|
(mu4e-format "Pipe: ")
|
|||
|
|
nil
|
|||
|
|
'mu4e~view-pipe-hist)))
|
|||
|
|
(index (plist-get att :index)))
|
|||
|
|
(mu4e~view-temp-action
|
|||
|
|
(mu4e-message-field msg :docid) index 'pipe pipecmd)))
|
|||
|
|
|
|||
|
|
(defun mu4e-view-open-attachment-emacs (msg attachnum)
|
|||
|
|
"Open MSG's attachment ATTACHNUM in the current emacs instance."
|
|||
|
|
(let* ((att (mu4e~view-get-attach msg attachnum))
|
|||
|
|
(index (plist-get att :index)))
|
|||
|
|
(mu4e~view-temp-action (mu4e-message-field msg :docid) index 'emacs)))
|
|||
|
|
|
|||
|
|
(defun mu4e-view-import-attachment-diary (msg attachnum)
|
|||
|
|
"Open MSG's attachment ATTACHNUM in the current emacs instance."
|
|||
|
|
(interactive)
|
|||
|
|
(let* ((att (mu4e~view-get-attach msg attachnum))
|
|||
|
|
(index (plist-get att :index)))
|
|||
|
|
(mu4e~view-temp-action (mu4e-message-field msg :docid) index 'diary)))
|
|||
|
|
|
|||
|
|
(defun mu4e-view-import-public-key (msg attachnum)
|
|||
|
|
"Import MSG's attachment ATTACHNUM into the gpg-keyring."
|
|||
|
|
(interactive)
|
|||
|
|
(let* ((att (mu4e~view-get-attach msg attachnum))
|
|||
|
|
(index (plist-get att :index))
|
|||
|
|
(mime-type (plist-get att :mime-type)))
|
|||
|
|
(if (string= "application/pgp-keys" mime-type)
|
|||
|
|
(mu4e~view-temp-action (mu4e-message-field msg :docid) index 'gpg)
|
|||
|
|
(mu4e-error "Invalid mime-type for a pgp-key: `%s'" mime-type))))
|
|||
|
|
|
|||
|
|
(defun mu4e-view-attachment-action (&optional msg)
|
|||
|
|
"Ask user what to do with attachments in MSG
|
|||
|
|
If MSG is nil use the message returned by `message-at-point'.
|
|||
|
|
The actions are specified in `mu4e-view-attachment-actions'."
|
|||
|
|
(interactive)
|
|||
|
|
(let* ((msg (or msg (mu4e-message-at-point)))
|
|||
|
|
(actionfunc (mu4e-read-option
|
|||
|
|
"Action on attachment: "
|
|||
|
|
mu4e-view-attachment-actions))
|
|||
|
|
(multi (eq actionfunc 'mu4e-view-save-attachment-multi))
|
|||
|
|
(attnum (unless multi
|
|||
|
|
(mu4e~view-get-attach-num "Which attachment" msg multi))))
|
|||
|
|
(cond ((and actionfunc attnum)
|
|||
|
|
(funcall actionfunc msg attnum))
|
|||
|
|
((and actionfunc multi)
|
|||
|
|
(funcall actionfunc msg)))))
|
|||
|
|
|
|||
|
|
;; handler-function to handle the response we get from the server when we
|
|||
|
|
;; want to do something with one of the attachments.
|
|||
|
|
(defun mu4e~view-temp-handler (path what docid param)
|
|||
|
|
"Handler function for doing things with temp files (ie.,
|
|||
|
|
attachments) in response to a (mu4e~proc-extract 'temp ... )."
|
|||
|
|
(cond
|
|||
|
|
((string= what "open-with")
|
|||
|
|
;; 'param' will be the program to open-with
|
|||
|
|
(start-process "*mu4e-open-with-proc*" "*mu4e-open-with*" param path))
|
|||
|
|
((string= what "pipe")
|
|||
|
|
;; 'param' will be the pipe command, path the infile for this
|
|||
|
|
(mu4e-process-file-through-pipe path param))
|
|||
|
|
;; if it's mu4e, it's some embedded message; 'param' may contain the docid
|
|||
|
|
;; of the parent message.
|
|||
|
|
((string= what "mu4e")
|
|||
|
|
;; remember the mapping path->docid, which maps the path of the embedded
|
|||
|
|
;; message to the docid of its parent
|
|||
|
|
(puthash path docid mu4e~path-parent-docid-map)
|
|||
|
|
(mu4e~proc-view-path path mu4e-view-show-images mu4e-decryption-policy))
|
|||
|
|
((string= what "emacs")
|
|||
|
|
(find-file path)
|
|||
|
|
;; make the buffer read-only since it usually does not make
|
|||
|
|
;; sense to edit the temp buffer; use C-x C-q if you insist...
|
|||
|
|
(setq buffer-read-only t))
|
|||
|
|
((string= what "diary")
|
|||
|
|
(icalendar-import-file path diary-file))
|
|||
|
|
((string= what "gpg")
|
|||
|
|
(epa-import-keys path))
|
|||
|
|
(t (mu4e-error "Unsupported action %S" what))))
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;; Various commands
|
|||
|
|
|
|||
|
|
(defconst mu4e~verify-buffer-name " *mu4e-verify*")
|
|||
|
|
|
|||
|
|
(defun mu4e-view-verify-msg-popup (&optional msg)
|
|||
|
|
"Pop-up a signature verification window for MSG.
|
|||
|
|
If MSG is nil, use the message at point."
|
|||
|
|
(interactive)
|
|||
|
|
(let* ((msg (or msg (mu4e-message-at-point)))
|
|||
|
|
(path (mu4e-message-field msg :path))
|
|||
|
|
(cmd (format "%s verify --verbose %s %s"
|
|||
|
|
mu4e-mu-binary
|
|||
|
|
(shell-quote-argument path)
|
|||
|
|
(if mu4e-decryption-policy
|
|||
|
|
"--decrypt --use-agent"
|
|||
|
|
"")))
|
|||
|
|
(output (shell-command-to-string cmd))
|
|||
|
|
;; create a new one
|
|||
|
|
(buf (get-buffer-create mu4e~verify-buffer-name))
|
|||
|
|
(win (or (get-buffer-window buf)
|
|||
|
|
(split-window-vertically (- (window-height) 6)))))
|
|||
|
|
(with-selected-window win
|
|||
|
|
(let ((inhibit-read-only t))
|
|||
|
|
;; (set-window-dedicated-p win t)
|
|||
|
|
(switch-to-buffer buf)
|
|||
|
|
(erase-buffer)
|
|||
|
|
(insert output)
|
|||
|
|
(goto-char (point-min))
|
|||
|
|
(local-set-key "q" 'kill-buffer-and-window))
|
|||
|
|
(setq buffer-read-only t))
|
|||
|
|
(select-window win)))
|
|||
|
|
|
|||
|
|
|
|||
|
|
;; Actions that are only available for the old view
|
|||
|
|
|
|||
|
|
;;; To HTML
|
|||
|
|
|
|||
|
|
(defun mu4e~action-header-to-html (msg field)
|
|||
|
|
"Convert the FIELD of MSG to an HTML string."
|
|||
|
|
(mapconcat
|
|||
|
|
(lambda(c)
|
|||
|
|
(let* ((name (when (car c)
|
|||
|
|
(replace-regexp-in-string "[[:cntrl:]]" "" (car c))))
|
|||
|
|
(email (when (cdr c)
|
|||
|
|
(replace-regexp-in-string "[[:cntrl:]]" "" (cdr c))))
|
|||
|
|
(addr (if mu4e-view-show-addresses
|
|||
|
|
(if name (format "%s <%s>" name email) email)
|
|||
|
|
(or name email))) ;; name may be nil
|
|||
|
|
;; Escape HTML entities
|
|||
|
|
(addr (replace-regexp-in-string "&" "&" addr))
|
|||
|
|
(addr (replace-regexp-in-string "<" "<" addr))
|
|||
|
|
(addr (replace-regexp-in-string ">" ">" addr)))
|
|||
|
|
addr))
|
|||
|
|
(mu4e-message-field msg field) ", "))
|
|||
|
|
|
|||
|
|
(defun mu4e~write-body-to-html (msg)
|
|||
|
|
"Write MSG's body (either html or text) to a temporary file;
|
|||
|
|
return the filename."
|
|||
|
|
(let* ((html (mu4e-message-field msg :body-html))
|
|||
|
|
(txt (mu4e-message-field msg :body-txt))
|
|||
|
|
(tmpfile (mu4e-make-temp-file "html"))
|
|||
|
|
(attachments (cl-remove-if (lambda (part)
|
|||
|
|
(or (null (plist-get part :attachment))
|
|||
|
|
(null (plist-get part :cid))))
|
|||
|
|
(mu4e-message-field msg :parts))))
|
|||
|
|
(unless (or html txt)
|
|||
|
|
(mu4e-error "No body part for this message"))
|
|||
|
|
(with-temp-buffer
|
|||
|
|
(insert "<head><meta charset=\"UTF-8\"></head>\n")
|
|||
|
|
(insert (concat "<p><strong>From</strong>: "
|
|||
|
|
(mu4e~action-header-to-html msg :from) "</br>"))
|
|||
|
|
(insert (concat "<strong>To</strong>: "
|
|||
|
|
(mu4e~action-header-to-html msg :to) "</br>"))
|
|||
|
|
(insert (concat "<strong>Date</strong>: "
|
|||
|
|
(format-time-string mu4e-view-date-format (mu4e-message-field msg :date)) "</br>"))
|
|||
|
|
(insert (concat "<strong>Subject</strong>: " (mu4e-message-field msg :subject) "</p>"))
|
|||
|
|
(insert (or html (concat "<pre>" txt "</pre>")))
|
|||
|
|
(write-file tmpfile)
|
|||
|
|
;; rewrite attachment urls
|
|||
|
|
(mapc (lambda (attachment)
|
|||
|
|
(goto-char (point-min))
|
|||
|
|
(while (re-search-forward (format "src=\"cid:%s\""
|
|||
|
|
(plist-get attachment :cid)) nil t)
|
|||
|
|
(if (plist-get attachment :temp)
|
|||
|
|
(replace-match (format "src=\"%s\""
|
|||
|
|
(plist-get attachment :temp)))
|
|||
|
|
(replace-match (format "src=\"%s%s\"" temporary-file-directory
|
|||
|
|
(plist-get attachment :name)))
|
|||
|
|
(let ((tmp-attachment-name
|
|||
|
|
(format "%s%s" temporary-file-directory
|
|||
|
|
(plist-get attachment :name))))
|
|||
|
|
(mu4e~proc-extract 'save (mu4e-message-field msg :docid)
|
|||
|
|
(plist-get attachment :index)
|
|||
|
|
mu4e-decryption-policy tmp-attachment-name)
|
|||
|
|
(mu4e-remove-file-later tmp-attachment-name)))))
|
|||
|
|
attachments)
|
|||
|
|
(save-buffer)
|
|||
|
|
tmpfile)))
|
|||
|
|
|
|||
|
|
(defun mu4e-action-view-in-browser (msg)
|
|||
|
|
"View the body of MSG in a web browser.
|
|||
|
|
You can influence the browser to use with the variable
|
|||
|
|
`browse-url-generic-program', and see the discussion of privacy
|
|||
|
|
aspects in `(mu4e) Displaying rich-text messages'. This is only
|
|||
|
|
available for the old view."
|
|||
|
|
(browse-url (concat "file://" (mu4e~write-body-to-html msg))))
|
|||
|
|
|
|||
|
|
(defun mu4e-action-view-with-xwidget (msg)
|
|||
|
|
"View the body of MSG inside xwidget-webkit.
|
|||
|
|
This is only available in Emacs 25+; also see the discussion of
|
|||
|
|
privacy aspects in `(mu4e) Displaying rich-text messages'."
|
|||
|
|
(unless (fboundp 'xwidget-webkit-browse-url)
|
|||
|
|
(mu4e-error "No xwidget support available"))
|
|||
|
|
(xwidget-webkit-browse-url
|
|||
|
|
(concat "file://" (mu4e~write-body-to-html msg)) t))
|
|||
|
|
|
|||
|
|
;;; To speech
|
|||
|
|
|
|||
|
|
(defconst mu4e-text2speech-command "festival --tts"
|
|||
|
|
"Program that speaks out text it receives on standard input.")
|
|||
|
|
|
|||
|
|
(defun mu4e-action-message-to-speech (msg)
|
|||
|
|
"Pronounce MSG's body text using `mu4e-text2speech-command'."
|
|||
|
|
(unless (mu4e-message-field msg :body-txt)
|
|||
|
|
(mu4e-warn "No text body for this message"))
|
|||
|
|
(with-temp-buffer
|
|||
|
|
(insert (mu4e-message-field msg :body-txt))
|
|||
|
|
(shell-command-on-region (point-min) (point-max)
|
|||
|
|
mu4e-text2speech-command)))
|
|||
|
|
|
|||
|
|
;;;
|
|||
|
|
(provide 'mu4e-view-old)
|
|||
|
|
;;; mu4e-view-old.el ends here
|