X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=emacs%2Fnotmuch-show.el;h=92d3811c995b1b17bc2e92c0c011a911211255ff;hp=a7f326311a91bb840f5d7c2111503dc0e189fd5d;hb=046f5dded2a113d80e55288aaa1659a6843dafa3;hpb=53629b55065122eff3a80bc59968613f8e10e490 diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el index a7f32631..92d3811c 100644 --- a/emacs/notmuch-show.el +++ b/emacs/notmuch-show.el @@ -47,8 +47,8 @@ For an open message, all of these headers will be made visible according to `notmuch-message-headers-visible' or can be toggled with `notmuch-show-toggle-headers'. For a closed message, only the first header in the list will be visible." - :group 'notmuch - :type '(repeat string)) + :type '(repeat string) + :group 'notmuch-show) (defcustom notmuch-message-headers-visible t "Should the headers be visible by default? @@ -58,13 +58,13 @@ If this value is non-nil, then all of the headers defined in of each message. Otherwise, these headers will be hidden and `notmuch-show-toggle-headers' can be used to make the visible for any given message." - :group 'notmuch - :type 'boolean) + :type 'boolean + :group 'notmuch-show) (defcustom notmuch-show-relative-dates t "Display relative dates in the message summary line." - :group 'notmuch - :type 'boolean) + :type 'boolean + :group 'notmuch-show) (defvar notmuch-show-markup-headers-hook '(notmuch-show-colour-headers) "A list of functions called to decorate the headers listed in @@ -72,30 +72,45 @@ any given message." (defcustom notmuch-show-hook nil "Functions called after populating a `notmuch-show' buffer." - :group 'notmuch - :type 'hook) + :type 'hook + :group 'notmuch-show + :group 'notmuch-hooks) -(defcustom notmuch-show-insert-text/plain-hook '(notmuch-wash-excerpt-citations) +(defcustom notmuch-show-insert-text/plain-hook '(notmuch-wash-wrap-long-lines + notmuch-wash-tidy-citations + notmuch-wash-elide-blank-lines + notmuch-wash-excerpt-citations) "Functions used to improve the display of text/plain parts." - :group 'notmuch :type 'hook :options '(notmuch-wash-convert-inline-patch-to-part notmuch-wash-wrap-long-lines notmuch-wash-tidy-citations notmuch-wash-elide-blank-lines - notmuch-wash-excerpt-citations)) + notmuch-wash-excerpt-citations) + :group 'notmuch-show + :group 'notmuch-hooks) ;; Mostly useful for debugging. (defcustom notmuch-show-all-multipart/alternative-parts t "Should all parts of multipart/alternative parts be shown?" - :group 'notmuch - :type 'boolean) + :type 'boolean + :group 'notmuch-show) + +(defcustom notmuch-show-indent-messages-width 1 + "Width of message indentation in threads. + +Messages are shown indented according to their depth in a thread. +This variable determines the width of this indentation measured +in number of blanks. Defaults to `1', choose `0' to disable +indentation." + :type 'integer + :group 'notmuch-show) (defcustom notmuch-show-indent-multipart nil "Should the sub-parts of a multipart/* part be indented?" ;; dme: Not sure which is a good default. - :group 'notmuch - :type 'boolean) + :type 'boolean + :group 'notmuch-show) (defmacro with-current-notmuch-show-message (&rest body) "Evaluate body with current buffer set to the text of current message" @@ -238,7 +253,7 @@ unchanged ADDRESS if parsing fails." "Insert a notmuch style headerline based on HEADERS for a message at DEPTH in the current thread." (let ((start (point))) - (insert (notmuch-show-spaces-n depth) + (insert (notmuch-show-spaces-n (* notmuch-show-indent-messages-width depth)) (notmuch-show-clean-address (plist-get headers :From)) " (" date @@ -255,12 +270,12 @@ message at DEPTH in the current thread." (defun notmuch-show-insert-headers (headers) "Insert the headers of the current message." (let ((start (point))) - (mapc '(lambda (header) - (let* ((header-symbol (intern (concat ":" header))) - (header-value (plist-get headers header-symbol))) - (if (and header-value - (not (string-equal "" header-value))) - (notmuch-show-insert-header header header-value)))) + (mapc (lambda (header) + (let* ((header-symbol (intern (concat ":" header))) + (header-value (plist-get headers header-symbol))) + (if (and header-value + (not (string-equal "" header-value))) + (notmuch-show-insert-header header header-value)))) notmuch-message-headers) (save-excursion (save-restriction @@ -310,17 +325,18 @@ message at DEPTH in the current thread." ;; ange-ftp, which is reasonable to use here. (mm-write-region (point-min) (point-max) file nil nil nil 'no-conversion t))))) -(defun notmuch-show-mm-display-part-inline (msg part content-type content) +(defun notmuch-show-mm-display-part-inline (msg part nth content-type) "Use the mm-decode/mm-view functions to display a part in the current buffer, if possible." (let ((display-buffer (current-buffer))) (with-temp-buffer - (insert content) - (let ((handle (mm-make-handle (current-buffer) (list content-type)))) - (set-buffer display-buffer) + (let* ((charset (plist-get part :content-charset)) + (handle (mm-make-handle (current-buffer) `(,content-type (charset . ,charset))))) (if (and (mm-inlinable-p handle) (mm-inlined-p handle)) - (progn + (let ((content (notmuch-show-get-bodypart-content msg part nth))) + (insert content) + (set-buffer display-buffer) (mm-display-part handle) t) nil))))) @@ -334,7 +350,7 @@ current buffer, if possible." )) (defun notmuch-show-multipart/*-to-list (part) - (mapcar '(lambda (inner-part) (plist-get inner-part :content-type)) + (mapcar (lambda (inner-part) (plist-get inner-part :content-type)) (plist-get part :content))) (defun notmuch-show-multipart/alternative-choose (types) @@ -447,11 +463,10 @@ current buffer, if possible." (defun notmuch-show-insert-part-multipart/signed (msg part content-type nth depth declared-type) (let ((button (notmuch-show-insert-part-header nth declared-type content-type nil))) - (button-put button 'face '(:foreground "blue")) + (button-put button 'face 'notmuch-crypto-part-header) ;; add signature status button if sigstatus provided (if (plist-member part :sigstatus) - (let* ((headers (plist-get msg :headers)) - (from (plist-get headers :From)) + (let* ((from (notmuch-show-get-header :From msg)) (sigstatus (car (plist-get part :sigstatus)))) (notmuch-crypto-insert-sigstatus-button sigstatus from)) ;; if we're not adding sigstatus, tell the user how they can get it @@ -470,15 +485,14 @@ current buffer, if possible." (defun notmuch-show-insert-part-multipart/encrypted (msg part content-type nth depth declared-type) (let ((button (notmuch-show-insert-part-header nth declared-type content-type nil))) - (button-put button 'face '(:foreground "blue")) + (button-put button 'face 'notmuch-crypto-part-header) ;; add encryption status button if encstatus specified (if (plist-member part :encstatus) (let ((encstatus (car (plist-get part :encstatus)))) (notmuch-crypto-insert-encstatus-button encstatus) ;; add signature status button if sigstatus specified (if (plist-member part :sigstatus) - (let* ((headers (plist-get msg :headers)) - (from (plist-get headers :From)) + (let* ((from (notmuch-show-get-header :From msg)) (sigstatus (car (plist-get part :sigstatus)))) (notmuch-crypto-insert-sigstatus-button sigstatus from)))) ;; if we're not adding encstatus, tell the user how they can get it @@ -511,7 +525,6 @@ current buffer, if possible." (defun notmuch-show-insert-part-message/rfc822 (msg part content-type nth depth declared-type) (notmuch-show-insert-part-header nth declared-type content-type nil) (let* ((message (car (plist-get part :content))) - (headers (plist-get message :headers)) (body (car (plist-get message :body))) (start (point))) @@ -578,17 +591,14 @@ current buffer, if possible." nil)) nil)))) -(defun notmuch-show-insert-part-application/* (msg part content-type nth depth declared-type -) - ;; do not render random "application" parts - (notmuch-show-insert-part-header nth content-type declared-type (plist-get part :filename))) +;; Handler for wash generated inline patch fake parts. +(defun notmuch-show-insert-part-inline-patch-fake-part (msg part content-type nth depth declared-type) + (notmuch-show-insert-part-*/* msg part "text/x-diff" nth depth "inline patch")) (defun notmuch-show-insert-part-*/* (msg part content-type nth depth declared-type) ;; This handler _must_ succeed - it is the handler of last resort. (notmuch-show-insert-part-header nth content-type declared-type (plist-get part :filename)) - (let ((content (notmuch-show-get-bodypart-content msg part nth))) - (if content - (notmuch-show-mm-display-part-inline msg part content-type content))) + (notmuch-show-mm-display-part-inline msg part nth content-type) t) ;; Functions for determining how to handle MIME parts. @@ -652,12 +662,12 @@ current buffer, if possible." ;; part, so we make sure that we're down at the end. (goto-char (point-max)) ;; Ensure that the part ends with a carriage return. - (if (not (bolp)) - (insert "\n"))) + (unless (bolp) + (insert "\n"))) (defun notmuch-show-insert-body (msg body depth) "Insert the body BODY at depth DEPTH in the current thread." - (mapc '(lambda (part) (notmuch-show-insert-bodypart msg part depth)) body)) + (mapc (lambda (part) (notmuch-show-insert-bodypart msg part depth)) body)) (defun notmuch-show-make-symbol (type) (make-symbol (concat "notmuch-show-" type))) @@ -733,13 +743,13 @@ current buffer, if possible." (setq body-start (point-marker)) (notmuch-show-insert-body msg (plist-get msg :body) depth) ;; Ensure that the body ends with a newline. - (if (not (bolp)) - (insert "\n")) + (unless (bolp) + (insert "\n")) (setq body-end (point-marker)) (setq content-end (point-marker)) ;; Indent according to the depth in the thread. - (indent-rigidly content-start content-end depth) + (indent-rigidly content-start content-end (* notmuch-show-indent-messages-width depth)) (setq message-end (point-max-marker)) @@ -775,11 +785,11 @@ current buffer, if possible." (defun notmuch-show-insert-thread (thread depth) "Insert the thread THREAD at depth DEPTH in the current forest." - (mapc '(lambda (tree) (notmuch-show-insert-tree tree depth)) thread)) + (mapc (lambda (tree) (notmuch-show-insert-tree tree depth)) thread)) (defun notmuch-show-insert-forest (forest) "Insert the forest of threads FOREST." - (mapc '(lambda (thread) (notmuch-show-insert-thread thread 0)) forest)) + (mapc (lambda (thread) (notmuch-show-insert-thread thread 0)) forest)) (defvar notmuch-show-thread-id nil) (make-variable-buffer-local 'notmuch-show-thread-id) @@ -803,7 +813,7 @@ a corresponding notmuch search." (remove-overlays (match-beginning 0) (match-end 0) 'goto-address t) (make-text-button (match-beginning 0) (match-end 0) 'action `(lambda (arg) - (notmuch-search ,(match-string-no-properties 0))) + (notmuch-show ,(match-string-no-properties 0))) 'follow-link t 'help-echo "Mouse-1, RET: search for this message" 'face goto-address-mail-face)))) @@ -843,6 +853,8 @@ buffer." (inhibit-read-only t)) (switch-to-buffer buffer) (notmuch-show-mode) + ;; Don't track undo information for this buffer + (set 'buffer-undo-list t) (setq notmuch-show-thread-id thread-id) (setq notmuch-show-parent-buffer parent-buffer) @@ -873,8 +885,8 @@ buffer." (run-hooks 'notmuch-show-hook)) ;; Move straight to the first open message - (if (not (notmuch-show-message-visible-p)) - (notmuch-show-next-open-message)) + (unless (notmuch-show-message-visible-p) + (notmuch-show-next-open-message)) ;; Set the header line to the subject of the first open message. (setq header-line-format (notmuch-show-strip-re (notmuch-show-get-subject))) @@ -923,7 +935,8 @@ thread id. If a prefix is given, crypto processing is toggled." (define-key map "s" 'notmuch-search) (define-key map "m" 'notmuch-mua-new-mail) (define-key map "f" 'notmuch-show-forward-message) - (define-key map "r" 'notmuch-show-reply) + (define-key map "r" 'notmuch-show-reply-sender) + (define-key map "R" 'notmuch-show-reply) (define-key map "|" 'notmuch-show-pipe-message) (define-key map "w" 'notmuch-show-save-attachments) (define-key map "V" 'notmuch-show-view-raw-message) @@ -1051,6 +1064,12 @@ All currently available key bindings: (put-text-property (point) (+ (point) 1) :notmuch-message-properties props))) (defun notmuch-show-get-message-properties () + "Return the properties of the current message as a plist. + +Some useful entries are: +:headers - Property list containing the headers :Date, :Subject, :From, etc. +:body - Body of the message +:tags - Tags for this message" (save-excursion (notmuch-show-move-to-message-top) (get-text-property (point) :notmuch-message-properties))) @@ -1077,9 +1096,9 @@ All currently available key bindings: "Return the filename of the current message." (notmuch-show-get-prop :filename)) -(defun notmuch-show-get-header (header) +(defun notmuch-show-get-header (header &optional props) "Return the named header of the current message, if any." - (plist-get (notmuch-show-get-prop :headers) header)) + (plist-get (notmuch-show-get-prop :headers props) header)) (defun notmuch-show-get-cc () (notmuch-show-get-header :Cc)) @@ -1149,8 +1168,9 @@ current window), advance to the next open message." (ret nil)) (while (invisible-p visible-end-of-this-message) (setq visible-end-of-this-message - (previous-single-char-property-change visible-end-of-this-message - 'invisible))) + (max (point-min) + (1- (previous-single-char-property-change + visible-end-of-this-message 'invisible))))) (cond ;; Ideally we would test `end-of-this-message' against the result ;; of `window-end', but that doesn't account for the fact that @@ -1221,9 +1241,14 @@ any effects from previous calls to (notmuch-show-previous-message))))) (defun notmuch-show-reply (&optional prompt-for-sender) - "Reply to the current message." + "Reply to the sender and all recipients of the current message." + (interactive "P") + (notmuch-mua-new-reply (notmuch-show-get-message-id) prompt-for-sender t)) + +(defun notmuch-show-reply-sender (&optional prompt-for-sender) + "Reply to the sender of the current message." (interactive "P") - (notmuch-mua-new-reply (notmuch-show-get-message-id) prompt-for-sender)) + (notmuch-mua-new-reply (notmuch-show-get-message-id) prompt-for-sender nil)) (defun notmuch-show-forward-message (&optional prompt-for-sender) "Forward the current message."