From e6be09e626f33f42b54e438ac90168467f42189e Mon Sep 17 00:00:00 2001 From: "Dirk-Jan C. Binnema" Date: Sun, 29 Aug 2021 09:58:39 +0300 Subject: [PATCH] mu4e-view: remove old view Remove the pre-Gnus view, and remove the infrastructure to handle both the new and old views. --- mu4e/mu4e-view-common.el | 642 -------------------- mu4e/mu4e-view-gnus.el | 643 -------------------- mu4e/mu4e-view-old.el | 1097 --------------------------------- mu4e/mu4e-view.el | 1249 +++++++++++++++++++++++++++++++++++++- 4 files changed, 1223 insertions(+), 2408 deletions(-) delete mode 100644 mu4e/mu4e-view-common.el delete mode 100644 mu4e/mu4e-view-gnus.el delete mode 100644 mu4e/mu4e-view-old.el diff --git a/mu4e/mu4e-view-common.el b/mu4e/mu4e-view-common.el deleted file mode 100644 index e4880d53..00000000 --- a/mu4e/mu4e-view-common.el +++ /dev/null @@ -1,642 +0,0 @@ -;;; mu4e-view-common.el -- part of mu4e, the mu mail user agent -*- lexical-binding: t -*- - -;; Copyright (C) 2021 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 common utils for 'old' and 'gnus' view mode. - -;;; Code: - -(require 'cl-lib) -(require 'mu4e-utils) ;; utility functions -(require 'mu4e-vars) -(require 'mu4e-headers) -(require 'mu4e-mark) -(require 'mu4e-proc) -(require 'mu4e-compose) -(require 'mu4e-actions) -(require 'mu4e-message) - -(require 'comint) -(require 'browse-url) -(require 'button) -(require 'epa) -(require 'epg) -(require 'thingatpt) - -;;; Options - -(defcustom mu4e-view-scroll-to-next t - "Move to the next message when calling -`mu4e-view-scroll-up-or-next' (typically bound to SPC) when at -the end of a message. Otherwise, don't move to the next message." - :type 'boolean - :group 'mu4e-view) - -(defcustom mu4e-view-fields - '(:from :to :cc :subject :flags :date :maildir :mailing-list :tags - :attachments :signature :decryption) - "Header fields to display in the message view buffer. -For the complete list of available headers, see -`mu4e-header-info'. - -Note, when using the gnus-based viewer you can only use this add -fields that are otherwise not shows; you can further tweak the -fields using e.g. `gnus-article-hide-boring-headers', -`gnus-article-hide-headers' etc., see the gnus documentation for -details." - :type (list 'symbol) - :group 'mu4e-view) - -(defcustom mu4e-view-actions - '( ("capture message" . mu4e-action-capture-message) - ("view in browser" . mu4e-action-view-in-browser) - ("show this thread" . mu4e-action-show-thread)) - "List of actions to perform on messages in view mode. -The actions are cons-cells of the form: - (NAME . FUNC) -where: -* NAME is the name of the action (e.g. \"Count lines\") -* FUNC is a function which receives a message plist as an argument. - -The first letter of NAME is used as a shortcut character." - :group 'mu4e-view - :type '(alist :key-type string :value-type function)) - - -;;; Old options - -;; These don't do anything useful when in "gnus" mode, except for avoid errors -;; for people that have these in their config. - -(defcustom mu4e-view-show-addresses nil - "Whether to initially show full e-mail addresses for contacts. -Otherwise, just show their names. Ignored when using the gnus-based view." - :type 'boolean - :group 'mu4e-view) - -(make-obsolete-variable 'mu4e-view-wrap-lines nil "0.9.9-dev7") -(make-obsolete-variable 'mu4e-view-hide-cited nil "0.9.9-dev7") - -(defcustom mu4e-view-date-format "%c" - "Date format to use in the message view. -In the format of `format-time-string'. Ignored when using the gnus-based view." - :type 'string - :group 'mu4e-view) - -(defcustom mu4e-view-image-max-width 800 - "The maximum width for images to display. -This is only effective if you're using an Emacs with Imagemagick -support, and `mu4e-view-show-images' is non-nil. Ignored when -using the gnus-based view." - :type 'integer - :group 'mu4e-view) - -(defcustom mu4e-view-image-max-height 600 - "The maximum height for images to display. -This is only effective if you're using an Emacs with Imagemagick -support, and `mu4e-view-show-images' is non-nil. Ignored when -using the gnus-based view." - :type 'integer - :group 'mu4e-view) - - -(defcustom mu4e-save-multiple-attachments-without-asking nil - "If non-nil, saving multiple attachments asks once for a -directory and saves all attachments in the chosen directory. -Ignored when using the gnus-based view." - :type 'boolean - :group 'mu4e-view) - -(defcustom mu4e-view-attachment-assoc nil - "Alist of (EXTENSION . PROGRAM). -Specify which PROGRAM to use to open attachment with EXTENSION. -Args EXTENSION and PROGRAM should be specified as strings. -Ignored when using the gnus-based view." - :group 'mu4e-view - :type '(alist :key-type string :value-type string)) - -(defcustom mu4e-view-attachment-actions - '( ("ssave" . mu4e-view-save-attachment-single) - ("Ssave multi" . mu4e-view-save-attachment-multi) - ("wopen-with" . mu4e-view-open-attachment-with) - ("ein-emacs" . mu4e-view-open-attachment-emacs) - ("dimport-in-diary" . mu4e-view-import-attachment-diary) - ("kimport-public-key" . mu4e-view-import-public-key) - ("|pipe" . mu4e-view-pipe-attachment)) - "List of actions to perform on message attachments. -The actions are cons-cells of the form: - (NAME . FUNC) -where: -* NAME is the name of the action (e.g. \"Count lines\") -* FUNC is a function which receives two arguments: the message - plist and the attachment number. -The first letter of NAME is used as a shortcut character. -Ignored when using the gnus-based view." - :group 'mu4e-view - :type '(alist :key-type string :value-type function)) - -;;; Keymaps - -(defvar mu4e-view-header-field-keymap - (let ((map (make-sparse-keymap))) - (define-key map [mouse-1] 'mu4e~view-header-field-fold) - (define-key map (kbd "TAB") 'mu4e~view-header-field-fold) - map) - "Keymap used for header fields. Ignored when using the -gnus-based view.") - -(defvar mu4e-view-contacts-header-keymap - (let ((map (make-sparse-keymap))) - (define-key map [mouse-2] 'mu4e~view-compose-contact) - (define-key map "C" 'mu4e~view-compose-contact) - (define-key map "c" 'mu4e~view-copy-contact) - map) - "Keymap used for the contacts in the header fields. -Ignored when using the gnus-based view.") - -(defvar mu4e-view-attachments-header-keymap - (let ((map (make-sparse-keymap))) - (define-key map [mouse-1] 'mu4e~view-open-attach-from-binding) - (define-key map [?\M-\r] 'mu4e~view-open-attach-from-binding) - (define-key map [mouse-2] 'mu4e~view-save-attach-from-binding) - (define-key map (kbd "") 'mu4e~view-save-attach-from-binding) - map) - "Keymap used in the \"Attachments\" header field. Ignored when -using the gnus-based view.") - -;; Helpers - -(defun mu4e~view-quit-buffer () - "Quit the mu4e-view buffer. -This is a rather complex function, to ensure we don't disturb -other windows." - (interactive) - (if (eq mu4e-split-view 'single-window) - (when (buffer-live-p (mu4e-get-view-buffer)) - (kill-buffer (mu4e-get-view-buffer))) - (unless (eq major-mode 'mu4e-view-mode) - (mu4e-error "Must be in mu4e-view-mode (%S)" major-mode)) - (let ((curbuf (current-buffer)) - (curwin (selected-window)) - (headers-win)) - (walk-windows - (lambda (win) - ;; check whether the headers buffer window is visible - (when (eq (mu4e-get-headers-buffer) (window-buffer win)) - (setq headers-win win)) - ;; and kill any _other_ (non-selected) window that shows the current - ;; buffer - (when - (and - (eq curbuf (window-buffer win)) ;; does win show curbuf? - (not (eq curwin win)) ;; but it's not the curwin? - (not (one-window-p))) ;; and not the last one on the frame? - (delete-window win)))) ;; delete it! - ;; now, all *other* windows should be gone. - ;; if the headers view is also visible, kill ourselves + window; otherwise - ;; switch to the headers view - (if (window-live-p headers-win) - ;; headers are visible - (progn - (kill-buffer-and-window) ;; kill the view win - (setq mu4e~headers-view-win nil) - (select-window headers-win)) ;; and switch to the headers win... - ;; headers are not visible... - (progn - (kill-buffer) - (setq mu4e~headers-view-win nil) - (when (buffer-live-p (mu4e-get-headers-buffer)) - (switch-to-buffer (mu4e-get-headers-buffer)))))))) - - -(defconst mu4e~view-raw-buffer-name " *mu4e-raw-view*" - "Name for the raw message view buffer.") - -(defun mu4e-view-raw-message () - "Display the raw contents of message at point in a new buffer." - (interactive) - (let ((path (mu4e-message-field-at-point :path)) - (buf (get-buffer-create mu4e~view-raw-buffer-name))) - (unless (and path (file-readable-p path)) - (mu4e-error "Not a readable file: %S" path)) - (with-current-buffer buf - (let ((inhibit-read-only t)) - (erase-buffer) - (insert-file-contents path) - (view-mode) - (goto-char (point-min)))) - (switch-to-buffer buf))) - -(defun mu4e-view-pipe (cmd) - "Pipe the message at point through shell command CMD. -Then, display the results." - (interactive "sShell command: ") - (let ((path (mu4e-message-field (mu4e-message-at-point) :path))) - (mu4e-process-file-through-pipe path cmd))) - - -(defmacro mu4e~view-in-headers-context (&rest body) - "Evaluate BODY in the context of the headers buffer connected to -this view." - `(progn - (unless (buffer-live-p (mu4e-get-headers-buffer)) - (mu4e-error "no headers buffer connected")) - (let* ((msg (mu4e-message-at-point)) - (docid (mu4e-message-field msg :docid))) - (unless docid - (mu4e-error "message without docid: action is not possible.")) - (with-current-buffer (mu4e-get-headers-buffer) - (unless (eq mu4e-split-view 'single-window) - (when (get-buffer-window) - (select-window (get-buffer-window)))) - (if (mu4e~headers-goto-docid docid) - ,@body - (mu4e-error "cannot find message in headers buffer.")))))) - -(defun mu4e-view-headers-next (&optional n) - "Move point to the next message header in the headers buffer -connected with this message view. If this succeeds, return the new -docid. Otherwise, return nil. Optionally, takes an integer -N (prefix argument), to the Nth next header." - (interactive "P") - (mu4e~view-in-headers-context - (mu4e~headers-move (or n 1)))) - -(defun mu4e-view-headers-prev (&optional n) - "Move point to the previous message header in the headers buffer -connected with this message view. If this succeeds, return the new -docid. Otherwise, return nil. Optionally, takes an integer -N (prefix argument), to the Nth previous header." - (interactive "P") - (mu4e~view-in-headers-context - (mu4e~headers-move (- (or n 1))))) - -(defun mu4e~view-prev-or-next-unread (backwards) - "Move point to the next or previous (when BACKWARDS is non-`nil') -unread message header in the headers buffer connected with this -message view. If this succeeds, return the new docid. Otherwise, -return nil." - (mu4e~view-in-headers-context - (mu4e~headers-prev-or-next-unread backwards)) - (if (eq mu4e-split-view 'single-window) - (when (eq (window-buffer) (mu4e-get-view-buffer)) - (with-current-buffer (mu4e-get-headers-buffer) - (mu4e-headers-view-message))) - (mu4e-select-other-view) - (mu4e-headers-view-message))) - -(defun mu4e-view-headers-prev-unread () - "Move point to the previous unread message header in the headers -buffer connected with this message view. If this succeeds, return -the new docid. Otherwise, return nil." - (interactive) - (mu4e~view-prev-or-next-unread t)) - -(defun mu4e-view-headers-next-unread () - "Move point to the next unread message header in the headers -buffer connected with this message view. If this succeeds, return -the new docid. Otherwise, return nil." - (interactive) - (mu4e~view-prev-or-next-unread nil)) - - -;;; Interactive functions -(defun mu4e-view-action (&optional msg) - "Ask user for some action to apply on MSG, then do it. -If MSG is nil apply action to message returned -bymessage-at-point. The actions are specified in -`mu4e-view-actions'." - (interactive) - (let* ((msg (or msg (mu4e-message-at-point))) - (actionfunc (mu4e-read-option "Action: " mu4e-view-actions))) - (funcall actionfunc msg))) - -(defun mu4e-view-mark-pattern () - "Ask user for a kind of mark (move, delete etc.), a field to -match and a regular expression to match with. Then, mark all -matching messages with that mark." - (interactive) - (mu4e~view-in-headers-context (mu4e-headers-mark-pattern))) - -(defun mu4e-view-mark-thread (&optional markpair) - "Ask user for a kind of mark (move, delete etc.), and apply it -to all messages in the thread at point in the headers view. The -optional MARKPAIR can also be used to provide the mark -selection." - (interactive) - (mu4e~view-in-headers-context - (if markpair (mu4e-headers-mark-thread nil markpair) - (call-interactively 'mu4e-headers-mark-thread)))) - -(defun mu4e-view-mark-subthread (&optional markpair) - "Ask user for a kind of mark (move, delete etc.), and apply it -to all messages in the subthread at point in the headers view. -The optional MARKPAIR can also be used to provide the mark -selection." - (interactive) - (mu4e~view-in-headers-context - (if markpair (mu4e-headers-mark-subthread markpair) - (mu4e-headers-mark-subthread)))) - -(defun mu4e-view-search-narrow () - "Run `mu4e-headers-search-narrow' in the headers buffer." - (interactive) - (mu4e~view-in-headers-context - (call-interactively 'mu4e-headers-search-narrow))) - -(defun mu4e-view-search-edit () - "Run `mu4e-headers-search-edit' in the headers buffer." - (interactive) - (mu4e~view-in-headers-context (mu4e-headers-search-edit))) - -(defun mu4e-mark-region-code () - "Highlight region marked with `message-mark-inserted-region'. -Add this function to `mu4e-view-mode-hook' to enable this feature." - (require 'message) - (let (beg end ov-beg ov-end ov-inv) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward - (concat "^" message-mark-insert-begin) nil t) - (setq ov-beg (match-beginning 0) - ov-end (match-end 0) - ov-inv (make-overlay ov-beg ov-end) - beg ov-end) - (overlay-put ov-inv 'invisible t) - (when (re-search-forward - (concat "^" message-mark-insert-end) nil t) - (setq ov-beg (match-beginning 0) - ov-end (match-end 0) - ov-inv (make-overlay ov-beg ov-end) - end ov-beg) - (overlay-put ov-inv 'invisible t)) - (when (and beg end) - (let ((ov (make-overlay beg end))) - (overlay-put ov 'face 'mu4e-region-code)) - (setq beg nil end nil)))))) - -;;; View Utilities - -(defun mu4e-view-mark-custom () - "Run some custom mark function." - (mu4e~view-in-headers-context - (mu4e-headers-mark-custom))) - -(defun mu4e~view-split-view-p () - "Return t if we're in split-view, nil otherwise." - (member mu4e-split-view '(horizontal vertical))) - -;;; Scroll commands - -(defun mu4e-view-scroll-up-or-next () - "Scroll-up the current message. -If `mu4e-view-scroll-to-next' is non-nil, and we can't scroll-up -anymore, go the next message." - (interactive) - (condition-case nil - (scroll-up) - (error - (when mu4e-view-scroll-to-next - (mu4e-view-headers-next))))) - -(defun mu4e-scroll-up () - "Scroll text of selected window up one line." - (interactive) - (scroll-up 1)) - -(defun mu4e-scroll-down () - "Scroll text of selected window down one line." - (interactive) - (scroll-down 1)) - -;;; Mark commands - -(defun mu4e-view-unmark-all () - "If we're in split-view, unmark all messages. -Otherwise, warn user that unmarking only works in the header -list." - (interactive) - (if (mu4e~view-split-view-p) - (mu4e~view-in-headers-context (mu4e-mark-unmark-all)) - (mu4e-message "Unmarking needs to be done in the header list view"))) - -(defun mu4e-view-unmark () - "If we're in split-view, unmark message at point. -Otherwise, warn user that unmarking only works in the header -list." - (interactive) - (if (mu4e~view-split-view-p) - (mu4e-view-mark-for-unmark) - (mu4e-message "Unmarking needs to be done in the header list view"))) - -(defmacro mu4e~view-defun-mark-for (mark) - "Define a function mu4e-view-mark-for-MARK." - (let ((funcname (intern (format "mu4e-view-mark-for-%s" mark))) - (docstring (format "Mark the current message for %s." mark))) - `(progn - (defun ,funcname () ,docstring - (interactive) - (mu4e~view-in-headers-context - (mu4e-headers-mark-and-next ',mark))) - (put ',funcname 'definition-name ',mark)))) - -(mu4e~view-defun-mark-for move) -(mu4e~view-defun-mark-for refile) -(mu4e~view-defun-mark-for delete) -(mu4e~view-defun-mark-for flag) -(mu4e~view-defun-mark-for unflag) -(mu4e~view-defun-mark-for unmark) -(mu4e~view-defun-mark-for something) -(mu4e~view-defun-mark-for read) -(mu4e~view-defun-mark-for unread) -(mu4e~view-defun-mark-for trash) -(mu4e~view-defun-mark-for untrash) - -(defun mu4e-view-marked-execute () - "Execute the marked actions." - (interactive) - (mu4e~view-in-headers-context - (mu4e-mark-execute-all))) - - -;;; URL handling - -(defvar mu4e~view-link-map nil - "A map of some number->url so we can jump to url by number.") -(put 'mu4e~view-link-map 'permanent-local t) - -(defvar mu4e-view-active-urls-keymap - (let ((map (make-sparse-keymap))) - (define-key map [down-mouse-1] 'mu4e~view-browse-url-from-binding) - (define-key map [mouse-1] 'mu4e~view-browse-url-from-binding) - (define-key map (kbd "M-") 'mu4e~view-browse-url-from-binding) - map) - "Keymap used for the urls inside the body.") - -(defvar mu4e~view-beginning-of-url-regexp - "https?\\://\\|mailto:" - "Regexp that matches the beginning of http:/https:/mailto: -URLs; match-string 1 will contain the matched URL, if any.") - - -(defun mu4e~view-browse-url-from-binding (&optional url) - "View in browser the url at point, or click location. -If the optional argument URL is provided, browse that instead. -If the url is mailto link, start writing an email to that address." - (interactive) - (let* (( url (or url (mu4e~view-get-property-from-event 'mu4e-url)))) - (when url - (if (string-match-p "^mailto:" url) - (browse-url-mail url) - (browse-url url))))) - - -(defun mu4e~view-get-property-from-event (prop) - "Get the property PROP at point, or the location of the mouse. -The action is chosen based on the `last-command-event'. -Meant to be evoked from interactive commands." - (if (and (eventp last-command-event) - (mouse-event-p last-command-event)) - (let ((posn (event-end last-command-event))) - (when (numberp (posn-point posn)) - (get-text-property - (posn-point posn) - prop - (window-buffer (posn-window posn))))) - (get-text-property (point) prop))) - -;; this is fairly simplistic... -(defun mu4e~view-activate-urls () - "Turn things that look like URLs into clickable things. -Also number them so they can be opened using `mu4e-view-go-to-url'." - (let ((num 0)) - (save-excursion - (setq mu4e~view-link-map ;; buffer local - (make-hash-table :size 32 :weakness nil)) - (goto-char (point-min)) - (while (re-search-forward mu4e~view-beginning-of-url-regexp nil t) - (let ((bounds (thing-at-point-bounds-of-url-at-point))) - (when bounds - (let* ((url (thing-at-point-url-at-point)) - (ov (make-overlay (car bounds) (cdr bounds)))) - (puthash (cl-incf num) url mu4e~view-link-map) - (add-text-properties - (car bounds) - (cdr bounds) - `(face mu4e-link-face - mouse-face highlight - mu4e-url ,url - keymap ,mu4e-view-active-urls-keymap - help-echo - "[mouse-1] or [M-RET] to open the link")) - (overlay-put ov 'after-string - (propertize (format "\u200B[%d]" num) - 'face 'mu4e-url-number-face))))))))) - - -(defun mu4e~view-get-urls-num (prompt &optional multi) - "Ask the user with PROMPT for an URL number for MSG, and ensure -it is valid. The number is [1..n] for URLs \[0..(n-1)] in the -message. If MULTI is nil, return the number for the URL; -otherwise (MULTI is non-nil), accept ranges of URL numbers, as -per `mu4e-split-ranges-to-numbers', and return the corresponding -string." - (let* ((count (hash-table-count mu4e~view-link-map)) (def)) - (when (zerop count) (mu4e-error "No links 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-go-to-url (&optional multi) - "Offer to go to url(s). If MULTI (prefix-argument) is nil, go to -a single one, otherwise, offer to go to a range of urls." - (interactive "P") - (mu4e~view-handle-urls "URL to visit" - multi - (lambda (url) (mu4e~view-browse-url-from-binding url)))) - -(defun mu4e-view-save-url (&optional multi) - "Offer to save urls(s) to the kill-ring. If -MULTI (prefix-argument) is nil, save a single one, otherwise, offer -to save a range of URLs." - (interactive "P") - (mu4e~view-handle-urls "URL to save" multi - (lambda (url) - (kill-new url) - (mu4e-message "Saved %s to the kill-ring" url)))) - -(defun mu4e-view-fetch-url (&optional multi) - "Offer to fetch (download) urls(s). If MULTI (prefix-argument) is nil, -download a single one, otherwise, offer to fetch a range of -URLs. The urls are fetched to `mu4e-attachment-dir'." - (interactive "P") - (mu4e~view-handle-urls "URL to fetch" multi - (lambda (url) - (let ((target (concat (mu4e~get-attachment-dir url) "/" - (file-name-nondirectory url)))) - (url-copy-file url target) - (mu4e-message "Fetched %s -> %s" url target))))) - -(defun mu4e~view-handle-urls (prompt multi urlfunc) - "If MULTI is nil, apply URLFUNC to a single uri, otherwise, apply -it to a range of uris. PROMPT is the query to present to the user." - (if multi - (mu4e~view-handle-multi-urls prompt urlfunc) - (mu4e~view-handle-single-url prompt urlfunc))) - -(defun mu4e~view-handle-single-url (prompt urlfunc &optional num) - "Apply URLFUNC to url NUM in the current message, prompting the -user with PROMPT." - (let* ((num (or num (mu4e~view-get-urls-num prompt))) - (url (gethash num mu4e~view-link-map))) - (unless url (mu4e-warn "Invalid number for URL")) - (funcall urlfunc url))) - -(defun mu4e~view-handle-multi-urls (prompt urlfunc) - "Apply URLFUNC to a a range of urls in the current message, -prompting the user with PROMPT. - -Default is to apply it to all URLs, [1..n], where n is the number -of urls. You can type multiple values separated by space, e.g. 1 -3-6 8 will visit urls 1,3,4,5,6 and 8. - -Furthermore, there is a shortcut \"a\" which means all urls, but as -this is the default, you may not need it." - (let* ((linkstr (mu4e~view-get-urls-num - "URL number range (or 'a' for 'all')" t)) - (count (hash-table-count mu4e~view-link-map)) - (linknums (mu4e-split-ranges-to-numbers linkstr count))) - (dolist (num linknums) - (mu4e~view-handle-single-url prompt urlfunc num)))) - -(defun mu4e-view-for-each-uri (func) - "Evaluate FUNC(uri) for each uri in the current message." - (maphash (lambda (_num uri) (funcall func uri)) mu4e~view-link-map)) - - -(provide 'mu4e-view-common) diff --git a/mu4e/mu4e-view-gnus.el b/mu4e/mu4e-view-gnus.el deleted file mode 100644 index ad5af171..00000000 --- a/mu4e/mu4e-view-gnus.el +++ /dev/null @@ -1,643 +0,0 @@ -;;; mu4e-view-gnus.el -- part of mu4e, the mu mail user agent -*- lexical-binding: t -*- - -;; Copyright (C) 2021 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 'mu4e-view-common) -(require 'mu4e-context) -(require 'mu4e-search) -(require 'calendar) -(require 'gnus-art) - -;;; Variables - -(defvar gnus-icalendar-additional-identities) -(defvar helm-comp-read-use-marked) -(defvar-local mu4e~view-rendering nil) - -(make-obsolete-variable 'mu4e-view-blocked-images 'gnus-blocked-images - "1.5.12") -(make-obsolete-variable 'mu4e-view-inhibit-images 'gnus-inhibit-images - "1.5.12") -;;; Main - -;; remember the mime-handles, so we can clean them up when -;; we quit this buffer. -(defvar-local mu4e~gnus-article-mime-handles nil) -(put 'mu4e~gnus-article-mime-handles 'permanent-local t) - -(defun mu4e~view-gnus (msg) - "View MSG using Gnus' article mode." - (when (bufferp gnus-article-buffer) - (kill-buffer gnus-article-buffer)) - (with-current-buffer (get-buffer-create gnus-article-buffer) - (let ((inhibit-read-only t)) - (erase-buffer) - (insert-file-contents-literally - (mu4e-message-field msg :path) nil nil nil t))) - (switch-to-buffer gnus-article-buffer) - (setq mu4e~view-message msg) - (mu4e~view-render-buffer msg)) - -(defun mu4e-view-message-text (msg) - "Return the pristine MSG as a string." - ;; we need this for replying/forwarding, since the mu4e-compose - ;; wants it that way. - (with-temp-buffer - (insert-file-contents-literally - (mu4e-message-field msg :path) nil nil nil t) - (mu4e~view-render-buffer msg) - (buffer-substring-no-properties (point-min) (point-max)))) - -(defun mu4e-action-view-in-browser (msg) - "Show current MSG in browser if it includes an HTML-part. -The variables `browse-url-browser-function', -`browse-url-handlers', and `browse-url-default-handlers' -determine which browser function to use." - (with-temp-buffer - (insert-file-contents-literally - (mu4e-message-field msg :path) nil nil nil t) - (run-hooks 'gnus-article-decode-hook) - (let ((header (cl-loop for field in '("from" "to" "cc" "date" "subject") - when (message-fetch-field field) - concat (format "%s: %s\n" (capitalize field) it))) - (parts (mm-dissect-buffer t t))) - ;; If singlepart, enforce a list. - (when (and (bufferp (car parts)) - (stringp (car (mm-handle-type parts)))) - (setq parts (list parts))) - ;; Process the list - (unless (gnus-article-browse-html-parts parts header) - (mu4e-warn "Message does not contain a \"text/html\" part")) - (mm-destroy-parts parts)))) - - -(defun mu4e~view-render-buffer (msg) - "Render current buffer with MSG using Gnus' article mode." - (setq gnus-summary-buffer (get-buffer-create " *appease-gnus*")) - (let* ((inhibit-read-only t) - (max-specpdl-size mu4e-view-max-specpdl-size) - (mm-decrypt-option 'known) - (ct (mail-fetch-field "Content-Type")) - (ct (and ct (mail-header-parse-content-type ct))) - (charset (mail-content-type-get ct 'charset)) - (charset (and charset (intern charset))) - (mu4e~view-rendering t); Needed if e.g. an ics file is buttonized - (gnus-article-emulate-mime t) - (gnus-unbuttonized-mime-types '(".*/.*")) - (gnus-buttonized-mime-types - (append (list "multipart/signed" "multipart/encrypted") - gnus-buttonized-mime-types)) - (gnus-newsgroup-charset - (if (and charset (coding-system-p charset)) charset - (detect-coding-region (point-min) (point-max) t))) - ;; Possibly add headers (before "Attachments") - (gnus-display-mime-function (mu4e~view-gnus-display-mime msg)) - (gnus-icalendar-additional-identities - (mu4e-personal-addresses 'no-regexp))) - (mm-enable-multibyte) - (mu4e-view-mode) - (run-hooks 'gnus-article-decode-hook) - (gnus-article-prepare-display) - (mu4e~view-activate-urls) - (setq mu4e~gnus-article-mime-handles gnus-article-mime-handles - gnus-article-decoded-p gnus-article-decode-hook) - (set-buffer-modified-p nil) - (add-hook 'kill-buffer-hook #'mu4e~view-kill-mime-handles))) - -(defun mu4e~view-kill-mime-handles () - "Kill cached MIME-handles, if any." - (when mu4e~gnus-article-mime-handles - (mm-destroy-parts mu4e~gnus-article-mime-handles) - (setq mu4e~gnus-article-mime-handles nil))) - -(defun mu4e~view-gnus-display-mime (msg) - "Like `gnus-display-mime' but include mu4e headers to MSG." - (lambda (&optional ihandles) - (gnus-display-mime ihandles) - (unless ihandles - (save-restriction - (article-goto-body) - (forward-line -1) - (narrow-to-region (point) (point)) - (dolist (field mu4e-view-fields) - (let ((fieldval (mu4e-message-field msg field))) - (cl-case field - ((:path :maildir :user-agent :mailing-list :message-id) - (mu4e~view-gnus-insert-header field fieldval)) - ((:flags :tags) - (let ((flags (mapconcat (lambda (flag) - (if (symbolp flag) - (symbol-name flag) - flag)) fieldval ", "))) - (mu4e~view-gnus-insert-header field flags))) - (:size (mu4e~view-gnus-insert-header - field (mu4e-display-size fieldval))) - ((:subject :to :from :cc :bcc :from-or-to :date :attachments - :signature :decryption)) ; handled by Gnus - (t - (mu4e~view-gnus-insert-header-custom msg field))))) - (let ((gnus-treatment-function-alist - '((gnus-treat-highlight-headers - gnus-article-highlight-headers)))) - (gnus-treat-article 'head)))))) - -(defun mu4e~view-gnus-insert-header (field val) - "Insert a header FIELD with value VAL." - (let* ((info (cdr (assoc field mu4e-header-info))) - (key (plist-get info :name)) - (help (plist-get info :help))) - (if (and val (> (length val) 0)) - (insert (propertize (concat key ":") 'help-echo help) - " " val "\n")))) - -(defun mu4e~view-gnus-insert-header-custom (msg field) - "Insert MSG's custom FIELD." - (let* ((info (cdr-safe (or (assoc field mu4e-header-info-custom) - (mu4e-error "Custom field %S not found" field)))) - (key (plist-get info :name)) - (func (or (plist-get info :function) - (mu4e-error "No :function defined for custom field %S %S" - field info))) - (val (funcall func msg)) - (help (plist-get info :help))) - (when (and val (> (length val) 0)) - (insert (propertize (concat key ":") 'help-echo help) " " val "\n")))) - -(define-advice gnus-icalendar-event-from-handle - (:filter-args (handle-attendee) mu4e~view-fix-missing-charset) - "Avoid error when displaying an ical attachment without a charset." - (if (and (boundp 'mu4e~view-rendering) mu4e~view-rendering) - (let* ((handle (car handle-attendee)) - (attendee (cadr handle-attendee)) - (buf (mm-handle-buffer handle)) - (ty (mm-handle-type handle)) - (rest (cddr handle))) - ;; Put the fallback at the end: - (setq ty (append ty '((charset . "utf-8")))) - (setq handle (cons buf (cons ty rest))) - (list handle attendee)) - handle-attendee)) - -(defun mu4e~view-mode-p () - "Is the buffer in mu4e-view-mode or one of its descendants?" - (or (eq major-mode 'mu4e-view-mode) - (derived-mode-p '(mu4e-view-mode)))) - -(defun mu4e~view-nop (func &rest args) - "Do not invoke FUNC with ARGS when in mu4e-view-mode. -This is useful for advising some Gnus-functionality that does not work in mu4e." - (unless (mu4e~view-mode-p) - (apply func args))) - -(defun mu4e~view-button-reply (func &rest args) - "Advise FUNC with ARGS to make `gnus-button-reply' links work in mu4e." - (if (mu4e~view-mode-p) - (mu4e-compose-reply) - (apply func args))) - -(defun mu4e~view-msg-mail (func &rest args) - "Advise FUNC with ARGS to make `gnus-msg-mail' links compose with mu4e." - (if (mu4e~view-mode-p) - (apply 'mu4e~compose-mail args) - (apply func args))) - -(defvar 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 "%" #'mu4e-view-mark-pattern) - (define-key map "t" #'mu4e-view-mark-subthread) - (define-key map "T" #'mu4e-view-mark-thread) - (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 "A" #'mu4e-view-mime-part-action) - (define-key map "e" #'mu4e-view-save-attachments) - - ;; 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 "S-SPC") #'scroll-down) - (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 from view <-> headers (when visible) - (define-key map "y" #'mu4e-select-other-view) - - ;; 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 "M" #'mu4e-view-massage) - - (define-key map "w" 'visual-line-mode) - (define-key map "h" #'mu4e-view-toggle-html) - (define-key map (kbd "M-q") 'article-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 [raw-view] - '("View raw message" . mu4e-view-raw-message)) - (define-key menumap [pipe] - '("Pipe through shell" . mu4e-view-pipe)) - - (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))) - - (set-keymap-parent map special-mode-map) - map) - "Keymap for mu4e-view mode.") - -(set-keymap-parent mu4e-view-mode-map button-buffer-map) -(suppress-keymap 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) - -;; "Define the major-mode for the mu4e-view." -(define-derived-mode mu4e-view-mode gnus-article-mode "mu4e:view" - "Major mode for viewing an e-mail message in mu4e. -Based on Gnus' article-mode." - ;; Restore C-h b default behavior - (define-key mu4e-view-mode-map (kbd "C-h b") 'describe-bindings) - ;; ;; turn off gnus modeline changes and menu items - (advice-add 'gnus-set-mode-line :around #'mu4e~view-nop) - (advice-add 'gnus-button-reply :around #'mu4e~view-button-reply) - (advice-add 'gnus-msg-mail :around #'mu4e~view-msg-mail) - - ;; advice gnus-block-private-groups to always return "." - ;; so that by default we block images. - (advice-add 'gnus-block-private-groups :around - (lambda(func &rest args) - (if (mu4e~view-mode-p) - "." (apply func args)))) - (use-local-map mu4e-view-mode-map) - (mu4e-context-minor-mode) - (mu4e-search-minor-mode) - (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))) - -;;; Massaging the message view - -(defcustom mu4e-view-massage-options - '( ("ctoggle citations" . gnus-article-hide-citation) - ("htoggle headers" . gnus-article-hide-headers) - ("ytoggle crypto" . gnus-article-hide-pem)) -"Various options for 'massaging' the message view. See `(gnus) -Article Treatment' for more options." - :group 'mu4e-view - :type '(alist :key-type string :value-type function)) - -(defun mu4e-view-massage() - "Massage current message view as per `mu4e-view-massage-options'." - (interactive) - (funcall (mu4e-read-option "Massage: " mu4e-view-massage-options))) - -;;; MIME-parts - -(defun mu4e~view-gather-mime-parts () - "Gather all MIME parts as an alist. -The alist uniquely maps the number to the gnus-part." - (let ((parts '())) - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (let ((part (get-text-property (point) 'gnus-data)) - (index (get-text-property (point) 'gnus-part))) - (when (and part (numberp index) (not (assoc index parts)) - (push `(,index . ,part) parts))) - (goto-char (or (next-single-property-change (point) 'gnus-part) - (point-max)))))) - parts)) - - -(defun mu4e-view-save-attachments (&optional arg) - "Save mime parts from current mu4e gnus view buffer. - -When helm-mode is enabled provide completion on attachments and -possibility to mark candidates to save, otherwise completion on -attachments is done with `completing-read-multiple', in this case -use \",\" to separate candidate, completion is provided after -each \",\". - -Note, currently this does not work well with file names -containing commas." - (interactive "P") - (cl-assert (and (eq major-mode 'mu4e-view-mode) - (derived-mode-p 'gnus-article-mode))) - (let* ((parts (mu4e~view-gather-mime-parts)) - (handles '()) - (files '()) - (compfn (if (and (boundp 'helm-mode) helm-mode) - #'completing-read - ;; Fallback to `completing-read-multiple' with poor - ;; completion - #'completing-read-multiple)) - dir) - (dolist (part parts) - (let ((fname (cdr (assoc 'filename (assoc "attachment" (cdr part)))))) - (when fname - (push `(,fname . ,(cdr part)) handles) - (push fname files)))) - (if files - (progn - (setq files (let ((helm-comp-read-use-marked t)) - (funcall compfn "Save part(s): " files)) - dir (if arg (read-directory-name "Save to directory: ") mu4e-attachment-dir)) - (cl-loop for (f . h) in handles - when (member f files) - do (mm-save-part-to-file - h (let ((file (expand-file-name f dir))) - (if (file-exists-p file) - (let (newname (count 1)) - (while (and - (setq newname - (concat - (file-name-sans-extension file) - (format "(%s)" count) - (file-name-extension file t))) - (file-exists-p newname)) - (cl-incf count)) - newname) - file))))) - (mu4e-message "No attached files found")))) - - -(defvar mu4e-view-mime-part-actions - '( - ;; - ;; some basic ones - ;; - - ;; save MIME-part to a file - (:name "save" :handler gnus-article-save-part :receives index) - ;; pipe MIME-part to some arbitrary shell command - (:name "|pipe" :handler gnus-article-pipe-part :receives index) - ;; open with the default handler, if any - (:name "open" :handler mu4e~view-open-file :receives temp) - ;; open with some custom file. - (:name "wopen-with" :handler (lambda (file)(mu4e~view-open-file file t)) - :receives temp) - - ;; - ;; some more examples - ;; - - ;; import GPG key - (:name "gpg" :handler epa-import-keys :receives temp) - ;; count the number of lines in a MIME-part - (:name "line-count" :handler "wc -l" :receives pipe) - ;; open in this emacs instance; tries to use the attachment name, - ;; so emacs can use specific modes etc. - (:name "emacs" :handler find-file :receives temp) - ;; open in this emacs instance, "raw" - (:name "raw" :handler (lambda (str) - (let ((tmpbuf (get-buffer-create " *mu4e-raw-mime*"))) - (with-current-buffer tmpbuf - (insert str) - (view-mode) - (goto-char (point-min))) - (switch-to-buffer tmpbuf))) :receives pipe)) - - "Specifies actions for MIME-parts. - -Each of the actions is a plist with keys -`(:name ;; name of the action; shortcut is first letter of name - - :handler ;; one of: - ;; - a function receiving the index/temp/pipe - ;; - a string, which is taken as a shell command - - :receives ;; a symbol specifying what the handler receives - ;; - index: the index number of the mime part (default) - ;; - temp: the full path to the mime part in a - ;; temporary file, which is deleted immediately - ;; after invoking handler - ;; - pipe: the attachment is piped to some shell command - ;; or as a string parameter to a function -).") - - -(defun mu4e~view-mime-part-to-temp-file (handle) - "Write MIME-part HANDLE to a temporary file and return the file name. -The filename is deduced from the MIME-part's filename, or -otherwise random; the result is placed in a temporary directory -with a unique name. Returns the full path for the file created. -The directory and file are self-destructed." - (let* ((tmpdir (make-temp-file "mu4e-temp-" t)) - (fname (cdr-safe (assoc 'filename (assoc "attachment" (cdr handle))))) - (fname (if fname - (concat tmpdir "/" (replace-regexp-in-string "/" "-" fname)) - (let ((temporary-file-directory tmpdir)) - (make-temp-file "mimepart"))))) - (mm-save-part-to-file handle fname) - (run-at-time "30 sec" nil (lambda () (ignore-errors (delete-directory tmpdir t)))) - fname)) - - -(defun mu4e~view-open-file (file &optional force-ask) - "Open FILE with default handler, if any. -Otherwise, or if FORCE-ASK is set, ask user for the program to -open with." - (let* ((opener - (pcase system-type - (`darwin "open") - ((or 'gnu 'gnu/linux 'gnu/kfreebsd) "xdg-open"))) - (prog (if (or force-ask (not opener)) - (read-shell-command "Open MIME-part with: ") - opener))) - (call-process prog nil 0 nil file))) - -(defun mu4e-view-mime-part-action (&optional n) - "Apply some action to MIME-part N in the current messsage. -If N is not specified, ask for it. For instance, '3 A o' opens -the third MIME-part." - (interactive "NNumber of MIME-part: ") - (let* ((parts (mu4e~view-gather-mime-parts)) - (options (mapcar (lambda (action) `(,(plist-get action :name) . ,action)) - mu4e-view-mime-part-actions)) - (handle (or (cdr-safe (cl-find-if (lambda (part) (eq (car part) n)) parts)) - (mu4e-error "MIME-part %s not found" n))) - (action (or (and options (mu4e-read-option "Action on MIME-part: " options)) - (mu4e-error "No such action"))) - (handler (or (plist-get action :handler) - (mu4e-error "No :handler item found for action %S" action))) - (receives (or (plist-get action :receives) - (mu4e-error "No :receives item found for action %S" action)))) - (save-excursion - (cond - ((functionp handler) - (cond - ((eq receives 'index) (funcall handler n)) - ((eq receives 'pipe) (funcall handler (mm-with-unibyte-buffer - (mm-insert-part handle) - (buffer-string)))) - ((eq receives 'temp) - (funcall handler (mu4e~view-mime-part-to-temp-file handle))) - (t (mu4e-error "Invalid :receive for %S" action)))) - ((stringp handler) - (cond - ((eq receives 'index) (shell-command (concat handler " " (shell-quote-argument n)))) - ((eq receives 'pipe) (mm-pipe-part handle handler)) - ((eq receives 'temp) - (shell-command (shell-command (concat handler " " - (shell-quote-argument - (mu4e~view-mime-part-to-temp-file handle)))))) - (t (mu4e-error "Invalid action %S" action)))))))) - -(defun mu4e-view-toggle-html () - "Toggle html-display of the first html-part found." - (interactive) - ;; This function assumes `gnus-article-mime-handle-alist' is sorted by - ;; pertinence, i.e. the first HTML part found in it is the most important one. - (if-let ((html-part - (seq-find (lambda (handle) - (equal (mm-handle-media-type (cdr handle)) "text/html")) - gnus-article-mime-handle-alist))) - (gnus-article-inline-part (car html-part)) - (mu4e-warn "No html part in this message"))) - - -(provide 'mu4e-view-gnus) -;;; mu4e-view-gnus.el ends here diff --git a/mu4e/mu4e-view-old.el b/mu4e/mu4e-view-old.el deleted file mode 100644 index edd7981d..00000000 --- a/mu4e/mu4e-view-old.el +++ /dev/null @@ -1,1097 +0,0 @@ -;;; 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 diff --git a/mu4e/mu4e-view.el b/mu4e/mu4e-view.el index c6ca2375..e31fad42 100644 --- a/mu4e/mu4e-view.el +++ b/mu4e/mu4e-view.el @@ -26,44 +26,1241 @@ ;; viewing e-mail messages ;;; Code: -(declare-function mu4e~view-gnus "mu4e-view-gnus") -(declare-function mu4e~view-old "mu4e-view-old") -(declare-function mu4e~headers-update-handler "mu4e-headers") -(declare-function mu4e-headers-search "mu4e-headers") -(declare-function mu4e-error "mu4e-utils") -(require 'mu4e-view-common) -(require (if mu4e-view-use-old 'mu4e-view-old 'mu4e-view-gnus)) +(require 'cl-lib) +(require 'calendar) +(require 'gnus-art) +(require 'comint) +(require 'browse-url) +(require 'button) +(require 'epa) +(require 'epg) +(require 'thingatpt) -(defun mu4e-view (msg) - "Display the message MSG in a new buffer, and keep in sync with HDRSBUF. -'In sync' here means that moving to the next/previous message in -the the message view affects HDRSBUF, as does marking etc. +(require 'mu4e-actions) +(require 'mu4e-compose) +(require 'mu4e-context) +(require 'mu4e-headers) +(require 'mu4e-mark) +(require 'mu4e-message) +(require 'mu4e-proc) +(require 'mu4e-search) +(require 'mu4e-utils) ;; utility functions +(require 'mu4e-vars) -As a side-effect, a message that is being viewed loses its 'unread' -marking if it still had that. +;;; Options -Depending on the value of `mu4e-view-use-old', either use mu4e's -internal display mode, or a (by default) display mode based on -Gnus' article-mode." +(defcustom mu4e-view-scroll-to-next t + "Move to the next message when calling +`mu4e-view-scroll-up-or-next' (typically bound to SPC) when at +the end of a message. Otherwise, don't move to the next message." + :type 'boolean + :group 'mu4e-view) - ;; sanity checks. - (if (and mu4e-view-use-old (featurep 'mu4e-view-gnus)) - (error "Cannot use old view when gnus-view is loaded; restart emacs") - (if (and (not mu4e-view-use-old) (featurep 'mu4e-view-old)) - (error "Cannot use gnus-based view with old view loaded; restart emacs"))) +(defcustom mu4e-view-fields + '(:from :to :cc :subject :flags :date :maildir :mailing-list :tags + :attachments :signature :decryption) + "Header fields to display in the message view buffer. +For the complete list of available headers, see +`mu4e-header-info'. - (mu4e~headers-update-handler msg nil nil);; update headers, if necessary. +Note, when using the gnus-based viewer you can only use this add +fields that are otherwise not shows; you can further tweak the +fields using e.g. `gnus-article-hide-boring-headers', +`gnus-article-hide-headers' etc., see the gnus documentation for +details." + :type (list 'symbol) + :group 'mu4e-view) - (if mu4e-view-use-old - (mu4e~view-old msg) - (mu4e~view-gnus msg))) +(defcustom mu4e-view-actions + '( ("capture message" . mu4e-action-capture-message) + ("view in browser" . mu4e-action-view-in-browser) + ("show this thread" . mu4e-action-show-thread)) + "List of actions to perform on messages in view mode. +The actions are cons-cells of the form: + (NAME . FUNC) +where: +* NAME is the name of the action (e.g. \"Count lines\") +* FUNC is a function which receives a message plist as an argument. + +The first letter of NAME is used as a shortcut character." + :group 'mu4e-view + :type '(alist :key-type string :value-type function)) + + +;;; Old options + +;; These don't do anything useful when in "gnus" mode, except for avoid errors +;; for people that have these in their config. + +(defcustom mu4e-view-show-addresses nil + "Whether to initially show full e-mail addresses for contacts. +Otherwise, just show their names. Ignored when using the gnus-based view." + :type 'boolean + :group 'mu4e-view) + +(make-obsolete-variable 'mu4e-view-wrap-lines nil "0.9.9-dev7") +(make-obsolete-variable 'mu4e-view-hide-cited nil "0.9.9-dev7") + +(defcustom mu4e-view-date-format "%c" + "Date format to use in the message view. +In the format of `format-time-string'. Ignored when using the gnus-based view." + :type 'string + :group 'mu4e-view) + +(defcustom mu4e-view-image-max-width 800 + "The maximum width for images to display. +This is only effective if you're using an Emacs with Imagemagick +support, and `mu4e-view-show-images' is non-nil. Ignored when +using the gnus-based view." + :type 'integer + :group 'mu4e-view) + +(defcustom mu4e-view-image-max-height 600 + "The maximum height for images to display. +This is only effective if you're using an Emacs with Imagemagick +support, and `mu4e-view-show-images' is non-nil. Ignored when +using the gnus-based view." + :type 'integer + :group 'mu4e-view) + + +(defcustom mu4e-save-multiple-attachments-without-asking nil + "If non-nil, saving multiple attachments asks once for a +directory and saves all attachments in the chosen directory. +Ignored when using the gnus-based view." + :type 'boolean + :group 'mu4e-view) + +(defcustom mu4e-view-attachment-assoc nil + "Alist of (EXTENSION . PROGRAM). +Specify which PROGRAM to use to open attachment with EXTENSION. +Args EXTENSION and PROGRAM should be specified as strings. +Ignored when using the gnus-based view." + :group 'mu4e-view + :type '(alist :key-type string :value-type string)) + +(defcustom mu4e-view-attachment-actions + '( ("ssave" . mu4e-view-save-attachment-single) + ("Ssave multi" . mu4e-view-save-attachment-multi) + ("wopen-with" . mu4e-view-open-attachment-with) + ("ein-emacs" . mu4e-view-open-attachment-emacs) + ("dimport-in-diary" . mu4e-view-import-attachment-diary) + ("kimport-public-key" . mu4e-view-import-public-key) + ("|pipe" . mu4e-view-pipe-attachment)) + "List of actions to perform on message attachments. +The actions are cons-cells of the form: + (NAME . FUNC) +where: +* NAME is the name of the action (e.g. \"Count lines\") +* FUNC is a function which receives two arguments: the message + plist and the attachment number. +The first letter of NAME is used as a shortcut character. +Ignored when using the gnus-based view." + :group 'mu4e-view + :type '(alist :key-type string :value-type function)) + +;;; Keymaps + +(defvar mu4e-view-header-field-keymap + (let ((map (make-sparse-keymap))) + (define-key map [mouse-1] 'mu4e~view-header-field-fold) + (define-key map (kbd "TAB") 'mu4e~view-header-field-fold) + map) + "Keymap used for header fields. Ignored when using the +gnus-based view.") + +(defvar mu4e-view-contacts-header-keymap + (let ((map (make-sparse-keymap))) + (define-key map [mouse-2] 'mu4e~view-compose-contact) + (define-key map "C" 'mu4e~view-compose-contact) + (define-key map "c" 'mu4e~view-copy-contact) + map) + "Keymap used for the contacts in the header fields. +Ignored when using the gnus-based view.") + +(defvar mu4e-view-attachments-header-keymap + (let ((map (make-sparse-keymap))) + (define-key map [mouse-1] 'mu4e~view-open-attach-from-binding) + (define-key map [?\M-\r] 'mu4e~view-open-attach-from-binding) + (define-key map [mouse-2] 'mu4e~view-save-attach-from-binding) + (define-key map (kbd "") 'mu4e~view-save-attach-from-binding) + map) + "Keymap used in the \"Attachments\" header field. Ignored when +using the gnus-based view.") + +;; Helpers + +(defun mu4e~view-quit-buffer () + "Quit the mu4e-view buffer. +This is a rather complex function, to ensure we don't disturb +other windows." + (interactive) + (if (eq mu4e-split-view 'single-window) + (when (buffer-live-p (mu4e-get-view-buffer)) + (kill-buffer (mu4e-get-view-buffer))) + (unless (eq major-mode 'mu4e-view-mode) + (mu4e-error "Must be in mu4e-view-mode (%S)" major-mode)) + (let ((curbuf (current-buffer)) + (curwin (selected-window)) + (headers-win)) + (walk-windows + (lambda (win) + ;; check whether the headers buffer window is visible + (when (eq (mu4e-get-headers-buffer) (window-buffer win)) + (setq headers-win win)) + ;; and kill any _other_ (non-selected) window that shows the current + ;; buffer + (when + (and + (eq curbuf (window-buffer win)) ;; does win show curbuf? + (not (eq curwin win)) ;; but it's not the curwin? + (not (one-window-p))) ;; and not the last one on the frame? + (delete-window win)))) ;; delete it! + ;; now, all *other* windows should be gone. + ;; if the headers view is also visible, kill ourselves + window; otherwise + ;; switch to the headers view + (if (window-live-p headers-win) + ;; headers are visible + (progn + (kill-buffer-and-window) ;; kill the view win + (setq mu4e~headers-view-win nil) + (select-window headers-win)) ;; and switch to the headers win... + ;; headers are not visible... + (progn + (kill-buffer) + (setq mu4e~headers-view-win nil) + (when (buffer-live-p (mu4e-get-headers-buffer)) + (switch-to-buffer (mu4e-get-headers-buffer)))))))) + + +(defconst mu4e~view-raw-buffer-name " *mu4e-raw-view*" + "Name for the raw message view buffer.") + +(defun mu4e-view-raw-message () + "Display the raw contents of message at point in a new buffer." + (interactive) + (let ((path (mu4e-message-field-at-point :path)) + (buf (get-buffer-create mu4e~view-raw-buffer-name))) + (unless (and path (file-readable-p path)) + (mu4e-error "Not a readable file: %S" path)) + (with-current-buffer buf + (let ((inhibit-read-only t)) + (erase-buffer) + (insert-file-contents path) + (view-mode) + (goto-char (point-min)))) + (switch-to-buffer buf))) + +(defun mu4e-view-pipe (cmd) + "Pipe the message at point through shell command CMD. +Then, display the results." + (interactive "sShell command: ") + (let ((path (mu4e-message-field (mu4e-message-at-point) :path))) + (mu4e-process-file-through-pipe path cmd))) + + +(defmacro mu4e~view-in-headers-context (&rest body) + "Evaluate BODY in the context of the headers buffer connected to +this view." + `(progn + (unless (buffer-live-p (mu4e-get-headers-buffer)) + (mu4e-error "no headers buffer connected")) + (let* ((msg (mu4e-message-at-point)) + (docid (mu4e-message-field msg :docid))) + (unless docid + (mu4e-error "message without docid: action is not possible.")) + (with-current-buffer (mu4e-get-headers-buffer) + (unless (eq mu4e-split-view 'single-window) + (when (get-buffer-window) + (select-window (get-buffer-window)))) + (if (mu4e~headers-goto-docid docid) + ,@body + (mu4e-error "cannot find message in headers buffer.")))))) + +(defun mu4e-view-headers-next (&optional n) + "Move point to the next message header in the headers buffer +connected with this message view. If this succeeds, return the new +docid. Otherwise, return nil. Optionally, takes an integer +N (prefix argument), to the Nth next header." + (interactive "P") + (mu4e~view-in-headers-context + (mu4e~headers-move (or n 1)))) + +(defun mu4e-view-headers-prev (&optional n) + "Move point to the previous message header in the headers buffer +connected with this message view. If this succeeds, return the new +docid. Otherwise, return nil. Optionally, takes an integer +N (prefix argument), to the Nth previous header." + (interactive "P") + (mu4e~view-in-headers-context + (mu4e~headers-move (- (or n 1))))) + +(defun mu4e~view-prev-or-next-unread (backwards) + "Move point to the next or previous (when BACKWARDS is non-`nil') +unread message header in the headers buffer connected with this +message view. If this succeeds, return the new docid. Otherwise, +return nil." + (mu4e~view-in-headers-context + (mu4e~headers-prev-or-next-unread backwards)) + (if (eq mu4e-split-view 'single-window) + (when (eq (window-buffer) (mu4e-get-view-buffer)) + (with-current-buffer (mu4e-get-headers-buffer) + (mu4e-headers-view-message))) + (mu4e-select-other-view) + (mu4e-headers-view-message))) + +(defun mu4e-view-headers-prev-unread () + "Move point to the previous unread message header in the headers +buffer connected with this message view. If this succeeds, return +the new docid. Otherwise, return nil." + (interactive) + (mu4e~view-prev-or-next-unread t)) + +(defun mu4e-view-headers-next-unread () + "Move point to the next unread message header in the headers +buffer connected with this message view. If this succeeds, return +the new docid. Otherwise, return nil." + (interactive) + (mu4e~view-prev-or-next-unread nil)) + + +;;; Interactive functions +(defun mu4e-view-action (&optional msg) + "Ask user for some action to apply on MSG, then do it. +If MSG is nil apply action to message returned +bymessage-at-point. The actions are specified in +`mu4e-view-actions'." + (interactive) + (let* ((msg (or msg (mu4e-message-at-point))) + (actionfunc (mu4e-read-option "Action: " mu4e-view-actions))) + (funcall actionfunc msg))) + +(defun mu4e-view-mark-pattern () + "Ask user for a kind of mark (move, delete etc.), a field to +match and a regular expression to match with. Then, mark all +matching messages with that mark." + (interactive) + (mu4e~view-in-headers-context (mu4e-headers-mark-pattern))) + +(defun mu4e-view-mark-thread (&optional markpair) + "Ask user for a kind of mark (move, delete etc.), and apply it +to all messages in the thread at point in the headers view. The +optional MARKPAIR can also be used to provide the mark +selection." + (interactive) + (mu4e~view-in-headers-context + (if markpair (mu4e-headers-mark-thread nil markpair) + (call-interactively 'mu4e-headers-mark-thread)))) + +(defun mu4e-view-mark-subthread (&optional markpair) + "Ask user for a kind of mark (move, delete etc.), and apply it +to all messages in the subthread at point in the headers view. +The optional MARKPAIR can also be used to provide the mark +selection." + (interactive) + (mu4e~view-in-headers-context + (if markpair (mu4e-headers-mark-subthread markpair) + (mu4e-headers-mark-subthread)))) + +(defun mu4e-view-search-narrow () + "Run `mu4e-headers-search-narrow' in the headers buffer." + (interactive) + (mu4e~view-in-headers-context (mu4e-search-narrow))) + +(defun mu4e-view-search-edit () + "Run `mu4e-headers-search-edit' in the headers buffer." + (interactive) + (mu4e~view-in-headers-context (mu4e-search-edit))) + +(defun mu4e-mark-region-code () + "Highlight region marked with `message-mark-inserted-region'. +Add this function to `mu4e-view-mode-hook' to enable this feature." + (require 'message) + (let (beg end ov-beg ov-end ov-inv) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward + (concat "^" message-mark-insert-begin) nil t) + (setq ov-beg (match-beginning 0) + ov-end (match-end 0) + ov-inv (make-overlay ov-beg ov-end) + beg ov-end) + (overlay-put ov-inv 'invisible t) + (when (re-search-forward + (concat "^" message-mark-insert-end) nil t) + (setq ov-beg (match-beginning 0) + ov-end (match-end 0) + ov-inv (make-overlay ov-beg ov-end) + end ov-beg) + (overlay-put ov-inv 'invisible t)) + (when (and beg end) + (let ((ov (make-overlay beg end))) + (overlay-put ov 'face 'mu4e-region-code)) + (setq beg nil end nil)))))) + +;;; View Utilities + +(defun mu4e-view-mark-custom () + "Run some custom mark function." + (mu4e~view-in-headers-context + (mu4e-headers-mark-custom))) + +(defun mu4e~view-split-view-p () + "Return t if we're in split-view, nil otherwise." + (member mu4e-split-view '(horizontal vertical))) + +;;; Scroll commands + +(defun mu4e-view-scroll-up-or-next () + "Scroll-up the current message. +If `mu4e-view-scroll-to-next' is non-nil, and we can't scroll-up +anymore, go the next message." + (interactive) + (condition-case nil + (scroll-up) + (error + (when mu4e-view-scroll-to-next + (mu4e-view-headers-next))))) + +(defun mu4e-scroll-up () + "Scroll text of selected window up one line." + (interactive) + (scroll-up 1)) + +(defun mu4e-scroll-down () + "Scroll text of selected window down one line." + (interactive) + (scroll-down 1)) + +;;; Mark commands + +(defun mu4e-view-unmark-all () + "If we're in split-view, unmark all messages. +Otherwise, warn user that unmarking only works in the header +list." + (interactive) + (if (mu4e~view-split-view-p) + (mu4e~view-in-headers-context (mu4e-mark-unmark-all)) + (mu4e-message "Unmarking needs to be done in the header list view"))) + +(defun mu4e-view-unmark () + "If we're in split-view, unmark message at point. +Otherwise, warn user that unmarking only works in the header +list." + (interactive) + (if (mu4e~view-split-view-p) + (mu4e-view-mark-for-unmark) + (mu4e-message "Unmarking needs to be done in the header list view"))) + +(defmacro mu4e~view-defun-mark-for (mark) + "Define a function mu4e-view-mark-for-MARK." + (let ((funcname (intern (format "mu4e-view-mark-for-%s" mark))) + (docstring (format "Mark the current message for %s." mark))) + `(progn + (defun ,funcname () ,docstring + (interactive) + (mu4e~view-in-headers-context + (mu4e-headers-mark-and-next ',mark))) + (put ',funcname 'definition-name ',mark)))) + +(mu4e~view-defun-mark-for move) +(mu4e~view-defun-mark-for refile) +(mu4e~view-defun-mark-for delete) +(mu4e~view-defun-mark-for flag) +(mu4e~view-defun-mark-for unflag) +(mu4e~view-defun-mark-for unmark) +(mu4e~view-defun-mark-for something) +(mu4e~view-defun-mark-for read) +(mu4e~view-defun-mark-for unread) +(mu4e~view-defun-mark-for trash) +(mu4e~view-defun-mark-for untrash) + +(defun mu4e-view-marked-execute () + "Execute the marked actions." + (interactive) + (mu4e~view-in-headers-context + (mu4e-mark-execute-all))) + + +;;; URL handling + +(defvar mu4e~view-link-map nil + "A map of some number->url so we can jump to url by number.") +(put 'mu4e~view-link-map 'permanent-local t) + +(defvar mu4e-view-active-urls-keymap + (let ((map (make-sparse-keymap))) + (define-key map [down-mouse-1] 'mu4e~view-browse-url-from-binding) + (define-key map [mouse-1] 'mu4e~view-browse-url-from-binding) + (define-key map (kbd "M-") 'mu4e~view-browse-url-from-binding) + map) + "Keymap used for the urls inside the body.") + +(defvar mu4e~view-beginning-of-url-regexp + "https?\\://\\|mailto:" + "Regexp that matches the beginning of http:/https:/mailto: +URLs; match-string 1 will contain the matched URL, if any.") + + +(defun mu4e~view-browse-url-from-binding (&optional url) + "View in browser the url at point, or click location. +If the optional argument URL is provided, browse that instead. +If the url is mailto link, start writing an email to that address." + (interactive) + (let* (( url (or url (mu4e~view-get-property-from-event 'mu4e-url)))) + (when url + (if (string-match-p "^mailto:" url) + (browse-url-mail url) + (browse-url url))))) + + +(defun mu4e~view-get-property-from-event (prop) + "Get the property PROP at point, or the location of the mouse. +The action is chosen based on the `last-command-event'. +Meant to be evoked from interactive commands." + (if (and (eventp last-command-event) + (mouse-event-p last-command-event)) + (let ((posn (event-end last-command-event))) + (when (numberp (posn-point posn)) + (get-text-property + (posn-point posn) + prop + (window-buffer (posn-window posn))))) + (get-text-property (point) prop))) + +;; this is fairly simplistic... +(defun mu4e~view-activate-urls () + "Turn things that look like URLs into clickable things. +Also number them so they can be opened using `mu4e-view-go-to-url'." + (let ((num 0)) + (save-excursion + (setq mu4e~view-link-map ;; buffer local + (make-hash-table :size 32 :weakness nil)) + (goto-char (point-min)) + (while (re-search-forward mu4e~view-beginning-of-url-regexp nil t) + (let ((bounds (thing-at-point-bounds-of-url-at-point))) + (when bounds + (let* ((url (thing-at-point-url-at-point)) + (ov (make-overlay (car bounds) (cdr bounds)))) + (puthash (cl-incf num) url mu4e~view-link-map) + (add-text-properties + (car bounds) + (cdr bounds) + `(face mu4e-link-face + mouse-face highlight + mu4e-url ,url + keymap ,mu4e-view-active-urls-keymap + help-echo + "[mouse-1] or [M-RET] to open the link")) + (overlay-put ov 'after-string + (propertize (format "\u200B[%d]" num) + 'face 'mu4e-url-number-face))))))))) + + +(defun mu4e~view-get-urls-num (prompt &optional multi) + "Ask the user with PROMPT for an URL number for MSG, and ensure +it is valid. The number is [1..n] for URLs \[0..(n-1)] in the +message. If MULTI is nil, return the number for the URL; +otherwise (MULTI is non-nil), accept ranges of URL numbers, as +per `mu4e-split-ranges-to-numbers', and return the corresponding +string." + (let* ((count (hash-table-count mu4e~view-link-map)) (def)) + (when (zerop count) (mu4e-error "No links 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-go-to-url (&optional multi) + "Offer to go to url(s). If MULTI (prefix-argument) is nil, go to +a single one, otherwise, offer to go to a range of urls." + (interactive "P") + (mu4e~view-handle-urls "URL to visit" + multi + (lambda (url) (mu4e~view-browse-url-from-binding url)))) + +(defun mu4e-view-save-url (&optional multi) + "Offer to save urls(s) to the kill-ring. If +MULTI (prefix-argument) is nil, save a single one, otherwise, offer +to save a range of URLs." + (interactive "P") + (mu4e~view-handle-urls "URL to save" multi + (lambda (url) + (kill-new url) + (mu4e-message "Saved %s to the kill-ring" url)))) + +(defun mu4e-view-fetch-url (&optional multi) + "Offer to fetch (download) urls(s). If MULTI (prefix-argument) is nil, +download a single one, otherwise, offer to fetch a range of +URLs. The urls are fetched to `mu4e-attachment-dir'." + (interactive "P") + (mu4e~view-handle-urls "URL to fetch" multi + (lambda (url) + (let ((target (concat (mu4e~get-attachment-dir url) "/" + (file-name-nondirectory url)))) + (url-copy-file url target) + (mu4e-message "Fetched %s -> %s" url target))))) + +(defun mu4e~view-handle-urls (prompt multi urlfunc) + "If MULTI is nil, apply URLFUNC to a single uri, otherwise, apply +it to a range of uris. PROMPT is the query to present to the user." + (if multi + (mu4e~view-handle-multi-urls prompt urlfunc) + (mu4e~view-handle-single-url prompt urlfunc))) + +(defun mu4e~view-handle-single-url (prompt urlfunc &optional num) + "Apply URLFUNC to url NUM in the current message, prompting the +user with PROMPT." + (let* ((num (or num (mu4e~view-get-urls-num prompt))) + (url (gethash num mu4e~view-link-map))) + (unless url (mu4e-warn "Invalid number for URL")) + (funcall urlfunc url))) + +(defun mu4e~view-handle-multi-urls (prompt urlfunc) + "Apply URLFUNC to a a range of urls in the current message, +prompting the user with PROMPT. + +Default is to apply it to all URLs, [1..n], where n is the number +of urls. You can type multiple values separated by space, e.g. 1 +3-6 8 will visit urls 1,3,4,5,6 and 8. + +Furthermore, there is a shortcut \"a\" which means all urls, but as +this is the default, you may not need it." + (let* ((linkstr (mu4e~view-get-urls-num + "URL number range (or 'a' for 'all')" t)) + (count (hash-table-count mu4e~view-link-map)) + (linknums (mu4e-split-ranges-to-numbers linkstr count))) + (dolist (num linknums) + (mu4e~view-handle-single-url prompt urlfunc num)))) + +(defun mu4e-view-for-each-uri (func) + "Evaluate FUNC(uri) for each uri in the current message." + (maphash (lambda (_num uri) (funcall func uri)) mu4e~view-link-map)) (defun mu4e-view-message-with-message-id (msgid) "View message with message-id MSGID. This (re)creates a headers-buffer with a search for MSGID, then open a view for that message." - (mu4e-headers-search (concat "msgid:" msgid) nil nil t msgid t)) + (mu4e-search (concat "msgid:" msgid) nil nil t msgid t)) + + +;;; Variables + +(defvar gnus-icalendar-additional-identities) +(defvar helm-comp-read-use-marked) +(defvar-local mu4e~view-rendering nil) + +(define-obsolete-variable-alias 'mu4e-view-blocked-images 'gnus-blocked-images + "1.5.12") +(define-obsolete-variable-alias 'mu4e-view-inhibit-images 'gnus-inhibit-images + "1.5.12") +;;; Main + +;; remember the mime-handles, so we can clean them up when +;; we quit this buffer. +(defvar-local mu4e~gnus-article-mime-handles nil) +(put 'mu4e~gnus-article-mime-handles 'permanent-local t) + +(defun mu4e-view (msg) + "Display the message MSG in a new buffer, and keep in sync with HDRSBUF. +'In sync' here means that moving to the next/previous message in +the the message view affects HDRSBUF, as does marking etc. + +As a side-effect, a message that is being viewed loses its 'unread' +marking if it still had that." + + (mu4e~headers-update-handler msg nil nil);; update headers, if necessary. + + (when (bufferp gnus-article-buffer) + (kill-buffer gnus-article-buffer)) + (with-current-buffer (get-buffer-create gnus-article-buffer) + (let ((inhibit-read-only t)) + (erase-buffer) + (insert-file-contents-literally + (mu4e-message-field msg :path) nil nil nil t))) + (switch-to-buffer gnus-article-buffer) + (setq mu4e~view-message msg) + (mu4e~view-render-buffer msg)) + +(defun mu4e-view-message-text (msg) + "Return the pristine MSG as a string." + ;; we need this for replying/forwarding, since the mu4e-compose + ;; wants it that way. + (with-temp-buffer + (insert-file-contents-literally + (mu4e-message-field msg :path) nil nil nil t) + (mu4e~view-render-buffer msg) + (buffer-substring-no-properties (point-min) (point-max)))) + +(defun mu4e-action-view-in-browser (msg) + "Show current MSG in browser if it includes an HTML-part. +The variables `browse-url-browser-function', +`browse-url-handlers', and `browse-url-default-handlers' +determine which browser function to use." + (with-temp-buffer + (insert-file-contents-literally + (mu4e-message-field msg :path) nil nil nil t) + (run-hooks 'gnus-article-decode-hook) + (let ((header (cl-loop for field in '("from" "to" "cc" "date" "subject") + when (message-fetch-field field) + concat (format "%s: %s\n" (capitalize field) it))) + (parts (mm-dissect-buffer t t))) + ;; If singlepart, enforce a list. + (when (and (bufferp (car parts)) + (stringp (car (mm-handle-type parts)))) + (setq parts (list parts))) + ;; Process the list + (unless (gnus-article-browse-html-parts parts header) + (mu4e-warn "Message does not contain a \"text/html\" part")) + (mm-destroy-parts parts)))) + + +(defun mu4e~view-render-buffer (msg) + "Render current buffer with MSG using Gnus' article mode." + (setq gnus-summary-buffer (get-buffer-create " *appease-gnus*")) + (let* ((inhibit-read-only t) + (max-specpdl-size mu4e-view-max-specpdl-size) + (mm-decrypt-option 'known) + (ct (mail-fetch-field "Content-Type")) + (ct (and ct (mail-header-parse-content-type ct))) + (charset (mail-content-type-get ct 'charset)) + (charset (and charset (intern charset))) + (mu4e~view-rendering t); Needed if e.g. an ics file is buttonized + (gnus-article-emulate-mime t) + (gnus-unbuttonized-mime-types '(".*/.*")) + (gnus-buttonized-mime-types + (append (list "multipart/signed" "multipart/encrypted") + gnus-buttonized-mime-types)) + (gnus-newsgroup-charset + (if (and charset (coding-system-p charset)) charset + (detect-coding-region (point-min) (point-max) t))) + ;; Possibly add headers (before "Attachments") + (gnus-display-mime-function (mu4e~view-gnus-display-mime msg)) + (gnus-icalendar-additional-identities + (mu4e-personal-addresses 'no-regexp))) + (mm-enable-multibyte) + (mu4e-view-mode) + (run-hooks 'gnus-article-decode-hook) + (gnus-article-prepare-display) + (mu4e~view-activate-urls) + (setq mu4e~gnus-article-mime-handles gnus-article-mime-handles + gnus-article-decoded-p gnus-article-decode-hook) + (set-buffer-modified-p nil) + (add-hook 'kill-buffer-hook #'mu4e~view-kill-mime-handles))) + +(defun mu4e~view-kill-mime-handles () + "Kill cached MIME-handles, if any." + (when mu4e~gnus-article-mime-handles + (mm-destroy-parts mu4e~gnus-article-mime-handles) + (setq mu4e~gnus-article-mime-handles nil))) + +(defun mu4e~view-gnus-display-mime (msg) + "Like `gnus-display-mime' but include mu4e headers to MSG." + (lambda (&optional ihandles) + (gnus-display-mime ihandles) + (unless ihandles + (save-restriction + (article-goto-body) + (forward-line -1) + (narrow-to-region (point) (point)) + (dolist (field mu4e-view-fields) + (let ((fieldval (mu4e-message-field msg field))) + (cl-case field + ((:path :maildir :user-agent :mailing-list :message-id) + (mu4e~view-gnus-insert-header field fieldval)) + ((:flags :tags) + (let ((flags (mapconcat (lambda (flag) + (if (symbolp flag) + (symbol-name flag) + flag)) fieldval ", "))) + (mu4e~view-gnus-insert-header field flags))) + (:size (mu4e~view-gnus-insert-header + field (mu4e-display-size fieldval))) + ((:subject :to :from :cc :bcc :from-or-to :date :attachments + :signature :decryption)) ; handled by Gnus + (t + (mu4e~view-gnus-insert-header-custom msg field))))) + (let ((gnus-treatment-function-alist + '((gnus-treat-highlight-headers + gnus-article-highlight-headers)))) + (gnus-treat-article 'head)))))) + +(defun mu4e~view-gnus-insert-header (field val) + "Insert a header FIELD with value VAL." + (let* ((info (cdr (assoc field mu4e-header-info))) + (key (plist-get info :name)) + (help (plist-get info :help))) + (if (and val (> (length val) 0)) + (insert (propertize (concat key ":") 'help-echo help) + " " val "\n")))) + +(defun mu4e~view-gnus-insert-header-custom (msg field) + "Insert MSG's custom FIELD." + (let* ((info (cdr-safe (or (assoc field mu4e-header-info-custom) + (mu4e-error "Custom field %S not found" field)))) + (key (plist-get info :name)) + (func (or (plist-get info :function) + (mu4e-error "No :function defined for custom field %S %S" + field info))) + (val (funcall func msg)) + (help (plist-get info :help))) + (when (and val (> (length val) 0)) + (insert (propertize (concat key ":") 'help-echo help) " " val "\n")))) + +(define-advice gnus-icalendar-event-from-handle + (:filter-args (handle-attendee) mu4e~view-fix-missing-charset) + "Avoid error when displaying an ical attachment without a charset." + (if (and (boundp 'mu4e~view-rendering) mu4e~view-rendering) + (let* ((handle (car handle-attendee)) + (attendee (cadr handle-attendee)) + (buf (mm-handle-buffer handle)) + (ty (mm-handle-type handle)) + (rest (cddr handle))) + ;; Put the fallback at the end: + (setq ty (append ty '((charset . "utf-8")))) + (setq handle (cons buf (cons ty rest))) + (list handle attendee)) + handle-attendee)) + +(defun mu4e~view-mode-p () + "Is the buffer in mu4e-view-mode or one of its descendants?" + (or (eq major-mode 'mu4e-view-mode) + (derived-mode-p '(mu4e-view-mode)))) + +(defun mu4e~view-nop (func &rest args) + "Do not invoke FUNC with ARGS when in mu4e-view-mode. +This is useful for advising some Gnus-functionality that does not work in mu4e." + (unless (mu4e~view-mode-p) + (apply func args))) + +(defun mu4e~view-button-reply (func &rest args) + "Advise FUNC with ARGS to make `gnus-button-reply' links work in mu4e." + (if (mu4e~view-mode-p) + (mu4e-compose-reply) + (apply func args))) + +(defun mu4e~view-msg-mail (func &rest args) + "Advise FUNC with ARGS to make `gnus-msg-mail' links compose with mu4e." + (if (mu4e~view-mode-p) + (apply 'mu4e~compose-mail args) + (apply func args))) + +(defvar 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 "%" #'mu4e-view-mark-pattern) + (define-key map "t" #'mu4e-view-mark-subthread) + (define-key map "T" #'mu4e-view-mark-thread) + (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 "A" #'mu4e-view-mime-part-action) + (define-key map "e" #'mu4e-view-save-attachments) + + ;; 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 "S-SPC") #'scroll-down) + (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 from view <-> headers (when visible) + (define-key map "y" #'mu4e-select-other-view) + + ;; 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 "M" #'mu4e-view-massage) + + (define-key map "w" 'visual-line-mode) + (define-key map "h" #'mu4e-view-toggle-html) + (define-key map (kbd "M-q") 'article-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 [raw-view] + '("View raw message" . mu4e-view-raw-message)) + (define-key menumap [pipe] + '("Pipe through shell" . mu4e-view-pipe)) + + (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))) + + (set-keymap-parent map special-mode-map) + map) + "Keymap for mu4e-view mode.") + +(set-keymap-parent mu4e-view-mode-map button-buffer-map) +(suppress-keymap 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) + +;; "Define the major-mode for the mu4e-view." +(define-derived-mode mu4e-view-mode gnus-article-mode "mu4e:view" + "Major mode for viewing an e-mail message in mu4e. +Based on Gnus' article-mode." + ;; Restore C-h b default behavior + (define-key mu4e-view-mode-map (kbd "C-h b") 'describe-bindings) + ;; ;; turn off gnus modeline changes and menu items + (advice-add 'gnus-set-mode-line :around #'mu4e~view-nop) + (advice-add 'gnus-button-reply :around #'mu4e~view-button-reply) + (advice-add 'gnus-msg-mail :around #'mu4e~view-msg-mail) + + ;; advice gnus-block-private-groups to always return "." + ;; so that by default we block images. + (advice-add 'gnus-block-private-groups :around + (lambda(func &rest args) + (if (mu4e~view-mode-p) + "." (apply func args)))) + (use-local-map mu4e-view-mode-map) + (mu4e-context-minor-mode) + (mu4e-search-minor-mode) + (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))) + +;;; Massaging the message view + +(defcustom mu4e-view-massage-options + '( ("ctoggle citations" . gnus-article-hide-citation) + ("htoggle headers" . gnus-article-hide-headers) + ("ytoggle crypto" . gnus-article-hide-pem)) +"Various options for 'massaging' the message view. See `(gnus) +Article Treatment' for more options." + :group 'mu4e-view + :type '(alist :key-type string :value-type function)) + +(defun mu4e-view-massage() + "Massage current message view as per `mu4e-view-massage-options'." + (interactive) + (funcall (mu4e-read-option "Massage: " mu4e-view-massage-options))) + +;;; MIME-parts + +(defun mu4e~view-gather-mime-parts () + "Gather all MIME parts as an alist. +The alist uniquely maps the number to the gnus-part." + (let ((parts '())) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (let ((part (get-text-property (point) 'gnus-data)) + (index (get-text-property (point) 'gnus-part))) + (when (and part (numberp index) (not (assoc index parts)) + (push `(,index . ,part) parts))) + (goto-char (or (next-single-property-change (point) 'gnus-part) + (point-max)))))) + parts)) + + +(defun mu4e-view-save-attachments (&optional arg) + "Save mime parts from current mu4e gnus view buffer. + +When helm-mode is enabled provide completion on attachments and +possibility to mark candidates to save, otherwise completion on +attachments is done with `completing-read-multiple', in this case +use \",\" to separate candidate, completion is provided after +each \",\". + +Note, currently this does not work well with file names +containing commas." + (interactive "P") + (cl-assert (and (eq major-mode 'mu4e-view-mode) + (derived-mode-p 'gnus-article-mode))) + (let* ((parts (mu4e~view-gather-mime-parts)) + (handles '()) + (files '()) + (compfn (if (and (boundp 'helm-mode) helm-mode) + #'completing-read + ;; Fallback to `completing-read-multiple' with poor + ;; completion + #'completing-read-multiple)) + dir) + (dolist (part parts) + (let ((fname (cdr (assoc 'filename (assoc "attachment" (cdr part)))))) + (when fname + (push `(,fname . ,(cdr part)) handles) + (push fname files)))) + (if files + (progn + (setq files (let ((helm-comp-read-use-marked t)) + (funcall compfn "Save part(s): " files)) + dir (if arg (read-directory-name "Save to directory: ") mu4e-attachment-dir)) + (cl-loop for (f . h) in handles + when (member f files) + do (mm-save-part-to-file + h (let ((file (expand-file-name f dir))) + (if (file-exists-p file) + (let (newname (count 1)) + (while (and + (setq newname + (concat + (file-name-sans-extension file) + (format "(%s)" count) + (file-name-extension file t))) + (file-exists-p newname)) + (cl-incf count)) + newname) + file))))) + (mu4e-message "No attached files found")))) + + +(defvar mu4e-view-mime-part-actions + '( + ;; + ;; some basic ones + ;; + + ;; save MIME-part to a file + (:name "save" :handler gnus-article-save-part :receives index) + ;; pipe MIME-part to some arbitrary shell command + (:name "|pipe" :handler gnus-article-pipe-part :receives index) + ;; open with the default handler, if any + (:name "open" :handler mu4e~view-open-file :receives temp) + ;; open with some custom file. + (:name "wopen-with" :handler (lambda (file)(mu4e~view-open-file file t)) + :receives temp) + + ;; + ;; some more examples + ;; + + ;; import GPG key + (:name "gpg" :handler epa-import-keys :receives temp) + ;; count the number of lines in a MIME-part + (:name "line-count" :handler "wc -l" :receives pipe) + ;; open in this emacs instance; tries to use the attachment name, + ;; so emacs can use specific modes etc. + (:name "emacs" :handler find-file :receives temp) + ;; open in this emacs instance, "raw" + (:name "raw" :handler (lambda (str) + (let ((tmpbuf (get-buffer-create " *mu4e-raw-mime*"))) + (with-current-buffer tmpbuf + (insert str) + (view-mode) + (goto-char (point-min))) + (switch-to-buffer tmpbuf))) :receives pipe)) + + "Specifies actions for MIME-parts. + +Each of the actions is a plist with keys +`(:name ;; name of the action; shortcut is first letter of name + + :handler ;; one of: + ;; - a function receiving the index/temp/pipe + ;; - a string, which is taken as a shell command + + :receives ;; a symbol specifying what the handler receives + ;; - index: the index number of the mime part (default) + ;; - temp: the full path to the mime part in a + ;; temporary file, which is deleted immediately + ;; after invoking handler + ;; - pipe: the attachment is piped to some shell command + ;; or as a string parameter to a function +).") + + +(defun mu4e~view-mime-part-to-temp-file (handle) + "Write MIME-part HANDLE to a temporary file and return the file name. +The filename is deduced from the MIME-part's filename, or +otherwise random; the result is placed in a temporary directory +with a unique name. Returns the full path for the file created. +The directory and file are self-destructed." + (let* ((tmpdir (make-temp-file "mu4e-temp-" t)) + (fname (cdr-safe (assoc 'filename (assoc "attachment" (cdr handle))))) + (fname (if fname + (concat tmpdir "/" (replace-regexp-in-string "/" "-" fname)) + (let ((temporary-file-directory tmpdir)) + (make-temp-file "mimepart"))))) + (mm-save-part-to-file handle fname) + (run-at-time "30 sec" nil (lambda () (ignore-errors (delete-directory tmpdir t)))) + fname)) + + +(defun mu4e~view-open-file (file &optional force-ask) + "Open FILE with default handler, if any. +Otherwise, or if FORCE-ASK is set, ask user for the program to +open with." + (let* ((opener + (pcase system-type + (`darwin "open") + ((or 'gnu 'gnu/linux 'gnu/kfreebsd) "xdg-open"))) + (prog (if (or force-ask (not opener)) + (read-shell-command "Open MIME-part with: ") + opener))) + (call-process prog nil 0 nil file))) + +(defun mu4e-view-mime-part-action (&optional n) + "Apply some action to MIME-part N in the current messsage. +If N is not specified, ask for it. For instance, '3 A o' opens +the third MIME-part." + (interactive "NNumber of MIME-part: ") + (let* ((parts (mu4e~view-gather-mime-parts)) + (options (mapcar (lambda (action) `(,(plist-get action :name) . ,action)) + mu4e-view-mime-part-actions)) + (handle (or (cdr-safe (cl-find-if (lambda (part) (eq (car part) n)) parts)) + (mu4e-error "MIME-part %s not found" n))) + (action (or (and options (mu4e-read-option "Action on MIME-part: " options)) + (mu4e-error "No such action"))) + (handler (or (plist-get action :handler) + (mu4e-error "No :handler item found for action %S" action))) + (receives (or (plist-get action :receives) + (mu4e-error "No :receives item found for action %S" action)))) + (save-excursion + (cond + ((functionp handler) + (cond + ((eq receives 'index) (funcall handler n)) + ((eq receives 'pipe) (funcall handler (mm-with-unibyte-buffer + (mm-insert-part handle) + (buffer-string)))) + ((eq receives 'temp) + (funcall handler (mu4e~view-mime-part-to-temp-file handle))) + (t (mu4e-error "Invalid :receive for %S" action)))) + ((stringp handler) + (cond + ((eq receives 'index) (shell-command (concat handler " " (shell-quote-argument n)))) + ((eq receives 'pipe) (mm-pipe-part handle handler)) + ((eq receives 'temp) + (shell-command (shell-command (concat handler " " + (shell-quote-argument + (mu4e~view-mime-part-to-temp-file handle)))))) + (t (mu4e-error "Invalid action %S" action)))))))) + +(defun mu4e-view-toggle-html () + "Toggle html-display of the first html-part found." + (interactive) + ;; This function assumes `gnus-article-mime-handle-alist' is sorted by + ;; pertinence, i.e. the first HTML part found in it is the most important one. + (if-let ((html-part + (seq-find (lambda (handle) + (equal (mm-handle-media-type (cdr handle)) "text/html")) + gnus-article-mime-handle-alist))) + (gnus-article-inline-part (car html-part)) + (mu4e-warn "No html part in this message"))) (provide 'mu4e-view) ;;; mu4e-view.el ends here