X-Git-Url: https://git.notmuchmail.org/git?a=blobdiff_plain;f=emacs%2Fnotmuch-lib.el;h=45817e1311dc7d4f4940e8573a924e05f7d9f10e;hb=e722b4f4;hp=3add992b46f1dbe4479f48576a77297b8d322da1;hpb=16b2db0986ce0ed7c420a69d0a98bb41e9ca4bd8;p=notmuch diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el index 3add992b..45817e13 100644 --- a/emacs/notmuch-lib.el +++ b/emacs/notmuch-lib.el @@ -22,6 +22,8 @@ ;;; Code: (require 'cl-lib) +(require 'pcase) +(require 'subr-x) (require 'mm-util) (require 'mm-view) @@ -101,6 +103,7 @@ search results. Note that any filtered searches created by search." :type 'boolean :group 'notmuch-search) +(make-variable-buffer-local 'notmuch-search-oldest-first) (defcustom notmuch-poll-script nil "[Deprecated] Command to run to incorporate new mail into the notmuch database. @@ -192,7 +195,7 @@ will be signaled. Otherwise the output will be returned." (with-temp-buffer - (let ((status (apply #'call-process notmuch-command nil t nil args)) + (let ((status (apply #'notmuch--call-process notmuch-command nil t nil args)) (output (buffer-string))) (notmuch-check-exit-status status (cons notmuch-command args) output) output))) @@ -203,7 +206,7 @@ Otherwise the output will be returned." (defun notmuch-cli-sane-p () "Return t if the cli seems to be configured sanely." (unless notmuch--cli-sane-p - (let ((status (call-process notmuch-command nil nil nil + (let ((status (notmuch--call-process notmuch-command nil nil nil "config" "get" "user.primary_email"))) (setq notmuch--cli-sane-p (= status 0)))) notmuch--cli-sane-p) @@ -247,7 +250,7 @@ displays both values separately." (let* ((val (notmuch-command-to-string "config" "get" item)) (len (length val))) ;; Trim off the trailing newline (if the value is empty or not - ;; configured, there will be no newline) + ;; configured, there will be no newline). (if (and (> len 0) (= (aref val (- len 1)) ?\n)) (substring val 0 -1) @@ -282,8 +285,8 @@ depending on the value of `notmuch-poll-script'." (interactive) (message "Polling mail...") (if (stringp notmuch-poll-script) - (unless (string= notmuch-poll-script "") - (unless (equal (call-process notmuch-poll-script nil nil) 0) + (unless (string-empty-p notmuch-poll-script) + (unless (equal (notmuch--call-process notmuch-poll-script nil nil) 0) (error "Notmuch: poll script `%s' failed!" notmuch-poll-script))) (notmuch-call-notmuch-process "new")) (message "Polling mail...done")) @@ -415,9 +418,9 @@ A command that supports a prefix argument can explicitly document its prefixed behavior by setting the 'notmuch-prefix-doc property of its command symbol." (interactive) - (let* ((mode major-mode) - (doc (substitute-command-keys - (notmuch-substitute-command-keys (documentation mode t))))) + (let ((doc (substitute-command-keys + (notmuch-substitute-command-keys + (documentation major-mode t))))) (with-current-buffer (generate-new-buffer "*notmuch-help*") (insert doc) (goto-char (point-min)) @@ -483,8 +486,8 @@ be displayed." ;;; String Utilities (defun notmuch-prettify-subject (subject) - ;; This function is used by `notmuch-search-process-filter' which - ;; requires that we not disrupt its' matching state. + ;; This function is used by `notmuch-search-process-filter', + ;; which requires that we not disrupt its matching state. (save-match-data (if (and subject (string-match "^[ \t]*$" subject)) @@ -549,16 +552,19 @@ This replaces spaces, percents, and double quotes in STR with ;;; MML Utilities (defun notmuch-match-content-type (t1 t2) - "Return t if t1 and t2 are matching content types, taking wildcards into account." - (let ((st1 (split-string t1 "/")) - (st2 (split-string t2 "/"))) - (if (or (string= (cadr st1) "*") - (string= (cadr st2) "*")) - ;; Comparison of content types should be case insensitive. - (string= (downcase (car st1)) - (downcase (car st2))) - (string= (downcase t1) - (downcase t2))))) + "Return t if t1 and t2 are matching content types. +Take wildcards into account." + (and (stringp t1) + (stringp t2) + (let ((st1 (split-string t1 "/")) + (st2 (split-string t2 "/"))) + (if (or (string= (cadr st1) "*") + (string= (cadr st2) "*")) + ;; Comparison of content types should be case insensitive. + (string= (downcase (car st1)) + (downcase (car st2))) + (string= (downcase t1) + (downcase t2)))))) (defvar notmuch-multipart/alternative-discouraged '(;; Avoid HTML parts. @@ -633,7 +639,7 @@ the given type." ;; charset is US-ASCII. RFC6657 ;; complicates this somewhat. 'us-ascii))))) - (apply #'call-process + (apply #'notmuch--call-process notmuch-command nil '(t nil) nil args) (buffer-string)))))) (when (and cache data) @@ -854,6 +860,32 @@ You may need to restart Emacs or upgrade your notmuch package.")) ;; `notmuch-logged-error' does not return. )))) +(defmacro notmuch--apply-with-env (func &rest args) + `(let ((default-directory "~")) + (apply ,func ,@args))) + +(defun notmuch--process-lines (program &rest args) + "Wrap process-lines, binding DEFAULT-DIRECTORY to a safe +default" + (notmuch--apply-with-env #'process-lines program args)) + +(defun notmuch--make-process (&rest args) + "Wrap make-process, binding DEFAULT-DIRECTORY to a safe +default" + (notmuch--apply-with-env #'make-process 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-process (program &optional infile destination display &rest args) + "Wrap call-process, binding DEFAULT-DIRECTORY to a safe default" + (notmuch--apply-with-env #'call-process program infile destination display args)) + (defun notmuch-call-notmuch--helper (destination args) "Helper for synchronous notmuch invocation commands. @@ -868,9 +900,9 @@ for `call-process'. ARGS is as described for (otherwise (error "Unknown keyword argument: %s" (car args))))) (if (null stdin-string) - (apply #'call-process notmuch-command nil destination nil args) + (apply #'notmuch--call-process notmuch-command nil destination nil args) (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)))) (defun notmuch-call-notmuch-process (&rest args) @@ -927,7 +959,7 @@ status." (let* ((command (or (executable-find notmuch-command) (error "Command not found: %s" notmuch-command))) (err-buffer (generate-new-buffer " *notmuch-stderr*")) - (proc (make-process + (proc (notmuch--make-process :name name :buffer buffer :command (cons command args)