:group 'notmuch-hooks)
;; Mostly useful for debugging.
-(defcustom notmuch-show-all-multipart/alternative-parts t
+(defcustom notmuch-show-all-multipart/alternative-parts nil
"Should all parts of multipart/alternative parts be shown?"
:type 'boolean
:group 'notmuch-show)
'action 'notmuch-show-part-button-default
'keymap 'notmuch-show-part-button-map
'follow-link t
- 'face 'message-mml)
+ 'face 'message-mml
+ :supertype 'notmuch-button-type)
(defvar notmuch-show-part-button-map
(let ((map (make-sparse-keymap)))
(fset 'notmuch-show-part-button-map notmuch-show-part-button-map)
(defun notmuch-show-insert-part-header (nth content-type declared-type &optional name comment)
- (let ((button))
+ (let ((button)
+ (base-label (concat (when name (concat name ": "))
+ declared-type
+ (unless (string-equal declared-type content-type)
+ (concat " (as " content-type ")"))
+ comment)))
+
(setq button
(insert-button
- (concat "[ "
- (if name (concat name ": ") "")
- declared-type
- (if (not (string-equal declared-type content-type))
- (concat " (as " content-type ")")
- "")
- (or comment "")
- " ]")
+ (concat "[ " base-label " ]")
+ :base-label base-label
:type 'notmuch-show-part-button-type
:notmuch-part nth
:notmuch-filename name
(let ((handle (mm-make-handle (current-buffer) (list content-type))))
(mm-pipe-part handle))))
+;; 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))
+ (new-start (button-start button))
+ (button-label (button-get button :base-label))
+ (old-point (point))
+ (inhibit-read-only t))
+ (overlay-put overlay 'invisible (not show))
+ (goto-char new-start)
+ (insert "[ " button-label (if show " ]" " (hidden) ]"))
+ (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))))))))
+
(defun notmuch-show-multipart/*-to-list (part)
(mapcar (lambda (inner-part) (plist-get inner-part :content-type))
(plist-get part :content)))
;; but it's not clear that this is the wrong thing to do - which
;; should be chosen if there are more than one that match?
(mapc (lambda (inner-part)
- (let ((inner-type (plist-get inner-part :content-type)))
- (if (or notmuch-show-all-multipart/alternative-parts
- (string= chosen-type inner-type))
- (notmuch-show-insert-bodypart msg inner-part depth)
- (notmuch-show-insert-part-header (plist-get inner-part :id) inner-type inner-type nil " (not shown)"))))
+ (let* ((inner-type (plist-get inner-part :content-type))
+ (hide (not (or notmuch-show-all-multipart/alternative-parts
+ (string= chosen-type inner-type)))))
+ (notmuch-show-insert-bodypart msg inner-part depth hide)))
inner-parts)
(when notmuch-show-indent-multipart
(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-text/html (msg part content-type nth depth declared-type)
+ ;; text/html handler to work around bugs in renderers and our
+ ;; invisibile parts code. In particular w3m sets up a keymap which
+ ;; "leaks" outside the invisible region and causes strange effects
+ ;; in notmuch. We set mm-inline-text-html-with-w3m-keymap to nil to
+ ;; tell w3m not to set a keymap (so the normal notmuch-show-mode-map
+ ;; remains).
+ (let ((mm-inline-text-html-with-w3m-keymap nil))
+ (notmuch-show-insert-part-*/* msg part content-type nth depth declared-type)))
+
(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))
(setq handlers (cdr handlers))))
t)
-(defun notmuch-show-insert-bodypart (msg part depth)
- "Insert the body part PART at depth DEPTH in the current thread."
+(defun notmuch-show-create-part-overlays (msg beg end hide)
+ "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))))))
+
+(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."
(let ((content-type (downcase (plist-get part :content-type)))
- (nth (plist-get part :id)))
- (notmuch-show-insert-bodypart-internal msg part content-type nth depth content-type))
- ;; 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")))
+ (nth (plist-get part :id))
+ (beg (point)))
+
+ (notmuch-show-insert-bodypart-internal msg part content-type nth depth content-type)
+ ;; 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)))
(defun notmuch-show-insert-body (msg body depth)
"Insert the body BODY at depth DEPTH in the current thread."
message-start message-end
content-start content-end
headers-start headers-end
- body-start body-end
- (headers-invis-spec (notmuch-show-make-symbol "header"))
- (message-invis-spec (notmuch-show-make-symbol "message"))
(bare-subject (notmuch-show-strip-re (plist-get headers :Subject))))
- ;; Set `buffer-invisibility-spec' to `nil' (a list), otherwise
- ;; removing items from `buffer-invisibility-spec' (which is what
- ;; `notmuch-show-headers-visible' and
- ;; `notmuch-show-message-visible' do) is a no-op and has no
- ;; effect. This caused threads with only matching messages to have
- ;; those messages hidden initially because
- ;; `buffer-invisibility-spec' stayed `t'.
- ;;
- ;; This needs to be set here (rather than just above the call to
- ;; `notmuch-show-headers-visible') because some of the part
- ;; rendering or body washing functions
- ;; (e.g. `notmuch-wash-text/plain-citations') manipulate
- ;; `buffer-invisibility-spec').
- (when (eq buffer-invisibility-spec t)
- (setq buffer-invisibility-spec nil))
-
(setq message-start (point-marker))
(notmuch-show-insert-headerline headers
(setq content-start (point-marker))
- (plist-put msg :headers-invis-spec headers-invis-spec)
- (plist-put msg :message-invis-spec message-invis-spec)
-
;; Set `headers-start' to point after the 'Subject:' header to be
;; compatible with the existing implementation. This just sets it
;; to after the first header.
(setq notmuch-show-previous-subject bare-subject)
- (setq body-start (point-marker))
;; A blank line between the headers and the body.
(insert "\n")
(notmuch-show-insert-body msg (plist-get msg :body)
;; Ensure that the body ends with a newline.
(unless (bolp)
(insert "\n"))
- (setq body-end (point-marker))
(setq content-end (point-marker))
;; Indent according to the depth in the thread.
;; message.
(put-text-property message-start message-end :notmuch-message-extent (cons message-start message-end))
- (let ((headers-overlay (make-overlay headers-start headers-end))
- (invis-specs (list headers-invis-spec message-invis-spec)))
- (overlay-put headers-overlay 'invisible invis-specs)
- (overlay-put headers-overlay 'priority 10))
- (overlay-put (make-overlay body-start body-end) 'invisible message-invis-spec)
+ ;; Create overlays used to control visibility
+ (plist-put msg :headers-overlay (make-overlay headers-start headers-end))
+ (plist-put msg :message-overlay (make-overlay headers-start content-end))
(plist-put msg :depth depth)
;; Remove the overlay created by goto-address-mode
(remove-overlays (first link) (second link) 'goto-address t)
(make-text-button (first link) (second link)
+ :type 'notmuch-button-type
'action `(lambda (arg)
(notmuch-show ,(third link)))
'follow-link t
(let ((inhibit-read-only t)
(state (unless reset-state
(notmuch-show-capture-state))))
+ ;; erase-buffer does not seem to remove overlays, which can lead
+ ;; to weird effects such as remaining images, so remove them
+ ;; manually.
+ (remove-overlays)
(erase-buffer)
(notmuch-show-build-buffer)
(if state
;; Functions relating to the visibility of messages and their
;; components.
-(defun notmuch-show-element-visible (props visible-p spec-property)
- (let ((spec (plist-get props spec-property)))
- (if visible-p
- (remove-from-invisibility-spec spec)
- (add-to-invisibility-spec spec))))
-
(defun notmuch-show-message-visible (props visible-p)
- (notmuch-show-element-visible props visible-p :message-invis-spec)
+ (overlay-put (plist-get props :message-overlay) 'invisible (not visible-p))
(notmuch-show-set-prop :message-visible visible-p props))
(defun notmuch-show-headers-visible (props visible-p)
- (notmuch-show-element-visible props visible-p :headers-invis-spec)
+ (overlay-put (plist-get props :headers-overlay) 'invisible (not visible-p))
(notmuch-show-set-prop :headers-visible visible-p props))
;; Functions for setting and getting attributes of the current
(interactive)
(notmuch-common-do-stash (notmuch-show-get-from)))
-(defun notmuch-show-stash-message-id ()
- "Copy id: query matching the current message to kill-ring."
- (interactive)
- (notmuch-common-do-stash (notmuch-show-get-message-id)))
+(defun notmuch-show-stash-message-id (&optional stash-thread-id)
+ "Copy id: query matching the current message to kill-ring.
+
+If invoked with a prefix argument (or STASH-THREAD-ID is
+non-nil), copy thread: query matching the current thread to
+kill-ring."
+ (interactive "P")
+ (if stash-thread-id
+ (notmuch-common-do-stash notmuch-show-thread-id)
+ (notmuch-common-do-stash (notmuch-show-get-message-id))))
(defun notmuch-show-stash-message-id-stripped ()
"Copy message ID of current message (sans `id:' prefix) to kill-ring."
(defun notmuch-show-part-button-default (&optional button)
(interactive)
- (notmuch-show-part-button-internal button notmuch-show-part-button-default-action))
+ (let ((button (or button (button-at (point)))))
+ (if (button-get button 'overlay)
+ (notmuch-show-toggle-part-invisibility button)
+ (notmuch-show-part-button-internal button notmuch-show-part-button-default-action))))
(defun notmuch-show-part-button-save (&optional button)
(interactive)