emacs: wrap call-process-region

As with notmuch--process-lines, initial purpose is to provide a safe
binding for default-directory. This is enough to make notmuch-hello
robust against non-existent or corrupt values default-directory, but
probably not other views.
This commit is contained in:
David Bremner 2021-08-29 12:23:30 -07:00
parent a890241138
commit 5e5f2122f9
4 changed files with 11 additions and 4 deletions

View file

@ -569,7 +569,7 @@ options will be handled as specified for
(or (plist-get options :filter-count) (or (plist-get options :filter-count)
(plist-get options :filter)))) (plist-get options :filter))))
"\n"))) "\n")))
(unless (= (call-process-region (point-min) (point-max) notmuch-command (unless (= (notmuch--call-process-region (point-min) (point-max) notmuch-command
t t nil "count" "--batch") 0) t t nil "count" "--batch") 0)
(notmuch-logged-error (notmuch-logged-error
"notmuch count --batch failed" "notmuch count --batch failed"

View file

@ -869,6 +869,14 @@ You may need to restart Emacs or upgrade your notmuch package."))
default" default"
(notmuch--apply-with-env #'process-lines program args)) (notmuch--apply-with-env #'process-lines program args))
(defun notmuch--call-process-region (start end program
&optional delete buffer display
&rest args)
"Wrap call-process-region, binding DEFAULT-DIRECTORY to a safe
default"
(notmuch--apply-with-env
#'call-process-region start end program delete buffer display args))
(defun notmuch-call-notmuch--helper (destination args) (defun notmuch-call-notmuch--helper (destination args)
"Helper for synchronous notmuch invocation commands. "Helper for synchronous notmuch invocation commands.
@ -885,7 +893,7 @@ for `call-process'. ARGS is as described for
(if (null stdin-string) (if (null stdin-string)
(apply #'call-process notmuch-command nil destination nil args) (apply #'call-process notmuch-command nil destination nil args)
(insert stdin-string) (insert stdin-string)
(apply #'call-process-region (point-min) (point-max) (apply #'notmuch--call-process-region (point-min) (point-max)
notmuch-command t destination nil args)))) notmuch-command t destination nil args))))
(defun notmuch-call-notmuch-process (&rest args) (defun notmuch-call-notmuch-process (&rest args)

View file

@ -48,7 +48,7 @@
"Pass the contents of the current buffer to 'muttprint'. "Pass the contents of the current buffer to 'muttprint'.
Optional OUTPUT allows passing a list of flags to muttprint." Optional OUTPUT allows passing a list of flags to muttprint."
(apply #'call-process-region (point-min) (point-max) (apply #'notmuch--call-process-region (point-min) (point-max)
;; Reads from stdin. ;; Reads from stdin.
"muttprint" "muttprint"
nil nil nil nil nil nil

View file

@ -69,7 +69,6 @@ notmuch tag -$tag '*'
test_expect_equal_file $EXPECTED/notmuch-hello-long-names OUTPUT test_expect_equal_file $EXPECTED/notmuch-hello-long-names OUTPUT
test_begin_subtest "notmuch-hello with nonexistent CWD" test_begin_subtest "notmuch-hello with nonexistent CWD"
test_subtest_known_broken
test_emacs ' test_emacs '
(notmuch-hello) (notmuch-hello)
(test-log-error (test-log-error