(declare-function notmuch-search-next-thread "notmuch" nil)
(declare-function notmuch-search-previous-thread "notmuch" nil)
(declare-function notmuch-search-show-thread "notmuch" nil)
+(declare-function notmuch-foreach-mime-part "notmuch" (function mm-handle))
+(declare-function notmuch-count-attachments "notmuch" (mm-handle))
+(declare-function notmuch-save-attachments "notmuch" (mm-handle &optional queryp))
(defcustom notmuch-message-headers '("Subject" "To" "Cc" "Date")
"Headers that should be shown in a message, in this order.
"Enable Visual Line mode."
(visual-line-mode t))
+;; DEPRECATED in Notmuch 0.16 since we now have convenient part
+;; commands. We'll keep the command around for a version or two in
+;; case people want to bind it themselves.
(defun notmuch-show-view-all-mime-parts ()
"Use external viewers to view all attachments from the current message."
(interactive)
)))
(mm-display-parts (mm-dissect-buffer)))))
-(defun notmuch-foreach-mime-part (function mm-handle)
- (cond ((stringp (car mm-handle))
- (dolist (part (cdr mm-handle))
- (notmuch-foreach-mime-part function part)))
- ((bufferp (car mm-handle))
- (funcall function mm-handle))
- (t (dolist (part mm-handle)
- (notmuch-foreach-mime-part function part)))))
-
-(defun notmuch-count-attachments (mm-handle)
- (let ((count 0))
- (notmuch-foreach-mime-part
- (lambda (p)
- (let ((disposition (mm-handle-disposition p)))
- (and (listp disposition)
- (or (equal (car disposition) "attachment")
- (and (equal (car disposition) "inline")
- (assq 'filename disposition)))
- (incf count))))
- mm-handle)
- count))
-
-(defun notmuch-save-attachments (mm-handle &optional queryp)
- (notmuch-foreach-mime-part
- (lambda (p)
- (let ((disposition (mm-handle-disposition p)))
- (and (listp disposition)
- (or (equal (car disposition) "attachment")
- (and (equal (car disposition) "inline")
- (assq 'filename disposition)))
- (or (not queryp)
- (y-or-n-p
- (concat "Save '" (cdr (assq 'filename disposition)) "' ")))
- (mm-save-part p))))
- mm-handle))
-
(defun notmuch-show-save-attachments ()
"Save all attachments from the current message."
(interactive)
(insert-button
(concat "[ " base-label " ]")
:base-label base-label
- :type 'notmuch-show-part-button-type))
+ :type 'notmuch-show-part-button-type
+ :notmuch-part-hidden nil))
(insert "\n")
;; return button
button))
-;; This is taken from notmuch-wash: maybe it should be unified?
(defun notmuch-show-toggle-part-invisibility (&optional button)
(interactive)
(let* ((button (or button (button-at (point))))
- (overlay (button-get button 'overlay)))
- (when overlay
- (let* ((show (overlay-get overlay 'invisible))
+ (overlay (button-get button 'overlay))
+ (lazy-part (button-get button :notmuch-lazy-part)))
+ ;; We have a part to toggle if there is an overlay or if there is a lazy part.
+ ;; If neither is present we cannot toggle the part so we just return nil.
+ (when (or overlay lazy-part)
+ (let* ((show (button-get button :notmuch-part-hidden))
(new-start (button-start button))
(button-label (button-get button :base-label))
(old-point (point))
- (properties (text-properties-at (point)))
+ (properties (text-properties-at (button-start button)))
(inhibit-read-only t))
- (overlay-put overlay 'invisible (not show))
+ ;; Toggle the button itself.
+ (button-put button :notmuch-part-hidden (not show))
(goto-char new-start)
(insert "[ " button-label (if show " ]" " (hidden) ]"))
(set-text-properties new-start (point) properties)
(let ((old-end (button-end button)))
(move-overlay button new-start (point))
(delete-region (point) old-end))
- (goto-char (min old-point (1- (button-end button))))))))
+ (goto-char (min old-point (1- (button-end button))))
+ ;; Return nil if there is a lazy-part, it is empty, and we are
+ ;; trying to show it. In all other cases return t.
+ (if lazy-part
+ (when show
+ (button-put button :notmuch-lazy-part nil)
+ (notmuch-show-lazy-part lazy-part button))
+ ;; else there must be an overlay.
+ (overlay-put overlay 'invisible (not show))
+ t)))))
;; MIME part renderers
;; Render the primary part.
(notmuch-show-insert-bodypart msg (car inner-parts) depth)
+ ;; Add hidden buttons for the rest
+ (mapc (lambda (inner-part)
+ (notmuch-show-insert-bodypart msg inner-part depth t))
+ (cdr inner-parts))
(when notmuch-show-indent-multipart
(indent-rigidly start (point) 1)))
(setq handlers (cdr handlers))))
t)
-(defun notmuch-show-create-part-overlays (msg beg end hide)
+(defun notmuch-show-create-part-overlays (button beg end)
"Add an overlay to the part between BEG and END"
- (let* ((button (button-at beg))
- (part-beg (and button (1+ (button-end button)))))
-
- ;; If the part contains no text we do not make it toggleable. We
- ;; also need to check that the button is a genuine part button not
- ;; a notmuch-wash button.
- (when (and button (/= part-beg end) (button-get button :base-label))
- (button-put button 'overlay (make-overlay part-beg end))
- ;; We toggle the button for hidden parts as that gets the
- ;; button label right.
- (save-excursion
- (when hide
- (notmuch-show-toggle-part-invisibility button))))))
+
+ ;; If there is no button (i.e., the part is text/plain and the first
+ ;; part) or if the part has no content then we don't make the part
+ ;; toggleable.
+ (when (and button (/= beg end))
+ (button-put button 'overlay (make-overlay beg end))
+ ;; Return true if we created an overlay.
+ t))
+
+(defun notmuch-show-record-part-information (part beg end)
+ "Store PART as a text property from BEG to END"
+
+ ;; Record part information. Since we already inserted subparts,
+ ;; don't override existing :notmuch-part properties.
+ (notmuch-map-text-property beg end :notmuch-part
+ (lambda (v) (or v part)))
+ ;; Make :notmuch-part front sticky and rear non-sticky so it stays
+ ;; applied to the beginning of each line when we indent the
+ ;; message. Since we're operating on arbitrary renderer output,
+ ;; watch out for sticky specs of t, which means all properties are
+ ;; front-sticky/rear-nonsticky.
+ (notmuch-map-text-property beg end 'front-sticky
+ (lambda (v) (if (listp v)
+ (pushnew :notmuch-part v)
+ v)))
+ (notmuch-map-text-property beg end 'rear-nonsticky
+ (lambda (v) (if (listp v)
+ (pushnew :notmuch-part v)
+ v))))
+
+(defun notmuch-show-lazy-part (part-args button)
+ ;; Insert the lazy part after the button for the part. We would just
+ ;; move to the start of the new line following the button and insert
+ ;; the part but that point might have text properties (eg colours
+ ;; from a message header etc) so instead we start from the last
+ ;; character of the button by adding a newline and finish by
+ ;; removing the extra newline from the end of the part.
+ (save-excursion
+ (goto-char (button-end button))
+ (insert "\n")
+ (let* ((inhibit-read-only t)
+ ;; We need to use markers for the start and end of the part
+ ;; because the part insertion functions do not guarantee
+ ;; to leave point at the end of the part.
+ (part-beg (copy-marker (point) nil))
+ (part-end (copy-marker (point) t))
+ ;; We have to save the depth as we can't find the depth
+ ;; when narrowed.
+ (depth (notmuch-show-get-depth)))
+ (save-restriction
+ (narrow-to-region part-beg part-end)
+ (delete-region part-beg part-end)
+ (apply #'notmuch-show-insert-bodypart-internal part-args)
+ (indent-rigidly part-beg part-end depth))
+ (goto-char part-end)
+ (delete-char 1)
+ (notmuch-show-record-part-information (second part-args)
+ (button-start button)
+ part-end)
+ ;; Create the overlay. If the lazy-part turned out to be empty/not
+ ;; showable this returns nil.
+ (notmuch-show-create-part-overlays button part-beg part-end))))
(defun notmuch-show-insert-bodypart (msg part depth &optional hide)
"Insert the body part PART at depth DEPTH in the current thread.
-If HIDE is non-nil then initially hide this part."
+HIDE determines whether to show or hide the part and the button
+as follows: If HIDE is nil, show the part and the button. If HIDE
+is t, hide the part initially and show the button. If HIDE is
+'no-buttons, show the part but do not add any buttons (this is
+useful for quoting in replies)."
(let* ((content-type (downcase (plist-get part :content-type)))
(mime-type (or (and (string= content-type "application/octet-stream")
content-type))
(nth (plist-get part :id))
(beg (point))
- ;; We omit the part button for the first (or only) part if this is text/plain.
- (button (unless (and (string= mime-type "text/plain") (<= nth 1))
- (notmuch-show-insert-part-header nth mime-type content-type (plist-get part :filename)))))
+ ;; Hide the part initially if HIDE is t.
+ (show-part (not (equal hide t)))
+ ;; We omit the part button for the first (or only) part if
+ ;; this is text/plain, or HIDE is 'no-buttons.
+ (button (unless (or (equal hide 'no-buttons)
+ (and (string= mime-type "text/plain") (<= nth 1)))
+ (notmuch-show-insert-part-header nth mime-type content-type (plist-get part :filename))))
+ (content-beg (point)))
+
+ ;; Store the computed mime-type for later use (e.g. by attachment handlers).
+ (plist-put part :computed-type mime-type)
+
+ (if show-part
+ (notmuch-show-insert-bodypart-internal msg part mime-type nth depth button)
+ (button-put button :notmuch-lazy-part
+ (list msg part mime-type nth depth button)))
- (notmuch-show-insert-bodypart-internal msg part mime-type nth depth button)
;; Some of the body part handlers leave point somewhere up in the
;; 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.
(unless (bolp)
(insert "\n"))
- (notmuch-show-create-part-overlays msg beg (point) hide)
- ;; Record part information. Since we already inserted subparts,
- ;; don't override existing :notmuch-part properties.
- (notmuch-map-text-property beg (point) :notmuch-part
- (lambda (v) (or v part)))
- ;; Make :notmuch-part front sticky and rear non-sticky so it stays
- ;; applied to the beginning of each line when we indent the
- ;; message. Since we're operating on arbitrary renderer output,
- ;; watch out for sticky specs of t, which means all properties are
- ;; front-sticky/rear-nonsticky.
- (notmuch-map-text-property beg (point) 'front-sticky
- (lambda (v) (if (listp v)
- (pushnew :notmuch-part v)
- v)))
- (notmuch-map-text-property beg (point) 'rear-nonsticky
- (lambda (v) (if (listp v)
- (pushnew :notmuch-part v)
- v)))))
+ ;; We do not create the overlay for hidden (lazy) parts until
+ ;; they are inserted.
+ (if show-part
+ (notmuch-show-create-part-overlays button content-beg (point))
+ (save-excursion
+ (notmuch-show-toggle-part-invisibility button)))
+ (notmuch-show-record-part-information part beg (point))))
(defun notmuch-show-insert-body (msg body depth)
"Insert the body BODY at depth DEPTH in the current thread."
(defvar notmuch-show-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "?" 'notmuch-help)
- (define-key map "q" 'notmuch-kill-this-buffer)
+ (set-keymap-parent map notmuch-common-keymap)
(define-key map (kbd "<C-tab>") 'widget-backward)
(define-key map (kbd "M-TAB") 'notmuch-show-previous-button)
(define-key map (kbd "<backtab>") 'notmuch-show-previous-button)
(define-key map (kbd "TAB") 'notmuch-show-next-button)
- (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-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)
- (define-key map "v" 'notmuch-show-view-all-mime-parts)
(define-key map "c" 'notmuch-show-stash-map)
- (define-key map "=" 'notmuch-show-refresh-view)
(define-key map "h" 'notmuch-show-toggle-visibility-headers)
(define-key map "*" 'notmuch-show-tag-all)
(define-key map "-" 'notmuch-show-remove-tag)
\\{notmuch-show-mode-map}"
(interactive)
(kill-all-local-variables)
+ (setq notmuch-buffer-refresh-function #'notmuch-show-refresh-view)
(use-local-map notmuch-show-mode-map)
(setq major-mode 'notmuch-show-mode
mode-name "notmuch-show")
"Are the headers of the current message visible?"
(notmuch-show-get-prop :headers-visible))
+(put 'notmuch-show-mark-read 'notmuch-prefix-doc
+ "Mark the current message as unread.")
(defun notmuch-show-mark-read (&optional unread)
"Mark the current message as read.
(notmuch-show-archive-thread-then-next)))
(defun notmuch-show-rewind ()
- "Backup through the thread, (reverse scrolling compared to \\[notmuch-show-advance-and-archive]).
+ "Backup through the thread (reverse scrolling compared to \\[notmuch-show-advance-and-archive]).
Specifically, if the beginning of the previous email is fewer
than `window-height' lines from the current point, move to it
;; Move to the previous message.
(notmuch-show-previous-message)))))
+(put 'notmuch-show-reply 'notmuch-prefix-doc "... and prompt for sender")
(defun notmuch-show-reply (&optional prompt-for-sender)
"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))
+(put 'notmuch-show-reply-sender 'notmuch-prefix-doc "... and prompt for sender")
(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 nil))
+(put 'notmuch-show-forward-message 'notmuch-prefix-doc
+ "... and prompt for sender")
(defun notmuch-show-forward-message (&optional prompt-for-sender)
"Forward the current message."
(interactive "P")
(set-buffer-modified-p nil)
(view-buffer buf 'kill-buffer-if-not-modified)))
+(put 'notmuch-show-pipe-message 'notmuch-doc
+ "Pipe the contents of the current message to a command.")
+(put 'notmuch-show-pipe-message 'notmuch-prefix-doc
+ "Pipe the thread as an mbox to a command.")
(defun notmuch-show-pipe-message (entire-thread command)
- "Pipe the contents of the current message (or thread) to the given command.
-
-The given command will be executed with the raw contents of the
-current email message as stdin. Anything printed by the command
-to stdout or stderr will appear in the *notmuch-pipe* buffer.
-
-When invoked with a prefix argument, the command will receive all
-open messages in the current thread (formatted as an mbox) rather
-than only the current message."
- (interactive "P\nsPipe message to command: ")
+ "Pipe the contents of the current message (or thread) to COMMAND.
+
+COMMAND will be executed with the raw contents of the current
+email message as stdin. Anything printed by the command to stdout
+or stderr will appear in the *notmuch-pipe* buffer.
+
+If ENTIRE-THREAD is non-nil (or when invoked with a prefix
+argument), COMMAND will receive all open messages in the current
+thread (formatted as an mbox) rather than only the current
+message."
+ (interactive (let ((query-string (if current-prefix-arg
+ "Pipe all open messages to command: "
+ "Pipe message to command: ")))
+ (list current-prefix-arg (read-string query-string))))
(let (shell-command)
(if entire-thread
(setq shell-command
(notmuch-show-set-tags new-tags))))))
(defun notmuch-show-add-tag ()
- "Same as `notmuch-show-tag' but sets initial input to '+'."
+ "Change tags for the current message (defaulting to add).
+
+Same as `notmuch-show-tag' but sets initial input to '+'."
(interactive)
(notmuch-show-tag "+"))
(defun notmuch-show-remove-tag ()
- "Same as `notmuch-show-tag' but sets initial input to '-'."
+ "Change tags for the current message (defaulting to remove).
+
+Same as `notmuch-show-tag' but sets initial input to '-'."
(interactive)
(notmuch-show-tag "-"))
(not (plist-get props :message-visible))))
(force-window-update))
+(put 'notmuch-show-open-or-close-all 'notmuch-doc "Show all messages.")
+(put 'notmuch-show-open-or-close-all 'notmuch-prefix-doc "Hide all messages.")
(defun notmuch-show-open-or-close-all ()
"Set the visibility all of the messages in the current thread.
+
By default make all of the messages visible. With a prefix
argument, hide all of the messages."
(interactive)
(interactive)
(notmuch-show-next-thread t t))
+(put 'notmuch-show-archive-thread 'notmuch-prefix-doc
+ "Un-archive each message in thread.")
(defun notmuch-show-archive-thread (&optional unarchive)
"Archive each message in thread.
(notmuch-show-archive-thread)
(notmuch-show-next-thread))
+(put 'notmuch-show-archive-message 'notmuch-prefix-doc
+ "Un-archive the current message.")
(defun notmuch-show-archive-message (&optional unarchive)
"Archive the current message.
(interactive)
(notmuch-common-do-stash (notmuch-show-get-from)))
+(put 'notmuch-show-stash-message-id 'notmuch-prefix-doc
+ "Copy thread: query matching current thread to kill-ring.")
(defun notmuch-show-stash-message-id (&optional stash-thread-id)
"Copy id: query matching the current message to kill-ring.
(with-current-buffer buf
(setq notmuch-show-process-crypto process-crypto)
;; Always acquires the part via `notmuch part', even if it is
- ;; available in the JSON output.
+ ;; available in the SEXP output.
(insert (notmuch-get-bodypart-internal message-id nth notmuch-show-process-crypto)))
buf))
(message-id (notmuch-show-get-message-id))
(nth (plist-get part :id))
(buf (notmuch-show-generate-part-buffer message-id nth))
- (content-type (plist-get part :content-type))
+ (computed-type (plist-get part :computed-type))
(filename (plist-get part :filename))
(disposition (if filename `(attachment (filename . ,filename)))))
- (mm-make-handle buf (list content-type) nil nil disposition)))
+ (mm-make-handle buf (list computed-type) nil nil disposition)))
(defun notmuch-show-apply-to-current-part-handle (fn)
"Apply FN to an mm-handle for the part containing point.
(defun notmuch-show-part-button-default (&optional button)
(interactive)
(let ((button (or button (button-at (point)))))
- (if (button-get button 'overlay)
- (notmuch-show-toggle-part-invisibility button)
+ ;; Try to toggle the part, if that fails then call the default
+ ;; action. The toggle fails if the part has no emacs renderable
+ ;; content.
+ (unless (notmuch-show-toggle-part-invisibility button)
(call-interactively notmuch-show-part-button-default-action))))
(defun notmuch-show-save-part ()
projects / notmuch / blobdiff