X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=emacs%2Fnotmuch-show.el;h=ce5ea6f9128e90d07e8b49b920f06624ce4a7bbc;hp=4a60631002590e6b26d7dc0e76344751d5a04cb2;hb=7cd3cd30039b54aefeab3dde83bbf14badaf7a60;hpb=119a42571eb8a57e3f6a8ea5e44450c43dd9df04

diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 4a606310..ce5ea6f9 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -30,6 +30,7 @@
 (require 'goto-addr)
 
 (require 'notmuch-lib)
+(require 'notmuch-tag)
 (require 'notmuch-query)
 (require 'notmuch-wash)
 (require 'notmuch-mua)
@@ -38,10 +39,8 @@
 
 (declare-function notmuch-call-notmuch-process "notmuch" (&rest args))
 (declare-function notmuch-fontify-headers "notmuch" nil)
-(declare-function notmuch-read-tag-changes "notmuch" (&optional initial-input &rest search-terms))
 (declare-function notmuch-search-next-thread "notmuch" nil)
 (declare-function notmuch-search-show-thread "notmuch" nil)
-(declare-function notmuch-update-tags "notmuch" (current-tags tag-changes))
 
 (defcustom notmuch-message-headers '("Subject" "To" "Cc" "Date")
   "Headers that should be shown in a message, in this order.
@@ -184,6 +183,13 @@ provided with an MLA argument nor `completing-read' input."
 	     notmuch-show-stash-mlarchive-link-alist))
   :group 'notmuch-show)
 
+(defcustom notmuch-show-mark-read-tags '("-unread")
+  "List of tags to apply when message is read, ie. shown in notmuch-show
+buffer."
+  :type '(repeat string)
+  :group 'notmuch-show)
+
+
 (defmacro with-current-notmuch-show-message (&rest body)
   "Evaluate body with current buffer set to the text of current message"
   `(save-excursion
@@ -454,6 +460,7 @@ message at DEPTH in the current thread."
     (define-key map "s" 'notmuch-show-part-button-save)
     (define-key map "v" 'notmuch-show-part-button-view)
     (define-key map "o" 'notmuch-show-part-button-interactively-view)
+    (define-key map "|" 'notmuch-show-part-button-pipe)
     map)
   "Submap for button commands")
 (fset 'notmuch-show-part-button-map notmuch-show-part-button-map)
@@ -488,7 +495,7 @@ message at DEPTH in the current thread."
 	 (setq notmuch-show-process-crypto ,process-crypto)
 	 ;; Always acquires the part via `notmuch part', even if it is
 	 ;; available in the JSON output.
-	 (insert (notmuch-show-get-bodypart-internal ,message-id ,nth))
+	 (insert (notmuch-get-bodypart-internal ,message-id ,nth notmuch-show-process-crypto))
 	 ,@body))))
 
 (defun notmuch-show-save-part (message-id nth &optional filename content-type)
@@ -525,47 +532,18 @@ message at DEPTH in the current thread."
     (let ((handle (mm-make-handle (current-buffer) (list content-type))))
       (mm-interactively-view-part handle))))
 
-(defun notmuch-show-mm-display-part-inline (msg part nth content-type)
-  "Use the mm-decode/mm-view functions to display a part in the
-current buffer, if possible."
-  (let ((display-buffer (current-buffer)))
-    (with-temp-buffer
-      (let* ((charset (plist-get part :content-charset))
-	     (handle (mm-make-handle (current-buffer) `(,content-type (charset . ,charset)))))
-	;; If the user wants the part inlined, insert the content and
-	;; test whether we are able to inline it (which includes both
-	;; capability and suitability tests).
-	(when (mm-inlined-p handle)
-	  (insert (notmuch-show-get-bodypart-content msg part nth))
-	  (when (mm-inlinable-p handle)
-	    (set-buffer display-buffer)
-	    (mm-display-part handle)
-	    t))))))
-
-(defvar notmuch-show-multipart/alternative-discouraged
-  '(
-    ;; Avoid HTML parts.
-    "text/html"
-    ;; multipart/related usually contain a text/html part and some associated graphics.
-    "multipart/related"
-    ))
+(defun notmuch-show-pipe-part (message-id nth &optional filename content-type)
+  (notmuch-with-temp-part-buffer message-id nth
+    (let ((handle (mm-make-handle (current-buffer) (list content-type))))
+      (mm-pipe-part handle))))
 
 (defun notmuch-show-multipart/*-to-list (part)
   (mapcar (lambda (inner-part) (plist-get inner-part :content-type))
 	  (plist-get part :content)))
 
-(defun notmuch-show-multipart/alternative-choose (types)
-  ;; Based on `mm-preferred-alternative-precedence'.
-  (let ((seq types))
-    (dolist (pref (reverse notmuch-show-multipart/alternative-discouraged))
-      (dolist (elem (copy-sequence seq))
-	(when (string-match pref elem)
-	  (setq seq (nconc (delete elem seq) (list elem))))))
-    seq))
-
 (defun notmuch-show-insert-part-multipart/alternative (msg part content-type nth depth declared-type)
   (notmuch-show-insert-part-header nth declared-type content-type nil)
-  (let ((chosen-type (car (notmuch-show-multipart/alternative-choose (notmuch-show-multipart/*-to-list part))))
+  (let ((chosen-type (car (notmuch-multipart/alternative-choose (notmuch-show-multipart/*-to-list part))))
 	(inner-parts (plist-get part :content))
 	(start (point)))
     ;; This inserts all parts of the chosen type rather than just one,
@@ -630,8 +608,8 @@ current buffer, if possible."
 	  ;; times (hundreds!), which results in many calls to
 	  ;; `notmuch part'.
 	  (unless content
-	    (setq content (notmuch-show-get-bodypart-internal (concat "id:" message-id)
-							      part-number))
+	    (setq content (notmuch-get-bodypart-internal (notmuch-id-to-query message-id)
+							      part-number notmuch-show-process-crypto))
 	    (with-current-buffer w3m-current-buffer
 	      (notmuch-show-w3m-cid-store-internal url
 						   message-id
@@ -751,7 +729,7 @@ current buffer, if possible."
     ;; insert a header to make this clear.
     (if (> nth 1)
 	(notmuch-show-insert-part-header nth declared-type content-type (plist-get part :filename)))
-    (insert (notmuch-show-get-bodypart-content msg part nth))
+    (insert (notmuch-get-bodypart-content msg part nth notmuch-show-process-crypto))
     (save-excursion
       (save-restriction
 	(narrow-to-region start (point-max))
@@ -761,7 +739,7 @@ current buffer, if possible."
 (defun notmuch-show-insert-part-text/calendar (msg part content-type nth depth declared-type)
   (notmuch-show-insert-part-header nth declared-type content-type (plist-get part :filename))
   (insert (with-temp-buffer
-	    (insert (notmuch-show-get-bodypart-content msg part nth))
+	    (insert (notmuch-get-bodypart-content msg part nth notmuch-show-process-crypto))
 	    (goto-char (point-min))
 	    (let ((file (make-temp-file "notmuch-ical"))
 		  result)
@@ -803,14 +781,11 @@ current buffer, if possible."
 (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))
-  (notmuch-show-mm-display-part-inline msg part nth content-type)
+  (notmuch-mm-display-part-inline msg part nth content-type notmuch-show-process-crypto)
   t)
 
 ;; Functions for determining how to handle MIME parts.
 
-(defun notmuch-show-split-content-type (content-type)
-  (split-string content-type "/"))
-
 (defun notmuch-show-handlers-for (content-type)
   "Return a list of content handlers for a part of type CONTENT-TYPE."
   (let (result)
@@ -821,30 +796,11 @@ current buffer, if possible."
 	  (list (intern (concat "notmuch-show-insert-part-*/*"))
 		(intern (concat
 			 "notmuch-show-insert-part-"
-			 (car (notmuch-show-split-content-type content-type))
+			 (car (notmuch-split-content-type content-type))
 			 "/*"))
 		(intern (concat "notmuch-show-insert-part-" content-type))))
     result))
 
-;; Helper for parts which are generally not included in the default
-;; JSON output.
-(defun notmuch-show-get-bodypart-internal (message-id part-number)
-  (let ((args '("show" "--format=raw"))
-	(part-arg (format "--part=%s" part-number)))
-    (setq args (append args (list part-arg)))
-    (if notmuch-show-process-crypto
-	(setq args (append args '("--decrypt"))))
-    (setq args (append args (list message-id)))
-    (with-temp-buffer
-      (let ((coding-system-for-read 'no-conversion))
-	(progn
-	  (apply 'call-process (append (list notmuch-command nil (list t nil) nil) args))
-	  (buffer-string))))))
-
-(defun notmuch-show-get-bodypart-content (msg part nth)
-  (or (plist-get part :content)
-      (notmuch-show-get-bodypart-internal (concat "id:" (plist-get msg :id)) nth)))
-
 ;; 
 
 (defun notmuch-show-insert-bodypart-internal (msg part content-type nth depth declared-type)
@@ -876,7 +832,7 @@ current buffer, if possible."
   (make-symbol (concat "notmuch-show-" type)))
 
 (defun notmuch-show-strip-re (string)
-  (replace-regexp-in-string "\\([Rr]e: *\\)+" "" string))
+  (replace-regexp-in-string "^\\([Rr]e: *\\)+" "" string))
 
 (defvar notmuch-show-previous-subject "")
 (make-variable-buffer-local 'notmuch-show-previous-subject)
@@ -1015,9 +971,9 @@ current buffer, if possible."
   "Insert the message tree TREE at depth DEPTH in the current thread."
   (let ((msg (car tree))
 	(replies (cadr tree)))
-    (if (or (not notmuch-show-elide-non-matching-messages)
-	    (plist-get msg :match))
-	(notmuch-show-insert-msg msg depth))
+    ;; We test whether there is a message or just some replies.
+    (when msg
+      (notmuch-show-insert-msg msg depth))
     (notmuch-show-insert-thread replies (1+ depth))))
 
 (defun notmuch-show-insert-thread (thread depth)
@@ -1082,7 +1038,8 @@ function is used."
 	  notmuch-show-parent-buffer parent-buffer
 	  notmuch-show-query-context query-context)
     (notmuch-show-build-buffer)
-    (notmuch-show-goto-first-wanted-message)))
+    (notmuch-show-goto-first-wanted-message)
+    (current-buffer)))
 
 (defun notmuch-show-build-buffer ()
   (let ((inhibit-read-only t))
@@ -1098,21 +1055,25 @@ function is used."
 	     (args (if notmuch-show-query-context
 		       (append (list "\'") basic-args
 			       (list "and (" notmuch-show-query-context ")\'"))
-		     (append (list "\'") basic-args (list "\'")))))
-	(notmuch-show-insert-forest (notmuch-query-get-threads args))
+		     (append (list "\'") basic-args (list "\'"))))
+	     (cli-args (cons "--exclude=false"
+			     (when notmuch-show-elide-non-matching-messages
+			       (list "--entire-thread=false")))))
+
+	(notmuch-show-insert-forest (notmuch-query-get-threads (append cli-args args)))
 	;; If the query context reduced the results to nothing, run
 	;; the basic query.
 	(when (and (eq (buffer-size) 0)
 		   notmuch-show-query-context)
 	  (notmuch-show-insert-forest
-	   (notmuch-query-get-threads basic-args))))
+	   (notmuch-query-get-threads (append cli-args basic-args)))))
 
       (jit-lock-register #'notmuch-show-buttonise-links)
 
       (run-hooks 'notmuch-show-hook))
 
     ;; Set the header line to the subject of the first message.
-    (setq header-line-format (notmuch-show-strip-re (notmuch-show-get-pretty-subject)))))
+    (setq header-line-format (notmuch-show-strip-re (notmuch-show-get-subject)))))
 
 (defun notmuch-show-capture-state ()
   "Capture the state of the current buffer.
@@ -1364,16 +1325,16 @@ Some useful entries are:
     (plist-get props prop)))
 
 (defun notmuch-show-get-message-id (&optional bare)
-  "Return the Message-Id of the current message.
+  "Return an id: query for the Message-Id of the current message.
 
 If optional argument BARE is non-nil, return
-the Message-Id without prefix and quotes."
+the Message-Id without id: prefix and escaping."
   (if bare
       (notmuch-show-get-prop :id)
-    (concat "id:\"" (notmuch-show-get-prop :id) "\"")))
+    (notmuch-id-to-query (notmuch-show-get-prop :id))))
 
 (defun notmuch-show-get-messages-ids ()
-  "Return all message ids of messages in the current thread."
+  "Return all id: queries of messages in the current thread."
   (let ((message-ids))
     (notmuch-show-mapc
      (lambda () (push (notmuch-show-get-message-id) message-ids)))
@@ -1412,9 +1373,6 @@ current thread."
 (defun notmuch-show-get-depth ()
   (notmuch-show-get-prop :depth))
 
-(defun notmuch-show-get-pretty-subject ()
-  (notmuch-prettify-subject (notmuch-show-get-subject)))
-
 (defun notmuch-show-set-tags (tags)
   "Set the tags of the current message."
   (notmuch-show-set-prop :tags tags)
@@ -1433,14 +1391,15 @@ current thread."
   (notmuch-show-get-prop :headers-visible))
 
 (defun notmuch-show-mark-read ()
-  "Mark the current message as read."
-  (notmuch-show-tag-message "-unread"))
+  "Apply `notmuch-show-mark-read-tags' to the message."
+  (when notmuch-show-mark-read-tags
+    (apply 'notmuch-show-tag-message notmuch-show-mark-read-tags)))
 
 ;; Functions for getting attributes of several messages in the current
 ;; thread.
 
 (defun notmuch-show-get-message-ids-for-open-messages ()
-  "Return a list of all message IDs for open messages in the current thread."
+  "Return a list of all id: queries for open messages in the current thread."
   (save-excursion
     (let (message-ids done)
       (goto-char (point-min))
@@ -1484,6 +1443,11 @@ current window), advance to the next open message."
       ;; This is not the last message - move to the next visible one.
       (notmuch-show-next-open-message))
 
+     ((not (= (point) (point-max)))
+      ;; This is the last message, but the cursor is not at the end of
+      ;; the buffer. Move it there.
+      (goto-char (point-max)))
+
      (t
       ;; This is the last message - change the return value
       (setq ret t)))
@@ -1570,9 +1534,11 @@ thread, navigate to the next thread in the parent search buffer."
       (goto-char (point-max)))))
 
 (defun notmuch-show-previous-message ()
-  "Show the previous message."
+  "Show the previous message or the start of the current message."
   (interactive)
-  (notmuch-show-goto-message-previous)
+  (if (= (point) (notmuch-show-message-top))
+      (notmuch-show-goto-message-previous)
+    (notmuch-show-move-to-message-top))
   (notmuch-show-mark-read)
   (notmuch-show-message-adjust))
 
@@ -1608,6 +1574,11 @@ to show, nil otherwise."
 	  (notmuch-show-message-adjust))
       (goto-char (point-max)))))
 
+(defun notmuch-show-open-if-matched ()
+  "Open a message if it is matched (whether or not excluded)."
+  (let ((props (notmuch-show-get-message-properties)))
+    (notmuch-show-message-visible props (plist-get props :match))))
+
 (defun notmuch-show-goto-first-wanted-message ()
   "Move to the first open message and mark it read"
   (goto-char (point-min))
@@ -1615,14 +1586,21 @@ to show, nil otherwise."
       (notmuch-show-mark-read)
     (notmuch-show-next-open-message))
   (when (eobp)
+    ;; There are no matched non-excluded messages so open all matched
+    ;; (necessarily excluded) messages and go to the first.
+    (notmuch-show-mapc 'notmuch-show-open-if-matched)
+    (force-window-update)
     (goto-char (point-min))
-    (unless (notmuch-show-get-prop :match)
-      (notmuch-show-next-matching-message))))
+    (if (notmuch-show-message-visible-p)
+	(notmuch-show-mark-read)
+      (notmuch-show-next-open-message))))
 
 (defun notmuch-show-previous-open-message ()
   "Show the previous open message."
   (interactive)
-  (while (and (notmuch-show-goto-message-previous)
+  (while (and (if (= (point) (notmuch-show-message-top))
+		  (notmuch-show-goto-message-previous)
+		(notmuch-show-move-to-message-top))
 	      (not (notmuch-show-message-visible-p))))
   (notmuch-show-mark-read)
   (notmuch-show-message-adjust))
@@ -1652,7 +1630,7 @@ than only the current message."
   (let (shell-command)
     (if entire-thread
 	(setq shell-command
-	      (concat notmuch-command " show --format=mbox "
+	      (concat notmuch-command " show --format=mbox --exclude=false "
 		      (shell-quote-argument
 		       (mapconcat 'identity (notmuch-show-get-message-ids-for-open-messages) " OR "))
 		      " | " command))
@@ -1679,22 +1657,26 @@ TAG-CHANGES is a list of tag operations for `notmuch-tag'."
   (let* ((current-tags (notmuch-show-get-tags))
 	 (new-tags (notmuch-update-tags current-tags tag-changes)))
     (unless (equal current-tags new-tags)
-      (apply 'notmuch-tag (notmuch-show-get-message-id) tag-changes)
+      (funcall 'notmuch-tag (notmuch-show-get-message-id) tag-changes)
       (notmuch-show-set-tags new-tags))))
 
-(defun notmuch-show-tag (&optional initial-input)
-  "Change tags for the current message, read input from the minibuffer."
+(defun notmuch-show-tag (&optional tag-changes)
+  "Change tags for the current message.
+
+See `notmuch-tag' for information on the format of TAG-CHANGES."
   (interactive)
-  (let ((tag-changes (notmuch-read-tag-changes
-		      initial-input (notmuch-show-get-message-id))))
-    (apply 'notmuch-show-tag-message tag-changes)))
+  (setq tag-changes (funcall 'notmuch-tag (notmuch-show-get-message-id) tag-changes))
+  (let* ((current-tags (notmuch-show-get-tags))
+	 (new-tags (notmuch-update-tags current-tags tag-changes)))
+    (unless (equal current-tags new-tags)
+      (notmuch-show-set-tags new-tags))))
 
-(defun notmuch-show-tag-all (&rest tag-changes)
-  "Change tags for all messages in the current buffer.
+(defun notmuch-show-tag-all (&optional tag-changes)
+  "Change tags for all messages in the current show buffer.
 
-TAG-CHANGES is a list of tag operations for `notmuch-tag'."
-  (interactive (notmuch-read-tag-changes nil notmuch-show-thread-id))
-  (apply 'notmuch-tag (notmuch-show-get-messages-ids-search) tag-changes)
+See `notmuch-tag' for information on the format of TAG-CHANGES."
+  (interactive)
+  (setq tag-changes (funcall 'notmuch-tag (notmuch-show-get-messages-ids-search) tag-changes))
   (notmuch-show-mapc
    (lambda ()
      (let* ((current-tags (notmuch-show-get-tags))
@@ -1766,13 +1748,10 @@ argument, hide all of the messages."
 (defun notmuch-show-archive-thread (&optional unarchive)
   "Archive each message in thread.
 
-If a prefix argument is given, the messages will be
-\"unarchived\" (ie. the \"inbox\" tag will be added instead of
-removed).
-
 Archive each message currently shown by removing the \"inbox\"
-tag from each. Then kill this buffer and show the next thread
-from the search from which this thread was originally shown.
+tag from each.  If a prefix argument is given, the messages will
+be \"unarchived\" (ie. the \"inbox\" tag will be added instead of
+removed).
 
 Note: This command is safe from any race condition of new messages
 being delivered to the same thread. It does not archive the
@@ -1795,7 +1774,7 @@ buffer."
   (notmuch-show-next-thread))
 
 (defun notmuch-show-archive-message (&optional unarchive)
-  "Archive the current message.
+  "Archive the current message (remove \"inbox\" tag).
 
 If a prefix argument is given, the message will be
 \"unarchived\" (ie. the \"inbox\" tag will be added instead of
@@ -1844,7 +1823,7 @@ thread from search."
   (notmuch-common-do-stash (notmuch-show-get-from)))
 
 (defun notmuch-show-stash-message-id ()
-  "Copy message ID of current message to kill-ring."
+  "Copy id: query matching the current message to kill-ring."
   (interactive)
   (notmuch-common-do-stash (notmuch-show-get-message-id)))
 
@@ -1916,6 +1895,10 @@ the user (see `notmuch-show-stash-mlarchive-link-alist')."
   (interactive)
   (notmuch-show-part-button-internal button #'notmuch-show-interactively-view-part))
 
+(defun notmuch-show-part-button-pipe (&optional button)
+  (interactive)
+  (notmuch-show-part-button-internal button #'notmuch-show-pipe-part))
+
 (defun notmuch-show-part-button-internal (button handler)
   (let ((button (or button (button-at (point)))))
     (if button