.emacs.d/elisp/mu4e/mu4e-view-old.el

1098 lines
46 KiB
EmacsLisp
Raw 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-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 "&" "&amp;" addr))
(addr (replace-regexp-in-string "<" "&lt;" addr))
(addr (replace-regexp-in-string ">" "&gt;" 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