X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=emacs%2Fnotmuch-show.el;h=e0dce21070f6a8714484d3a7b40214b42bcbe9ea;hp=0b023a5c75d71130a0f702b9f0302a5b9fca5e9e;hb=af59d61a4c295a42038889a333fb39a8c05b6a91;hpb=d2684228847715d7616ef39a2744e84989fb05bd

diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 0b023a5c..e0dce210 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -126,6 +126,11 @@ indentation."
 		 (const :tag "View interactively"
 			notmuch-show-interactively-view-part)))
 
+(defcustom notmuch-show-only-matching-messages nil
+  "Only matching messages are shown by default."
+  :type 'boolean
+  :group 'notmuch-show)
+
 (defvar notmuch-show-thread-id nil)
 (make-variable-buffer-local 'notmuch-show-thread-id)
 (put 'notmuch-show-thread-id 'permanent-local t)
@@ -150,6 +155,35 @@ indentation."
 (make-variable-buffer-local 'notmuch-show-indent-content)
 (put 'notmuch-show-indent-content 'permanent-local t)
 
+(defcustom notmuch-show-stash-mlarchive-link-alist
+  '(("Gmane" . "http://mid.gmane.org/")
+    ("MARC" . "http://marc.info/?i=")
+    ("Mail Archive, The" . "http://mail-archive.com/search?l=mid&q=")
+    ;; FIXME: can these services be searched by `Message-Id' ?
+    ;; ("MarkMail" . "http://markmail.org/")
+    ;; ("Nabble" . "http://nabble.com/")
+    ;; ("opensubscriber" . "http://opensubscriber.com/")
+    )
+  "List of Mailing List Archives to use when stashing links.
+
+These URIs are concatenated with the current message's
+Message-Id in `notmuch-show-stash-mlarchive-link'."
+  :type '(alist :key-type (string :tag "Name")
+		:value-type (string :tag "URL"))
+  :group 'notmuch-show)
+
+(defcustom notmuch-show-stash-mlarchive-link-default "Gmane"
+  "Default Mailing List Archive to use when stashing links.
+
+This is used when `notmuch-show-stash-mlarchive-link' isn't
+provided with an MLA argument nor `completing-read' input."
+  :type `(choice
+	  ,@(mapcar
+	     (lambda (mla)
+	       (list 'const :tag (car mla) :value (car mla)))
+	     notmuch-show-stash-mlarchive-link-alist))
+  :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,7 +488,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)
@@ -502,36 +536,19 @@ current buffer, if possible."
 	;; 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))
+	  (insert (notmuch-get-bodypart-content msg part nth notmuch-show-process-crypto))
 	  (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-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,
@@ -596,8 +613,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
@@ -717,17 +734,17 @@ 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))
 	(run-hook-with-args 'notmuch-show-insert-text/plain-hook msg depth))))
   t)
 
-(defun notmuch-show-insert-part-text/x-vcalendar (msg part content-type nth depth declared-type)
+(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)
@@ -742,6 +759,10 @@ current buffer, if possible."
 	      result)))
   t)
 
+;; For backwards compatibility.
+(defun notmuch-show-insert-part-text/x-vcalendar (msg part content-type nth depth declared-type)
+  (notmuch-show-insert-part-text/calendar msg part content-type nth depth declared-type))
+
 (defun notmuch-show-insert-part-application/octet-stream (msg part content-type nth depth declared-type)
   ;; If we can deduce a MIME type from the filename of the attachment,
   ;; do so and pass it on to the handler for that type.
@@ -770,9 +791,6 @@ current buffer, if possible."
 
 ;; 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)
@@ -783,30 +801,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)
@@ -943,7 +942,8 @@ current buffer, if possible."
 
     ;; Message visibility depends on whether it matched the search
     ;; criteria.
-    (notmuch-show-message-visible msg (plist-get msg :match))))
+    (notmuch-show-message-visible msg (and (plist-get msg :match)
+					   (not (plist-get msg :excluded))))))
 
 (defun notmuch-show-toggle-process-crypto ()
   "Toggle the processing of cryptographic MIME parts."
@@ -952,7 +952,7 @@ current buffer, if possible."
   (message (if notmuch-show-process-crypto
 	       "Processing cryptographic MIME parts."
 	     "Not processing cryptographic MIME parts."))
-  (notmuch-show-refresh-view t))
+  (notmuch-show-refresh-view))
 
 (defun notmuch-show-toggle-elide-non-matching ()
   "Toggle the display of non-matching messages."
@@ -961,7 +961,7 @@ current buffer, if possible."
   (message (if notmuch-show-elide-non-matching-messages
 	       "Showing matching messages only."
 	     "Showing all messages."))
-  (notmuch-show-refresh-view t))
+  (notmuch-show-refresh-view))
 
 (defun notmuch-show-toggle-thread-indentation ()
   "Toggle the indentation of threads."
@@ -970,7 +970,7 @@ current buffer, if possible."
   (message (if notmuch-show-indent-content
 	       "Content is indented."
 	     "Content is not indented."))
-  (notmuch-show-refresh-view t))
+  (notmuch-show-refresh-view))
 
 (defun notmuch-show-insert-tree (tree depth)
   "Insert the message tree TREE at depth DEPTH in the current thread."
@@ -1032,13 +1032,20 @@ function is used."
     ;; Set the default value for `notmuch-show-process-crypto' in this
     ;; buffer.
     (setq notmuch-show-process-crypto notmuch-crypto-process-mime)
+    ;; Set the default value for
+    ;; `notmuch-show-elide-non-matching-messages' in this buffer. If
+    ;; there is a prefix argument, invert the default.
+    (setq notmuch-show-elide-non-matching-messages notmuch-show-only-matching-messages)
+    (if current-prefix-arg
+	(setq notmuch-show-elide-non-matching-messages (not notmuch-show-elide-non-matching-messages)))
 
     (setq notmuch-show-thread-id thread-id
 	  notmuch-show-parent-buffer parent-buffer
 	  notmuch-show-query-context query-context)
-    (notmuch-show-worker)))
+    (notmuch-show-build-buffer)
+    (notmuch-show-goto-first-wanted-message)))
 
-(defun notmuch-show-worker ()
+(defun notmuch-show-build-buffer ()
   (let ((inhibit-read-only t))
 
     (notmuch-show-mode)
@@ -1053,26 +1060,22 @@ function is used."
 		       (append (list "\'") basic-args
 			       (list "and (" notmuch-show-query-context ")\'"))
 		     (append (list "\'") basic-args (list "\'")))))
-	(notmuch-show-insert-forest (notmuch-query-get-threads args))
+	(notmuch-show-insert-forest (notmuch-query-get-threads
+				     (cons "--exclude=false" 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
+	    (cons "--exclude=false" basic-args)))))
 
       (jit-lock-register #'notmuch-show-buttonise-links)
 
       (run-hooks 'notmuch-show-hook))
 
-    ;; Move straight to the first open message
-    (unless (notmuch-show-message-visible-p)
-      (notmuch-show-next-open-message))
-
-    ;; Set the header line to the subject of the first open message.
-    (setq header-line-format (notmuch-show-strip-re (notmuch-show-get-pretty-subject)))
-
-    (notmuch-show-mark-read)))
+    ;; Set the header line to the subject of the first message.
+    (setq header-line-format (notmuch-show-strip-re (notmuch-show-get-subject)))))
 
 (defun notmuch-show-capture-state ()
   "Capture the state of the current buffer.
@@ -1107,21 +1110,24 @@ This includes:
       (message "Previously current message not found."))
     (notmuch-show-message-adjust)))
 
-(defun notmuch-show-refresh-view (&optional retain-state)
+(defun notmuch-show-refresh-view (&optional reset-state)
   "Refresh the current view.
 
 Refreshes the current view, observing changes in display
-preferences. If RETAIN-STATE is non-nil then the state of the
-buffer is stored and re-applied after the refresh."
-  (interactive)
+preferences. If invoked with a prefix argument (or RESET-STATE is
+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)
-	state)
-    (if retain-state
-	(setq state (notmuch-show-capture-state)))
+	(state (unless reset-state
+		 (notmuch-show-capture-state))))
     (erase-buffer)
-    (notmuch-show-worker)
+    (notmuch-show-build-buffer)
     (if state
-	(notmuch-show-apply-state state))))
+	(notmuch-show-apply-state state)
+      ;; We're resetting state, so navigate to the first open message
+      ;; and mark it read, just like opening a new show buffer.
+      (notmuch-show-goto-first-wanted-message))))
 
 (defvar notmuch-show-stash-map
   (let ((map (make-sparse-keymap)))
@@ -1134,6 +1140,8 @@ buffer is stored and re-applied after the refresh."
     (define-key map "s" 'notmuch-show-stash-subject)
     (define-key map "T" 'notmuch-show-stash-tags)
     (define-key map "t" 'notmuch-show-stash-to)
+    (define-key map "l" 'notmuch-show-stash-mlarchive-link)
+    (define-key map "L" 'notmuch-show-stash-mlarchive-link-and-go)
     map)
   "Submap for stash commands")
 (fset 'notmuch-show-stash-map notmuch-show-stash-map)
@@ -1318,12 +1326,17 @@ Some useful entries are:
 		   (notmuch-show-get-message-properties))))
     (plist-get props prop)))
 
-(defun notmuch-show-get-message-id ()
-  "Return the message id of the current message."
-  (concat "id:\"" (notmuch-show-get-prop :id) "\""))
+(defun notmuch-show-get-message-id (&optional bare)
+  "Return an id: query for the Message-Id of the current message.
+
+If optional argument BARE is non-nil, return
+the Message-Id without id: prefix and escaping."
+  (if bare
+      (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)))
@@ -1362,9 +1375,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)
@@ -1390,7 +1400,7 @@ current thread."
 ;; 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))
@@ -1434,6 +1444,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)))
@@ -1546,6 +1561,39 @@ to show, nil otherwise."
 	(goto-char (point-max))))
     r))
 
+(defun notmuch-show-next-matching-message ()
+  "Show the next matching message."
+  (interactive)
+  (let (r)
+    (while (and (setq r (notmuch-show-goto-message-next))
+		(not (notmuch-show-get-prop :match))))
+    (if r
+	(progn
+	  (notmuch-show-mark-read)
+	  (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))
+  (if (notmuch-show-message-visible-p)
+      (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))
+    (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)
@@ -1617,7 +1665,7 @@ TAG-CHANGES is a list of tag operations for `notmuch-tag'."
     (apply 'notmuch-show-tag-message tag-changes)))
 
 (defun notmuch-show-tag-all (&rest tag-changes)
-  "Change tags for all messages in the current thread.
+  "Change tags for all messages in the current buffer.
 
 TAG-CHANGES is a list of tag operations for `notmuch-tag'."
   (interactive (notmuch-read-tag-changes nil notmuch-show-thread-id))
@@ -1679,26 +1727,6 @@ argument, hide all of the messages."
   (interactive)
   (backward-button 1))
 
-(defun notmuch-show-tag-thread-internal (tag &optional remove)
-  "Add tag to the current set of messages.
-
-If the remove switch is given, tags will be removed instead of
-added."
-  (goto-char (point-min))
-  (let ((op (if remove "-" "+")))
-    (loop do (notmuch-show-tag-message (concat op tag))
-	  until (not (notmuch-show-goto-message-next)))))
-
-(defun notmuch-show-add-tag-thread (tag)
-  "Add tag to all messages in the current thread."
-  (interactive)
-  (notmuch-show-tag-thread-internal tag))
-
-(defun notmuch-show-remove-tag-thread (tag)
-  "Remove tag from all messages in the current thread."
-  (interactive)
-  (notmuch-show-tag-thread-internal tag t))
-
 (defun notmuch-show-next-thread (&optional show-next)
   "Move to the next item in the search results, if any."
   (interactive "P")
@@ -1726,18 +1754,17 @@ being delivered to the same thread. It does not archive the
 entire thread, but only the messages shown in the current
 buffer."
   (interactive "P")
-  (if unarchive
-      (notmuch-show-add-tag-thread "inbox")
-    (notmuch-show-remove-tag-thread "inbox")))
+  (let ((op (if unarchive "+" "-")))
+    (notmuch-show-tag-all (concat op "inbox"))))
 
 (defun notmuch-show-archive-thread-then-next ()
-  "Archive each message in thread, then show next thread from search."
+  "Archive all messages in the current buffer, then show next thread from search."
   (interactive)
   (notmuch-show-archive-thread)
   (notmuch-show-next-thread t))
 
 (defun notmuch-show-archive-thread-then-exit ()
-  "Archive each message in thread, then exit back to search results."
+  "Archive all messages in the current buffer, then exit back to search results."
   (interactive)
   (notmuch-show-archive-thread)
   (notmuch-show-next-thread))
@@ -1792,14 +1819,14 @@ 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)))
 
 (defun notmuch-show-stash-message-id-stripped ()
   "Copy message ID of current message (sans `id:' prefix) to kill-ring."
   (interactive)
-  (notmuch-common-do-stash (substring (notmuch-show-get-message-id) 4 -1)))
+  (notmuch-common-do-stash (notmuch-show-get-message-id t)))
 
 (defun notmuch-show-stash-subject ()
   "Copy Subject field of current message to kill-ring."
@@ -1816,6 +1843,36 @@ thread from search."
   (interactive)
   (notmuch-common-do-stash (notmuch-show-get-to)))
 
+(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.
+
+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-common-do-stash
+   (concat (cdr (assoc
+		 (or mla
+		     (let ((completion-ignore-case t))
+		       (completing-read
+			"Mailing List Archive: "
+			notmuch-show-stash-mlarchive-link-alist
+			nil t nil nil notmuch-show-stash-mlarchive-link-default)))
+		 notmuch-show-stash-mlarchive-link-alist))
+	   (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.
+
+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')."
+  (interactive)
+  (notmuch-show-stash-mlarchive-link mla)
+  (browse-url (current-kill 0 t)))
+
 ;; Commands typically bound to buttons.
 
 (defun notmuch-show-part-button-default (&optional button)