X-Git-Url: https://git.notmuchmail.org/git?a=blobdiff_plain;f=emacs%2Fnotmuch-show.el;h=619337b4461ffd1b2e2bb479e0eeee4c3ecf7228;hb=d273263d16433344cac77f54862c77535bf51e6a;hp=aded1ee745e8f4fe065245053010b83e21e970f0;hpb=fb4a0967cab7df737d5d53199a48a0e79c429b61;p=notmuch diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el index aded1ee7..619337b4 100644 --- a/emacs/notmuch-show.el +++ b/emacs/notmuch-show.el @@ -32,7 +32,6 @@ (require 'notmuch-lib) (require 'notmuch-tag) -(require 'notmuch-query) (require 'notmuch-wash) (require 'notmuch-mua) (require 'notmuch-crypto) @@ -111,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 @@ -493,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)) @@ -513,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))) @@ -1027,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). @@ -1082,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 @@ -1096,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 @@ -1185,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)))) @@ -1366,7 +1445,7 @@ If no messages match the query return NIL." (notmuch-show-previous-subject "")) ;; Use results from the first query that returns some. (while (and (not forest) queries) - (setq forest (notmuch-query-get-threads + (setq forest (notmuch--run-show (append cli-args (list "'") (car queries) (list "'")))) (when (and forest notmuch-show-single-message) (setq forest (list (list (list forest))))) @@ -1449,6 +1528,7 @@ non-nil) then the state of the buffer (open/closed messages) is reset based on the original query." (interactive "P") (let ((inhibit-read-only t) + (mm-inline-override-types (notmuch--inline-override-types)) (state (unless reset-state (notmuch-show-capture-state)))) ;; `erase-buffer' does not seem to remove overlays, which can lead @@ -1537,6 +1617,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) @@ -1731,10 +1812,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 (notmuch-show-get-duplicate))) + (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." @@ -1746,6 +1827,10 @@ current thread." (defun notmuch-show-get-date () (notmuch-show-get-header :Date)) +(defun notmuch-show-get-duplicate () + ;; if no duplicate property exists, assume first file + (or (notmuch-show-get-prop :duplicate) 1)) + (defun notmuch-show-get-timestamp () (notmuch-show-get-prop :timestamp)) @@ -1940,13 +2025,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") @@ -2057,12 +2144,16 @@ to show, nil otherwise." "View the original source of the current message." (interactive) (let* ((id (notmuch-show-get-message-id)) - (buf (get-buffer-create (concat "*notmuch-raw-" id "*"))) + (duplicate (notmuch-show-get-duplicate)) + (args (if (> duplicate 1) + (list (format "--duplicate=%d" duplicate) id) + (list id))) + (buf (get-buffer-create (format "*notmuch-raw-%s-%d*" id duplicate))) (inhibit-read-only t)) (pop-to-buffer-same-window buf) (erase-buffer) (let ((coding-system-for-read 'no-conversion)) - (notmuch--call-process notmuch-command nil t nil "show" "--format=raw" id)) + (apply #'notmuch--call-process notmuch-command nil t nil "show" "--format=raw" args)) (goto-char (point-min)) (set-buffer-modified-p nil) (setq buffer-read-only t)