X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=emacs%2Fnotmuch-show.el;h=c917046614724e4fe3a6e230a6f79aaa5ddafdb8;hp=ec998ede8dad49ebc1421f7eb839dd24da70cde7;hb=HEAD;hpb=a3b46fa8bbfaf6651f5055bb27aa52a0ef0d3ba2 diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el index ec998ede..4c0ad74d 100644 --- a/emacs/notmuch-show.el +++ b/emacs/notmuch-show.el @@ -452,14 +452,19 @@ operation on the contents of the current buffer." (defun notmuch-show-update-tags (tags) "Update the displayed tags of the current message." (save-excursion - (goto-char (notmuch-show-message-top)) - (when (re-search-forward "(\\([^()]*\\))$" (line-end-position) t) - (let ((inhibit-read-only t)) - (replace-match (concat "(" - (notmuch-tag-format-tags - tags - (notmuch-show-get-prop :orig-tags)) - ")")))))) + (let ((inhibit-read-only t) + (start (notmuch-show-message-top)) + (depth (notmuch-show-get-prop :depth)) + (orig-tags (notmuch-show-get-prop :orig-tags)) + (props (notmuch-show-get-message-properties)) + (extent (notmuch-show-message-extent))) + (goto-char start) + (notmuch-show-insert-headerline props depth tags orig-tags) + (put-text-property start (1+ start) + :notmuch-message-properties props) + (put-text-property (car extent) (cdr extent) :notmuch-message-extent extent) + ;; delete original headerline, but do not save to kill ring + (delete-region (point) (1+ (line-end-position)))))) (defun notmuch-clean-address (address) "Try to clean a single email ADDRESS for display. Return a cons @@ -530,11 +535,17 @@ Return unchanged ADDRESS if parsing fails." (plist-put msg :height height) height)))) -(defun notmuch-show-insert-headerline (headers date tags depth duplicate file-count) +(defun notmuch-show-insert-headerline (msg-plist depth tags &optional orig-tags) "Insert a notmuch style headerline based on HEADERS for a message at DEPTH in the current thread." - (let ((start (point)) - (from (notmuch-sanitize + (let* ((start (point)) + (headers (plist-get msg-plist :headers)) + (duplicate (or (plist-get msg-plist :duplicate) 0)) + (file-count (length (plist-get msg-plist :filename))) + (date (or (and notmuch-show-relative-dates + (plist-get msg-plist :date_relative)) + (plist-get headers :Date))) + (from (notmuch-sanitize (notmuch-show-clean-address (plist-get headers :From))))) (when (string-match "\\cR" from) ;; If the From header has a right-to-left character add @@ -549,7 +560,7 @@ message at DEPTH in the current thread." " (" date ") (" - (notmuch-tag-format-tags tags tags) + (notmuch-tag-format-tags tags (or orig-tags tags)) ")") (insert (if (> file-count 1) @@ -633,8 +644,24 @@ message at DEPTH in the current thread." (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)) + (let* ((part (plist-get properties :notmuch-part)) + (undisplayer (plist-get part :undisplayer)) + (mime-type (plist-get part :computed-type)) + (redisplay-data (button-get button + :notmuch-redisplay-data)) + (imagep (string-match "^image/" mime-type))) + (cond + ((and imagep (not show) undisplayer) + ;; call undisplayer thunk created by gnus. + (funcall undisplayer) + ;; there is an extra newline left + (delete-region + (+ 1 (button-end button)) + (+ 2 (button-end button)))) + ((and imagep show redisplay-data) + (notmuch-show-lazy-part redisplay-data button)) + (t + (overlay-put overlay 'invisible (not show))))) t))))))) ;;; Part content ID handling @@ -1008,10 +1035,13 @@ will return nil if the CID is unknown or cannot be retrieved." (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))) + (depth (notmuch-show-get-depth)) + (mime-type (plist-get (cadr part-args) :computed-type))) (save-restriction (narrow-to-region part-beg part-end) (delete-region part-beg part-end) + (when (and mime-type (string-match "^image/" mime-type)) + (button-put button :notmuch-redisplay-data part-args)) (apply #'notmuch-show-insert-bodypart-internal part-args) (indent-rigidly part-beg part-end @@ -1095,14 +1125,18 @@ is t, hide the part initially and show the button." (and deep button) (and high button) (and long button)))) - (content-beg (point))) + (content-beg (point)) + (part-data (list msg part mime-type nth depth button))) ;; 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) + (cond + (show-part + (apply #'notmuch-show-insert-bodypart-internal part-data) + (when (and button (string-match "^image/" mime-type)) + (button-put button :notmuch-redisplay-data part-data))) + (t (when button - (button-put button :notmuch-lazy-part - (list msg part mime-type nth depth button)))) + (button-put button :notmuch-lazy-part part-data)))) ;; 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)) @@ -1171,8 +1205,6 @@ is out of range." (defun notmuch-show-insert-msg (msg depth) "Insert the message MSG at depth DEPTH in the current thread." (let* ((headers (plist-get msg :headers)) - (duplicate (or (plist-get msg :duplicate) 0)) - (files (length (plist-get msg :filename))) ;; Indentation causes the buffer offset of the start/end ;; points to move, so we must use markers. message-start message-end @@ -1180,11 +1212,7 @@ is out of range." headers-start headers-end (bare-subject (notmuch-show-strip-re (plist-get headers :Subject)))) (setq message-start (point-marker)) - (notmuch-show-insert-headerline headers - (or (and notmuch-show-relative-dates - (plist-get msg :date_relative)) - (plist-get headers :Date)) - (plist-get msg :tags) depth duplicate files) + (notmuch-show-insert-headerline msg depth (plist-get msg :tags)) (setq content-start (point-marker)) ;; Set `headers-start' to point after the 'Subject:' header to be ;; compatible with the existing implementation. This just sets it @@ -2479,10 +2507,12 @@ kill-ring." (defun notmuch-show-stash-mlarchive-link (&optional mla) "Copy an ML Archive URI for the current message to the kill-ring. -This presumes that the message is available at the selected Mailing List Archive. +This presumes that the message is available at the selected +Mailing List Archive. -If optional argument MLA is non-nil, use the provided key instead of prompting -the user (see `notmuch-show-stash-mlarchive-link-alist')." +If optional argument MLA is non-nil, use the provided key instead +of prompting the user (see +`notmuch-show-stash-mlarchive-link-alist')." (interactive) (let ((url (cdr (assoc (or mla @@ -2499,12 +2529,15 @@ the user (see `notmuch-show-stash-mlarchive-link-alist')." (concat url (notmuch-show-get-message-id t)))))) (defun notmuch-show-stash-mlarchive-link-and-go (&optional mla) - "Copy an ML Archive URI for the current message to the kill-ring and visit it. + "Copy an ML Archive URI for the current message to the + kill-ring and visit it. -This presumes that the message is available at the selected Mailing List Archive. +This presumes that the message is available at the selected +Mailing List Archive. -If optional argument MLA is non-nil, use the provided key instead of prompting -the user (see `notmuch-show-stash-mlarchive-link-alist')." +If optional argument MLA is non-nil, use the provided key instead +of prompting the user (see +`notmuch-show-stash-mlarchive-link-alist')." (interactive) (notmuch-show-stash-mlarchive-link mla) (browse-url (current-kill 0 t)))