;;; 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 ;; Maintainer: Dirk-Jan C. Binnema ;; 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 . ;;; 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 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 "") 'mu4e-headers-query-prev) (define-key map (kbd "") '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 "") 'mu4e-headers-split-view-grow) (define-key map (kbd "") '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 "") '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 "") 'mu4e-view-headers-next) (define-key map (kbd "") '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 "") 'mu4e-view-mark-for-delete) (define-key map (kbd "") '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 "") 'mu4e-view-mark-for-something) (define-key map (kbd "") 'mu4e-view-mark-for-something) (define-key map (kbd "") '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 "\n") (insert (concat "

From: " (mu4e~action-header-to-html msg :from) "
")) (insert (concat "To: " (mu4e~action-header-to-html msg :to) "
")) (insert (concat "Date: " (format-time-string mu4e-view-date-format (mu4e-message-field msg :date)) "
")) (insert (concat "Subject: " (mu4e-message-field msg :subject) "

")) (insert (or html (concat "
" txt "
"))) (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