emacs/show: Make the insertion of part headers overridable.

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

diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 793f1a5c1c9b6e2570e531049d80a4d6781225c0..ddb9c65c6d05c43319df0e08752f0f44bbdcffc9 100644 (file)
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -153,27 +153,21 @@ indentation."
 
 (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


@@ -927,6 +921,32 @@ will return nil if the CID is unknown or cannot be retrieved."
       ;; showable this returns nil.
       (notmuch-show-create-part-overlays button part-beg part-end))))
 
       ;; showable this returns nil.
       (notmuch-show-create-part-overlays button part-beg part-end))))
 

+(defun notmuch-show-mime-type (part)
+  "Return the correct mime-type to use for PART."
+  (let ((content-type (downcase (plist-get part :content-type))))
+    (or (and (string= content-type "application/octet-stream")
+            (notmuch-show-get-mime-type-of-application/octet-stream part))
+       (and (string= content-type "inline patch")
+            "text/x-diff")
+       content-type)))
+
+;; The following variable can be overridden by let bindings.
+(defvar notmuch-show-insert-header-p-function 'notmuch-show-insert-header-p
+  "Specify which function decides which part headers get inserted.
+
+The function should take two parameters, PART and HIDE, and
+should return non-NIL if a header button should be inserted for
+this part.")
+
+(defun notmuch-show-insert-header-p (part hide)
+  ;; Show all part buttons except for the first part if it is text/plain.
+  (let ((mime-type (notmuch-show-mime-type part)))
+    (not (and (string= mime-type "text/plain")
+             (<= (plist-get part :id) 1)))))
+
+(defun notmuch-show-reply-insert-header-p-never (part hide)
+  nil)
+

 (defun notmuch-show-insert-bodypart (msg part depth &optional hide)
   "Insert the body part PART at depth DEPTH in the current thread.
 
 (defun notmuch-show-insert-bodypart (msg part depth &optional hide)
   "Insert the body part PART at depth DEPTH in the current thread.
 


@@ -937,20 +957,16 @@ is t, hide the part initially and show the button. If HIDE is
 useful for quoting in replies)."
 
   (let* ((content-type (downcase (plist-get part :content-type)))
 useful for quoting in replies)."
 
   (let* ((content-type (downcase (plist-get part :content-type)))

-        (mime-type (or (and (string= content-type "application/octet-stream")
-                            (notmuch-show-get-mime-type-of-application/octet-stream part))
-                       (and (string= content-type "inline patch")
-                            "text/x-diff")
-                       content-type))
+        (mime-type (notmuch-show-mime-type part))

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

-        ;; 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)))
+        ;; This default header-p function omits the part button for
+        ;; the first (or only) part if this is text/plain.
+        (button (when (and (not (equal hide 'no-buttons))
+                    (funcall notmuch-show-insert-header-p-function part hide))

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


@@ -1197,71 +1213,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.


@@ -1320,17 +1366,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)))


@@ -1878,12 +1924,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