X-Git-Url: https://git.notmuchmail.org/git?a=blobdiff_plain;f=emacs%2Fnotmuch-lib.el;h=e09912d3174fbf45f089745e317e8350e0c6f364;hb=904ffbc9256db472abd34aa8e683c40067a42dd0;hp=e23999ad74a4dcbc29ec0c6fe0425c58b2c260a4;hpb=ced341e82e8cb84dc2c90187d208838335511f6e;p=notmuch diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el index e23999ad..e09912d3 100644 --- a/emacs/notmuch-lib.el +++ b/emacs/notmuch-lib.el @@ -800,20 +800,27 @@ You may need to restart Emacs or upgrade your notmuch Emacs package.")) Emacs requested a newer output format than supported by the notmuch CLI. You may need to restart Emacs or upgrade your notmuch package.")) (t - (let* ((command-string - (mapconcat (lambda (arg) - (shell-quote-argument - (cond ((stringp arg) arg) - ((symbolp arg) (symbol-name arg)) - (t "*UNKNOWN ARGUMENT*")))) - command " ")) - (extra - (concat "command: " command-string "\n" - (if (integerp exit-status) - (format "exit status: %s\n" exit-status) - (format "exit signal: %s\n" exit-status)) - (and err (concat "stderr:\n" err)) - (and output (concat "stdout:\n" output))))) + (pcase-let* + ((`(,command . ,args) command) + (command (if (equal (file-name-nondirectory command) + notmuch-command) + notmuch-command + command)) + (command-string + (mapconcat (lambda (arg) + (shell-quote-argument + (cond ((stringp arg) arg) + ((symbolp arg) (symbol-name arg)) + (t "*UNKNOWN ARGUMENT*")))) + (cons command args) + " ")) + (extra + (concat "command: " command-string "\n" + (if (integerp exit-status) + (format "exit status: %s\n" exit-status) + (format "exit signal: %s\n" exit-status)) + (and err (concat "stderr:\n" err)) + (and output (concat "stdout:\n" output))))) (if err ;; We have an error message straight from the CLI. (notmuch-logged-error @@ -821,7 +828,7 @@ You may need to restart Emacs or upgrade your notmuch package.")) ;; We only have combined output from the CLI; don't inundate ;; the user with it. Mimic `process-lines'. (notmuch-logged-error (format "%s exited with status %s" - (car command) exit-status) + command exit-status) extra)) ;; `notmuch-logged-error' does not return. )))) @@ -896,56 +903,29 @@ when the process exits, or nil for none. The caller must *not* invoke `set-process-sentinel' directly on the returned process, as that will interfere with the handling of stderr and the exit status." - (let (err-file err-buffer proc err-proc - ;; Find notmuch using Emacs' `exec-path' - (command (or (executable-find notmuch-command) - (error "Command not found: %s" notmuch-command)))) - (if (fboundp 'make-process) - (progn - (setq err-buffer (generate-new-buffer " *notmuch-stderr*")) - ;; Emacs 25 and newer has `make-process', which allows - ;; redirecting stderr independently from stdout to a - ;; separate buffer. As this allows us to avoid using a - ;; temporary file and shell invocation, use it when - ;; available. - (setq proc (make-process - :name name - :buffer buffer - :command (cons command args) - :connection-type 'pipe - :stderr err-buffer)) - (setq err-proc (get-buffer-process err-buffer)) - (process-put proc 'err-buffer err-buffer) - - (process-put err-proc 'err-file err-file) - (process-put err-proc 'err-buffer err-buffer) - (set-process-sentinel err-proc #'notmuch-start-notmuch-error-sentinel)) - ;; On Emacs versions before 25, there is no way to capture - ;; stdout and stderr separately for asynchronous processes, or - ;; even to redirect stderr to a file, so we use a trivial shell - ;; wrapper to send stderr to a temporary file and clean things - ;; up in the sentinel. - (setq err-file (make-temp-file "nmerr")) - (let ((process-connection-type nil)) ;; Use a pipe - (setq proc (apply #'start-process name buffer - "/bin/sh" "-c" - "exec 2>\"$1\"; shift; exec \"$0\" \"$@\"" - command err-file args))) - (process-put proc 'err-file err-file)) + (let* ((command (or (executable-find notmuch-command) + (error "Command not found: %s" notmuch-command))) + (err-buffer (generate-new-buffer " *notmuch-stderr*")) + (proc (make-process + :name name + :buffer buffer + :command (cons command args) + :connection-type 'pipe + :stderr err-buffer)) + (err-proc (get-buffer-process err-buffer))) + (process-put proc 'err-buffer err-buffer) (process-put proc 'sub-sentinel sentinel) - (process-put proc 'real-command (cons notmuch-command args)) (set-process-sentinel proc #'notmuch-start-notmuch-sentinel) + (set-process-sentinel err-proc #'notmuch-start-notmuch-error-sentinel) proc)) (defun notmuch-start-notmuch-sentinel (proc event) "Process sentinel function used by `notmuch-start-notmuch'." - (let* ((err-file (process-get proc 'err-file)) - (err-buffer (or (process-get proc 'err-buffer) - (find-file-noselect err-file))) - (err (and (not (zerop (buffer-size err-buffer))) + (let* ((err-buffer (process-get proc 'err-buffer)) + (err (and (buffer-live-p err-buffer) + (not (zerop (buffer-size err-buffer))) (with-current-buffer err-buffer (buffer-string)))) - (sub-sentinel (process-get proc 'sub-sentinel)) - (real-command (process-get proc 'real-command))) + (sub-sentinel (process-get proc 'sub-sentinel))) (condition-case err (progn ;; Invoke the sub-sentinel, if any @@ -957,7 +937,7 @@ status." ;; and there's no point in telling the user that (but we ;; still check for and report stderr output below). (when (buffer-live-p (process-buffer proc)) - (notmuch-check-async-exit-status proc event real-command err)) + (notmuch-check-async-exit-status proc event nil err)) ;; If that didn't signal an error, then any error output was ;; really warning output. Show warnings, if any. (let ((warnings @@ -977,16 +957,12 @@ status." (error ;; Emacs behaves strangely if an error escapes from a sentinel, ;; so turn errors into messages. - (message "%s" (error-message-string err)))) - (when err-file (ignore-errors (delete-file err-file))))) + (message "%s" (error-message-string err)))))) (defun notmuch-start-notmuch-error-sentinel (proc event) - (let* ((err-file (process-get proc 'err-file)) - ;; When `make-process' is available, use the error buffer - ;; associated with the process, otherwise the error file. - (err-buffer (or (process-get proc 'err-buffer) - (find-file-noselect err-file)))) - (when err-buffer (kill-buffer err-buffer)))) + (let ((buffer (process-buffer proc))) + (when (buffer-live-p buffer) + (kill-buffer buffer)))) (defvar-local notmuch-show-process-crypto nil)