emacs: Report a lack of matches when calling `notmuch-show'.

[notmuch.git] / emacs / notmuch-show.el

diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 66350d436470ffa24d543370490c33980997293d..4629c64b11fd151448872b24d882086cc89ec6ad 100644 (file)
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -47,6 +47,7 @@
 (declare-function notmuch-tree "notmuch-tree"
                  (&optional query query-context target buffer-name open-target))
 (declare-function notmuch-tree-get-message-properties "notmuch-tree" nil)
 (declare-function notmuch-tree "notmuch-tree"
                  (&optional query query-context target buffer-name open-target))
 (declare-function notmuch-tree-get-message-properties "notmuch-tree" nil)

+(declare-function notmuch-read-query "notmuch" (prompt))

 
 (defcustom notmuch-message-headers '("Subject" "To" "Cc" "Date")
   "Headers that should be shown in a message, in this order.
 
 (defcustom notmuch-message-headers '("Subject" "To" "Cc" "Date")
   "Headers that should be shown in a message, in this order.


@@ -99,6 +100,13 @@ visible for any given message."
   :group 'notmuch-show
   :group 'notmuch-hooks)
 
   :group 'notmuch-show
   :group 'notmuch-hooks)
 

+(defcustom notmuch-show-max-text-part-size 100000
+  "Maximum size of a text part to be shown by default in characters.
+
+Set to 0 to show the part regardless of size."
+  :type 'integer
+  :group 'notmuch-show)
+

 ;; Mostly useful for debugging.
 (defcustom notmuch-show-all-multipart/alternative-parts nil
   "Should all parts of multipart/alternative parts be shown?"
 ;; Mostly useful for debugging.
 (defcustom notmuch-show-all-multipart/alternative-parts nil
   "Should all parts of multipart/alternative parts be shown?"


@@ -136,29 +144,30 @@ indentation."
   :type 'boolean
   :group 'notmuch-show)
 
   :type 'boolean
   :group 'notmuch-show)
 

+;; By default, block all external images to prevent privacy leaks and
+;; potential attacks.
+(defcustom notmuch-show-text/html-blocked-images "."
+  "Remote images that have URLs matching this regexp will be blocked."
+  :type '(choice (const nil) regexp)
+  :group 'notmuch-show)
+

 (defvar notmuch-show-thread-id nil)
 (make-variable-buffer-local 'notmuch-show-thread-id)
 (defvar notmuch-show-thread-id nil)
 (make-variable-buffer-local 'notmuch-show-thread-id)

-(put 'notmuch-show-thread-id 'permanent-local t)

 
 (defvar notmuch-show-parent-buffer nil)
 (make-variable-buffer-local 'notmuch-show-parent-buffer)
 
 (defvar notmuch-show-parent-buffer nil)
 (make-variable-buffer-local 'notmuch-show-parent-buffer)

-(put 'notmuch-show-parent-buffer 'permanent-local t)

 
 (defvar notmuch-show-query-context nil)
 (make-variable-buffer-local 'notmuch-show-query-context)
 
 (defvar notmuch-show-query-context nil)
 (make-variable-buffer-local 'notmuch-show-query-context)

-(put 'notmuch-show-query-context 'permanent-local t)

 
 (defvar notmuch-show-process-crypto nil)
 (make-variable-buffer-local 'notmuch-show-process-crypto)
 
 (defvar notmuch-show-process-crypto nil)
 (make-variable-buffer-local 'notmuch-show-process-crypto)

-(put 'notmuch-show-process-crypto 'permanent-local t)

 
 (defvar notmuch-show-elide-non-matching-messages nil)
 (make-variable-buffer-local 'notmuch-show-elide-non-matching-messages)
 
 (defvar notmuch-show-elide-non-matching-messages nil)
 (make-variable-buffer-local 'notmuch-show-elide-non-matching-messages)

-(put 'notmuch-show-elide-non-matching-messages 'permanent-local t)

 
 (defvar notmuch-show-indent-content t)
 (make-variable-buffer-local 'notmuch-show-indent-content)
 
 (defvar notmuch-show-indent-content t)
 (make-variable-buffer-local 'notmuch-show-indent-content)

-(put 'notmuch-show-indent-content 'permanent-local t)

 
 (defvar notmuch-show-attachment-debug nil
   "If t log stdout and stderr from attachment handlers
 
 (defvar notmuch-show-attachment-debug nil
   "If t log stdout and stderr from attachment handlers


@@ -338,8 +347,6 @@ operation on the contents of the current buffer."
                'message-header-cc)
               ((looking-at "[Ss]ubject:")
                'message-header-subject)
                'message-header-cc)
               ((looking-at "[Ss]ubject:")
                'message-header-subject)

-              ((looking-at "[Ff]rom:")
-               'message-header-from)

               (t
                'message-header-other))))
 
               (t
                'message-header-other))))
 


@@ -771,14 +778,21 @@ will return nil if the CID is unknown or cannot be retrieved."
       ;; It's easier to drive shr ourselves than to work around the
       ;; goofy things `mm-shr' does (like irreversibly taking over
       ;; content ID handling).
       ;; It's easier to drive shr ourselves than to work around the
       ;; goofy things `mm-shr' does (like irreversibly taking over
       ;; content ID handling).

-      (notmuch-show--insert-part-text/html-shr msg part)
+
+      ;; FIXME: If we block an image, offer a button to load external
+      ;; images.
+      (let ((shr-blocked-images notmuch-show-text/html-blocked-images))
+       (notmuch-show--insert-part-text/html-shr msg part))

     ;; Otherwise, let message-mode do the heavy lifting
     ;;
     ;; w3m sets up a keymap which "leaks" outside the invisible region
     ;; and causes strange effects in notmuch. We set
     ;; mm-inline-text-html-with-w3m-keymap to nil to tell w3m not to
     ;; set a keymap (so the normal notmuch-show-mode-map remains).
     ;; Otherwise, let message-mode do the heavy lifting
     ;;
     ;; w3m sets up a keymap which "leaks" outside the invisible region
     ;; and causes strange effects in notmuch. We set
     ;; mm-inline-text-html-with-w3m-keymap to nil to tell w3m not to
     ;; set a keymap (so the normal notmuch-show-mode-map remains).

-    (let ((mm-inline-text-html-with-w3m-keymap nil))
+    (let ((mm-inline-text-html-with-w3m-keymap nil)
+         ;; FIXME: If we block an image, offer a button to load external
+         ;; images.
+         (gnus-blocked-images notmuch-show-text/html-blocked-images))

       (notmuch-show-insert-part-*/* msg part content-type nth depth button))))
 
 ;; These functions are used by notmuch-show--insert-part-text/html-shr
       (notmuch-show-insert-part-*/* msg part content-type nth depth button))))
 
 ;; These functions are used by notmuch-show--insert-part-text/html-shr


@@ -797,11 +811,7 @@ will return nil if the CID is unknown or cannot be retrieved."
           ;; shr strips the "cid:" part of URL, but doesn't
           ;; URL-decode it (see RFC 2392).
           (let ((cid (url-unhex-string url)))
           ;; shr strips the "cid:" part of URL, but doesn't
           ;; URL-decode it (see RFC 2392).
           (let ((cid (url-unhex-string url)))

-            (first (notmuch-show--get-cid-content cid)))))
-       ;; Block all external images to prevent privacy leaks and
-       ;; potential attacks.  FIXME: If we block an image, offer a
-       ;; button to load external images.
-       (shr-blocked-images "."))
+            (first (notmuch-show--get-cid-content cid))))))

     (shr-insert-document dom)
     t))
 
     (shr-insert-document dom)
     t))
 


@@ -927,14 +937,20 @@ useful for quoting in replies)."
                             "text/x-diff")
                        content-type))
         (nth (plist-get part :id))
                             "text/x-diff")
                        content-type))
         (nth (plist-get part :id))

+        (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)))

         (beg (point))
         (beg (point))

-        ;; Hide the part initially if HIDE is t.
-        (show-part (not (equal hide t)))

         ;; We omit the part button for the first (or only) part if
         ;; this is text/plain, or HIDE is 'no-buttons.
         (button (unless (or (equal hide 'no-buttons)
                             (and (string= mime-type "text/plain") (<= nth 1)))
                   (notmuch-show-insert-part-header nth mime-type content-type (plist-get part :filename))))
         ;; We omit the part button for the first (or only) part if
         ;; this is text/plain, or HIDE is 'no-buttons.
         (button (unless (or (equal hide 'no-buttons)
                             (and (string= mime-type "text/plain") (<= nth 1)))
                   (notmuch-show-insert-part-header nth mime-type content-type (plist-get part :filename))))

+        ;; Hide the part initially if HIDE is t, or if it is too long
+        ;; and we have a button to allow toggling (thus reply which
+        ;; uses 'no-buttons automatically includes long parts)
+        (show-part (not (or (equal hide t)
+                            (and long button))))

         (content-beg (point)))
 
     ;; Store the computed mime-type for later use (e.g. by attachment handlers).
         (content-beg (point)))
 
     ;; Store the computed mime-type for later use (e.g. by attachment handlers).


@@ -1175,71 +1191,101 @@ non-nil.
 The optional BUFFER-NAME provides the name of the buffer in
 which the message thread is shown. If it is nil (which occurs
 when the command is called interactively) the argument to the
 The optional BUFFER-NAME provides the name of the buffer in
 which the message thread is shown. If it is nil (which occurs
 when the command is called interactively) the argument to the

-function is used."
+function is used.
+
+Returns the buffer containing the messages, or NIL if no messages
+matched."

   (interactive "sNotmuch show: \nP")
   (let ((buffer-name (generate-new-buffer-name
                      (or buffer-name
                          (concat "*notmuch-" thread-id "*")))))
     (switch-to-buffer (get-buffer-create buffer-name))
   (interactive "sNotmuch show: \nP")
   (let ((buffer-name (generate-new-buffer-name
                      (or buffer-name
                          (concat "*notmuch-" thread-id "*")))))
     (switch-to-buffer (get-buffer-create buffer-name))

-    ;; 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
-    ;; elide-toggle is set, invert the default.
-    (setq notmuch-show-elide-non-matching-messages notmuch-show-only-matching-messages)
-    (if elide-toggle
-       (setq notmuch-show-elide-non-matching-messages (not notmuch-show-elide-non-matching-messages)))
+    ;; No need to track undo information for this buffer.
+    (setq buffer-undo-list t)

 
 

+    (notmuch-show-mode)
+
+    ;; Set various buffer local variables to their appropriate initial
+    ;; state. Do this after enabling `notmuch-show-mode' so that they
+    ;; aren't wiped out.

     (setq notmuch-show-thread-id thread-id
          notmuch-show-parent-buffer parent-buffer
     (setq notmuch-show-thread-id thread-id
          notmuch-show-parent-buffer parent-buffer

-         notmuch-show-query-context query-context)
-    (notmuch-show-build-buffer)
-    (notmuch-show-goto-first-wanted-message)
-    (current-buffer)))
+         notmuch-show-query-context query-context

 
 

-(defun notmuch-show-build-buffer ()
-  (let ((inhibit-read-only t))
+         notmuch-show-process-crypto notmuch-crypto-process-mime
+         ;; If `elide-toggle', invert the default value.
+         notmuch-show-elide-non-matching-messages
+         (if elide-toggle
+             (not notmuch-show-only-matching-messages)
+           notmuch-show-only-matching-messages))

 
 

-    (notmuch-show-mode)

     (add-hook 'post-command-hook #'notmuch-show-command-hook nil t)
     (add-hook 'post-command-hook #'notmuch-show-command-hook nil t)

-
-    ;; Don't track undo information for this buffer
-    (set 'buffer-undo-list t)
+    (jit-lock-register #'notmuch-show-buttonise-links)

 
     (notmuch-tag-clear-cache)
 
     (notmuch-tag-clear-cache)

-    (erase-buffer)
-    (goto-char (point-min))
-    (save-excursion
-      (let* ((basic-args (list notmuch-show-thread-id))
-            (args (if notmuch-show-query-context
-                      (append (list "\'") basic-args
-                              (list "and (" notmuch-show-query-context ")\'"))
-                    (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 (append cli-args basic-args)))))
-
-      (jit-lock-register #'notmuch-show-buttonise-links)
-
-      (notmuch-show-mapc (lambda () (notmuch-show-set-prop :orig-tags (notmuch-show-get-tags))))
+
+    (let ((inhibit-read-only t))
+      (if (notmuch-show--build-buffer)
+         ;; Messages were inserted into the buffer.
+         (current-buffer)
+
+       ;; No messages were inserted - presumably none matched the
+       ;; query.
+       (kill-buffer (current-buffer))
+       (ding)
+       (message "No messages matched the query!")
+       nil))))
+
+(defun notmuch-show--build-buffer (&optional state)
+  "Display messages matching the current buffer context.
+
+Apply the previously saved STATE if supplied, otherwise show the
+first relevant message.
+
+If no messages match the query return NIL."
+  (let* ((basic-args (list notmuch-show-thread-id))
+        (args (if notmuch-show-query-context
+                  (append (list "\'") basic-args
+                          (list "and (" notmuch-show-query-context ")\'"))
+                (append (list "\'") basic-args (list "\'"))))
+        (cli-args (cons "--exclude=false"
+                        (when notmuch-show-elide-non-matching-messages
+                          (list "--entire-thread=false"))))
+
+        (forest (or (notmuch-query-get-threads (append cli-args args))
+                    ;; If a query context reduced the number of
+                    ;; results to zero, try again without it.
+                    (and notmuch-show-query-context
+                         (notmuch-query-get-threads (append cli-args basic-args)))))
+
+        ;; Must be reset every time we are going to start inserting
+        ;; messages into the buffer.
+        (notmuch-show-previous-subject ""))
+
+    (when forest
+      (notmuch-show-insert-forest forest)
+
+      ;; Store the original tags for each message so that we can
+      ;; display changes.
+      (notmuch-show-mapc
+       (lambda () (notmuch-show-set-prop :orig-tags (notmuch-show-get-tags))))

 
       ;; Set the header line to the subject of the first message.
       (setq header-line-format
            (replace-regexp-in-string "%" "%%"
 
       ;; Set the header line to the subject of the first message.
       (setq header-line-format
            (replace-regexp-in-string "%" "%%"

-                           (notmuch-sanitize
-                            (notmuch-show-strip-re
-                             (notmuch-show-get-subject)))))
+                                     (notmuch-sanitize
+                                      (notmuch-show-strip-re
+                                       (notmuch-show-get-subject)))))
+
+      (run-hooks 'notmuch-show-hook)

 
 

-      (run-hooks 'notmuch-show-hook))))
+      (if state
+         (notmuch-show-apply-state state)
+       ;; With no state to apply, just go to the first message.
+       (notmuch-show-goto-first-wanted-message)))
+
+    ;; Report back to the caller whether any messages matched.
+    forest))

 
 (defun notmuch-show-capture-state ()
   "Capture the state of the current buffer.
 
 (defun notmuch-show-capture-state ()
   "Capture the state of the current buffer.


@@ -1258,6 +1304,16 @@ This includes:
              ")")
     notmuch-show-thread-id))
 
              ")")
     notmuch-show-thread-id))
 

+(defun notmuch-show-goto-message (msg-id)
+  "Go to message with msg-id."
+  (goto-char (point-min))
+  (unless (loop if (string= msg-id (notmuch-show-get-message-id))
+               return t
+               until (not (notmuch-show-goto-message-next)))
+    (goto-char (point-min))
+    (message "Message-id not found."))
+  (notmuch-show-message-adjust))
+

 (defun notmuch-show-apply-state (state)
   "Apply STATE to the current buffer.
 
 (defun notmuch-show-apply-state (state)
   "Apply STATE to the current buffer.
 


@@ -1275,13 +1331,7 @@ This includes:
          until (not (notmuch-show-goto-message-next)))
 
     ;; Go to the previously open message.
          until (not (notmuch-show-goto-message-next)))
 
     ;; Go to the previously open message.

-    (goto-char (point-min))
-    (unless (loop if (string= current (notmuch-show-get-message-id))
-                 return t
-                 until (not (notmuch-show-goto-message-next)))
-      (goto-char (point-min))
-      (message "Previously current message not found."))
-    (notmuch-show-message-adjust)))
+    (notmuch-show-goto-message current)))

 
 (defun notmuch-show-refresh-view (&optional reset-state)
   "Refresh the current view.
 
 (defun notmuch-show-refresh-view (&optional reset-state)
   "Refresh the current view.


@@ -1294,17 +1344,17 @@ reset based on the original query."
   (let ((inhibit-read-only t)
        (state (unless reset-state
                 (notmuch-show-capture-state))))
   (let ((inhibit-read-only t)
        (state (unless reset-state
                 (notmuch-show-capture-state))))

-    ;; erase-buffer does not seem to remove overlays, which can lead
+    ;; `erase-buffer' does not seem to remove overlays, which can lead

     ;; to weird effects such as remaining images, so remove them
     ;; manually.
     (remove-overlays)
     (erase-buffer)
     ;; to weird effects such as remaining images, so remove them
     ;; manually.
     (remove-overlays)
     (erase-buffer)

-    (notmuch-show-build-buffer)
-    (if 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))))
+
+    (unless (notmuch-show--build-buffer state)
+      ;; No messages were inserted.
+      (kill-buffer (current-buffer))
+      (ding)
+      (message "Refreshing the buffer resulted in no messages!"))))

 
 (defvar notmuch-show-stash-map
   (let ((map (make-sparse-keymap)))
 
 (defvar notmuch-show-stash-map
   (let ((map (make-sparse-keymap)))


@@ -1345,6 +1395,7 @@ reset based on the original query."
     (define-key map (kbd "<backtab>") 'notmuch-show-previous-button)
     (define-key map (kbd "TAB") 'notmuch-show-next-button)
     (define-key map "f" 'notmuch-show-forward-message)
     (define-key map (kbd "<backtab>") 'notmuch-show-previous-button)
     (define-key map (kbd "TAB") 'notmuch-show-next-button)
     (define-key map "f" 'notmuch-show-forward-message)

+    (define-key map "l" 'notmuch-show-filter-thread)

     (define-key map "r" 'notmuch-show-reply-sender)
     (define-key map "R" 'notmuch-show-reply)
     (define-key map "|" 'notmuch-show-pipe-message)
     (define-key map "r" 'notmuch-show-reply-sender)
     (define-key map "R" 'notmuch-show-reply)
     (define-key map "|" 'notmuch-show-pipe-message)


@@ -1633,6 +1684,16 @@ user decision and we should not override it."
     (save-excursion
       (funcall notmuch-show-mark-read-function (window-start) (window-end)))))
 
     (save-excursion
       (funcall notmuch-show-mark-read-function (window-start) (window-end)))))
 

+(defun notmuch-show-filter-thread (query)
+  "Filter or LIMIT the current thread based on a new query string.
+
+Reshows the current thread with matches defined by the new query-string."
+  (interactive (list (notmuch-read-query "Filter thread: ")))
+  (let ((msg-id (notmuch-show-get-message-id)))
+    (setq notmuch-show-query-context (if (string= query "") nil query))
+    (notmuch-show-refresh-view t)
+    (notmuch-show-goto-message msg-id)))
+

 ;; Functions for getting attributes of several messages in the current
 ;; thread.
 
 ;; Functions for getting attributes of several messages in the current
 ;; thread.
 


@@ -1841,12 +1902,15 @@ to show, nil otherwise."
   "View the original source of the current message."
   (interactive)
   (let* ((id (notmuch-show-get-message-id))
   "View the original source of the current message."
   (interactive)
   (let* ((id (notmuch-show-get-message-id))

-        (buf (get-buffer-create (concat "*notmuch-raw-" id "*"))))
-    (let ((coding-system-for-read 'no-conversion))
-      (call-process notmuch-command nil buf nil "show" "--format=raw" id))
+        (buf (get-buffer-create (concat "*notmuch-raw-" id "*")))
+        (inhibit-read-only t))

     (switch-to-buffer buf)
     (switch-to-buffer buf)

+    (erase-buffer)
+    (let ((coding-system-for-read 'no-conversion))
+      (call-process notmuch-command nil t nil "show" "--format=raw" id))

     (goto-char (point-min))
     (set-buffer-modified-p nil)
     (goto-char (point-min))
     (set-buffer-modified-p nil)

+    (setq buffer-read-only t)

     (view-buffer buf 'kill-buffer-if-not-modified)))
 
 (put 'notmuch-show-pipe-message 'notmuch-doc
     (view-buffer buf 'kill-buffer-if-not-modified)))
 
 (put 'notmuch-show-pipe-message 'notmuch-doc