emacs: wrap call-process

[notmuch] / emacs / notmuch-show.el

diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 939f8913f2508d5ff145bdbd6a1477fcf278fae4..ea20ddcef4d8fdb634c59dcaff3ff44a36dc818f 100644 (file)
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -59,6 +59,7 @@
 (defvar shr-blocked-images)
 (defvar gnus-blocked-images)
 (defvar shr-content-function)
 (defvar shr-blocked-images)
 (defvar gnus-blocked-images)
 (defvar shr-content-function)

+(defvar w3m-ignored-image-url-regexp)

 
 ;;; Options
 
 
 ;;; Options
 


@@ -179,6 +180,8 @@ indentation."
 
 (defvar-local notmuch-show-indent-content t)
 
 
 (defvar-local notmuch-show-indent-content t)
 

+(defvar-local notmuch-show-single-message nil)
+

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


@@ -276,7 +279,7 @@ position of the message in the thread."
        (let ((buf (generate-new-buffer (concat "*notmuch-msg-" id "*"))))
         (with-current-buffer buf
           (let ((coding-system-for-read 'no-conversion))
        (let ((buf (generate-new-buffer (concat "*notmuch-msg-" id "*"))))
         (with-current-buffer buf
           (let ((coding-system-for-read 'no-conversion))

-            (call-process notmuch-command nil t nil "show" "--format=raw" id))
+            (notmuch--call-process notmuch-command nil t nil "show" "--format=raw" id))

           ,@body)
         (kill-buffer buf)))))
 
           ,@body)
         (kill-buffer buf)))))
 


@@ -716,21 +719,23 @@ will return nil if the CID is unknown or cannot be retrieved."
   t)
 
 (defun notmuch-show-insert-part-message/rfc822 (msg part _content-type _nth depth _button)
   t)
 
 (defun notmuch-show-insert-part-message/rfc822 (msg part _content-type _nth depth _button)

-  (let* ((message (car (plist-get part :content)))
-        (body (car (plist-get message :body)))
-        (start (point)))
-    ;; Override `notmuch-message-headers' to force `From' to be
-    ;; displayed.
-    (let ((notmuch-message-headers '("From" "Subject" "To" "Cc" "Date")))
-      (notmuch-show-insert-headers (plist-get message :headers)))
-    ;; Blank line after headers to be compatible with the normal
-    ;; message display.
-    (insert "\n")
-    ;; Show the body
-    (notmuch-show-insert-bodypart msg body depth)
-    (when notmuch-show-indent-multipart
-      (indent-rigidly start (point) 1)))
-  t)
+  (let ((message (car (plist-get part :content))))
+    (and
+     message
+     (let ((body (car (plist-get message :body)))
+          (start (point)))
+       ;; Override `notmuch-message-headers' to force `From' to be
+       ;; displayed.
+       (let ((notmuch-message-headers '("From" "Subject" "To" "Cc" "Date")))
+        (notmuch-show-insert-headers (plist-get message :headers)))
+       ;; Blank line after headers to be compatible with the normal
+       ;; message display.
+       (insert "\n")
+       ;; Show the body
+       (notmuch-show-insert-bodypart msg body depth)
+       (when notmuch-show-indent-multipart
+        (indent-rigidly start (point) 1))
+       t))))

 
 (defun notmuch-show-insert-part-text/plain (msg part _content-type _nth depth button)
   ;; For backward compatibility we want to apply the text/plain hook
 
 (defun notmuch-show-insert-part-text/plain (msg part _content-type _nth depth button)
   ;; For backward compatibility we want to apply the text/plain hook


@@ -821,7 +826,8 @@ will return nil if the CID is unknown or cannot be retrieved."
     (let ((mm-inline-text-html-with-w3m-keymap nil)
          ;; FIXME: If we block an image, offer a button to load external
          ;; images.
     (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))
+         (gnus-blocked-images notmuch-show-text/html-blocked-images)
+         (w3m-ignored-image-url-regexp notmuch-show-text/html-blocked-images))

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


@@ -1315,9 +1321,10 @@ Apply the previously saved STATE if supplied, otherwise show the
 first relevant message.
 
 If no messages match the query return NIL."
 first relevant message.
 
 If no messages match the query return NIL."

-  (let* ((cli-args (cons "--exclude=false"
-                        (and notmuch-show-elide-non-matching-messages
-                             (list "--entire-thread=false"))))
+  (let* ((cli-args (list "--exclude=false"))
+        (cli-args (if notmuch-show-elide-non-matching-messages (cons "--entire-thread=false" cli-args) cli-args))
+        ;; "part 0 is the whole message (headers and body)" notmuch-show(1)
+        (cli-args (if notmuch-show-single-message (cons "--part=0" cli-args) cli-args))

         (queries (notmuch-show--build-queries
                   notmuch-show-thread-id notmuch-show-query-context))
         (forest nil)
         (queries (notmuch-show--build-queries
                   notmuch-show-thread-id notmuch-show-query-context))
         (forest nil)


@@ -1328,6 +1335,8 @@ If no messages match the query return NIL."
     (while (and (not forest) queries)
       (setq forest (notmuch-query-get-threads
                    (append cli-args (list "'") (car queries) (list "'"))))
     (while (and (not forest) queries)
       (setq forest (notmuch-query-get-threads
                    (append cli-args (list "'") (car queries) (list "'"))))

+      (when (and forest notmuch-show-single-message)
+       (setq forest (list (list (list forest)))))

       (setq queries (cdr queries)))
     (when forest
       (notmuch-show-insert-forest forest)
       (setq queries (cdr queries)))
     (when forest
       (notmuch-show-insert-forest forest)


@@ -2025,7 +2034,7 @@ to show, nil otherwise."
     (pop-to-buffer-same-window buf)
     (erase-buffer)
     (let ((coding-system-for-read 'no-conversion))
     (pop-to-buffer-same-window buf)
     (erase-buffer)
     (let ((coding-system-for-read 'no-conversion))

-      (call-process notmuch-command nil t nil "show" "--format=raw" id))
+      (notmuch--call-process notmuch-command nil t nil "show" "--format=raw" id))

     (goto-char (point-min))
     (set-buffer-modified-p nil)
     (setq buffer-read-only t)
     (goto-char (point-min))
     (set-buffer-modified-p nil)
     (setq buffer-read-only t)


@@ -2071,19 +2080,19 @@ message."
     (let ((cwd default-directory)
          (buf (get-buffer-create (concat "*notmuch-pipe*"))))
       (with-current-buffer buf
     (let ((cwd default-directory)
          (buf (get-buffer-create (concat "*notmuch-pipe*"))))
       (with-current-buffer buf

-       (setq buffer-read-only nil)
-       (erase-buffer)
-       ;; Use the originating buffer's working directory instead of
-       ;; that of the pipe buffer.
-       (cd cwd)
-       (let ((exit-code (call-process-shell-command shell-command nil buf)))
-         (goto-char (point-max))
-         (set-buffer-modified-p nil)
-         (setq buffer-read-only t)
-         (unless (zerop exit-code)
-           (pop-to-buffer buf)
-           (message (format "Command '%s' exited abnormally with code %d"
-                            shell-command exit-code))))))))
+       (setq buffer-read-only t)
+       (let ((inhibit-read-only t))
+         (erase-buffer)
+         ;; Use the originating buffer's working directory instead of
+         ;; that of the pipe buffer.
+         (cd cwd)
+         (let ((exit-code (notmuch--call-process-shell-command shell-command nil buf)))
+           (goto-char (point-max))
+           (set-buffer-modified-p nil)
+           (unless (zerop exit-code)
+             (pop-to-buffer buf)
+             (message (format "Command '%s' exited abnormally with code %d"
+                              shell-command exit-code)))))))))

 
 (defun notmuch-show-tag-message (&rest tag-changes)
   "Change tags for the current message.
 
 (defun notmuch-show-tag-message (&rest tag-changes)
   "Change tags for the current message.