X-Git-Url: https://git.notmuchmail.org/git?a=blobdiff_plain;f=emacs%2Fnotmuch-show.el;h=527db4bbc0ff346572bdf34f97830264ac7dad38;hb=1849c68d0f4de0a2028df5f1708d473e60d87785;hp=0954d87639813cbd0236ee1ce7b9847bd8703d3b;hpb=5500868bd96f9461a230d16839591cb7ebc035df;p=notmuch diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el index 0954d876..527db4bb 100644 --- a/emacs/notmuch-show.el +++ b/emacs/notmuch-show.el @@ -110,6 +110,32 @@ displayed." (function :tag "Function")) :group 'notmuch-show) +(defcustom notmuch-show-depth-limit nil + "Depth beyond which message bodies are displayed lazily. + +If bound to an integer, any message with tree depth greater than +this will have its body display lazily, initially +inserting only a button. + +If this variable is set to nil (the default) no such lazy +insertion is done." + :type '(choice (const :tag "No limit" nil) + (number :tag "Limit" 10)) + :group 'notmuch-show) + +(defcustom notmuch-show-height-limit nil + "Height (from leaves) beyond which message bodies are displayed lazily. + +If bound to an integer, any message with height in the message +tree greater than this will have its body displayed lazily, +initially only a button. + +If this variable is set to nil (the default) no such lazy +display is done." + :type '(choice (const :tag "No limit" nil) + (number :tag "Limit" 10)) + :group 'notmuch-show) + (defcustom notmuch-show-relative-dates t "Display relative dates in the message summary line." :type 'boolean @@ -492,7 +518,19 @@ Return unchanged ADDRESS if parsing fails." ;; Otherwise format the name and address together. (concat p-name " <" p-address ">")))) -(defun notmuch-show-insert-headerline (headers date tags depth) +(defun notmuch-show--mark-height (tree) + "Calculate and cache height (distance from deepest descendent)" + (let* ((msg (car tree)) + (children (cadr tree)) + (cached-height (plist-get msg :height))) + (or cached-height + (let ((height + (if (null children) 0 + (1+ (apply #'max (mapcar #'notmuch-show--mark-height children)))))) + (plist-put msg :height height) + height)))) + +(defun notmuch-show-insert-headerline (headers date tags depth duplicate file-count) "Insert a notmuch style headerline based on HEADERS for a message at DEPTH in the current thread." (let ((start (point)) @@ -512,7 +550,14 @@ message at DEPTH in the current thread." date ") (" (notmuch-tag-format-tags tags tags) - ")\n") + ")") + (insert + (if (> file-count 1) + (let ((txt (format "%d/%d\n" duplicate file-count))) + (concat + (notmuch-show-spaces-n (max 0 (- (window-width) (+ (current-column) (length txt))))) + txt)) + "\n")) (overlay-put (make-overlay start (point)) 'face 'notmuch-message-summary-face))) @@ -1026,21 +1071,29 @@ is t, hide the part initially and show the button." (let* ((content-type (plist-get part :content-type)) (mime-type (notmuch-show-mime-type part)) (nth (plist-get part :id)) + (height (plist-get msg :height)) (long (and (notmuch-match-content-type mime-type "text/*") (> notmuch-show-max-text-part-size 0) (> (length (plist-get part :content)) notmuch-show-max-text-part-size))) + (deep (and notmuch-show-depth-limit + (> depth notmuch-show-depth-limit))) + (high (and notmuch-show-height-limit + (> height notmuch-show-height-limit))) (beg (point)) ;; This default header-p function omits the part button for ;; the first (or only) part if this is text/plain. - (button (and (funcall notmuch-show-insert-header-p-function part hide) + (button (and (or deep long high + (funcall notmuch-show-insert-header-p-function part hide)) (notmuch-show-insert-part-header nth mime-type (and content-type (downcase content-type)) (plist-get part :filename)))) - ;; Hide the part initially if HIDE is t, or if it is too long + ;; Hide the part initially if HIDE is t, or if it is too long/deep ;; and we have a button to allow toggling. (show-part (not (or (equal hide t) + (and deep button) + (and high button) (and long button)))) (content-beg (point))) ;; Store the computed mime-type for later use (e.g. by attachment handlers). @@ -1081,9 +1134,35 @@ is t, hide the part initially and show the button." (defvar notmuch-show-previous-subject "") (make-variable-buffer-local 'notmuch-show-previous-subject) +(defun notmuch-show-choose-duplicate (duplicate) + (interactive "Nduplicate: ") + (let ((count (length (notmuch-show-get-prop :filename)))) + (when (or (> duplicate count) + (< duplicate 1)) + (error "Duplicate %d out of range [1,%d]" duplicate count))) + (notmuch-show-move-to-message-top) + (save-excursion + (let* ((extent (notmuch-show-message-extent)) + (id (notmuch-show-get-message-id)) + (depth (notmuch-show-get-depth)) + (inhibit-read-only t) + (new-msg (notmuch--run-show (list id) duplicate))) + ;; clean up existing overlays to avoid extending them. + (dolist (o (overlays-in (car extent) (cdr extent))) + (delete-overlay o)) + ;; pretend insertion is happening at end of buffer + (narrow-to-region (point-min) (car extent)) + ;; Insert first, then delete, to avoid marker for start of next + ;; message being in same place as the start of this one. + (notmuch-show-insert-msg new-msg depth) + (widen) + (delete-region (point) (cdr extent))))) + (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 @@ -1095,7 +1174,7 @@ is t, hide the part initially and show the button." (or (and notmuch-show-relative-dates (plist-get msg :date_relative)) (plist-get headers :Date)) - (plist-get msg :tags) depth) + (plist-get msg :tags) depth duplicate files) (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 @@ -1184,6 +1263,7 @@ is t, hide the part initially and show the button." (replies (cadr tree))) ;; We test whether there is a message or just some replies. (when msg + (notmuch-show--mark-height tree) (notmuch-show-insert-msg msg depth)) (notmuch-show-insert-thread replies (1+ depth)))) @@ -1536,6 +1616,7 @@ reset based on the original query." (define-key map "#" 'notmuch-show-print-message) (define-key map "!" 'notmuch-show-toggle-elide-non-matching) (define-key map "$" 'notmuch-show-toggle-process-crypto) + (define-key map "%" 'notmuch-show-choose-duplicate) (define-key map "<" 'notmuch-show-toggle-thread-indentation) (define-key map "t" 'toggle-truncate-lines) (define-key map "." 'notmuch-show-part-map) @@ -1730,10 +1811,10 @@ current thread." ;; dme: Would it make sense to use a macro for many of these? -;; XXX TODO figure out what to do about multiple filenames (defun notmuch-show-get-filename () "Return the filename of the current message." - (car (notmuch-show-get-prop :filename))) + (let ((duplicate (or (notmuch-show-get-prop :duplicate) 1))) + (nth (1- duplicate) (notmuch-show-get-prop :filename)))) (defun notmuch-show-get-header (header &optional props) "Return the named header of the current message, if any." @@ -1939,13 +2020,15 @@ any effects from previous calls to (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)) + (notmuch-mua-new-reply (notmuch-show-get-message-id) prompt-for-sender t + (notmuch-show-get-prop :duplicate))) (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)) + (notmuch-mua-new-reply (notmuch-show-get-message-id) prompt-for-sender nil + (notmuch-show-get-prop :duplicate))) (put 'notmuch-show-forward-message 'notmuch-prefix-doc "... and prompt for sender")