-;; Compatibility functions for versions of emacs before emacs 23.
-;;
-;; Both functions here were copied from emacs 23 with the following copyright:
-;;
-;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
-;;
-;; and under the GPL version 3 (or later) exactly as notmuch itself.
-(compile-on-emacs-prior-to-23
- (defun apply-partially (fun &rest args)
- "Return a function that is a partial application of FUN to ARGS.
-ARGS is a list of the first N arguments to pass to FUN.
-The result is a new function which does the same as FUN, except that
-the first N arguments are fixed at the values with which this function
-was called."
- (lexical-let ((fun fun) (args1 args))
- (lambda (&rest args2) (apply fun (append args1 args2))))))
-
-(compile-on-emacs-prior-to-23
- (defun mouse-event-p (object)
- "Return non-nil if OBJECT is a mouse click event."
- (memq (event-basic-type object) '(mouse-1 mouse-2 mouse-3 mouse-movement))))
-
-;; This variable is used only buffer local, but it needs to be
-;; declared globally first to avoid compiler warnings.
-(defvar notmuch-show-process-crypto nil)
-(make-variable-buffer-local 'notmuch-show-process-crypto)
-
-;; Incremental JSON parsing
-
-(defun notmuch-json-create-parser (buffer)
- "Return a streaming JSON parser that consumes input from BUFFER.
-
-This parser is designed to read streaming JSON whose structure is
-known to the caller. Like a typical JSON parsing interface, it
-provides a function to read a complete JSON value from the input.
-However, it extends this with an additional function that
-requires the next value in the input to be a compound value and
-descends into it, allowing its elements to be read one at a time
-or further descended into. Both functions can return 'retry to
-indicate that not enough input is available.
-
-The parser always consumes input from BUFFER's point. Hence, the
-caller is allowed to delete and data before point and may
-resynchronize after an error by moving point."
-
- (list buffer
- ;; Terminator stack: a stack of characters that indicate the
- ;; end of the compound values enclosing point
- '()
- ;; Next: One of
- ;; * 'expect-value if the next token must be a value, but a
- ;; value has not yet been reached
- ;; * 'value if point is at the beginning of a value
- ;; * 'expect-comma if the next token must be a comma
- 'expect-value
- ;; Allow terminator: non-nil if the next token may be a
- ;; terminator
- nil
- ;; Partial parse position: If state is 'value, a marker for
- ;; the position of the partial parser or nil if no partial
- ;; parsing has happened yet
- nil
- ;; Partial parse state: If state is 'value, the current
- ;; `parse-partial-sexp' state
- nil))
-
-(defmacro notmuch-json-buffer (jp) `(first ,jp))
-(defmacro notmuch-json-term-stack (jp) `(second ,jp))
-(defmacro notmuch-json-next (jp) `(third ,jp))
-(defmacro notmuch-json-allow-term (jp) `(fourth ,jp))
-(defmacro notmuch-json-partial-pos (jp) `(fifth ,jp))
-(defmacro notmuch-json-partial-state (jp) `(sixth ,jp))
-
-(defvar notmuch-json-syntax-table
- (let ((table (make-syntax-table)))
- ;; The standard syntax table is what we need except that "." needs
- ;; to have word syntax instead of punctuation syntax.
- (modify-syntax-entry ?. "w" table)
- table)
- "Syntax table used for incremental JSON parsing.")
-
-(defun notmuch-json-scan-to-value (jp)
- ;; Helper function that consumes separators, terminators, and
- ;; whitespace from point. Returns nil if it successfully reached
- ;; the beginning of a value, 'end if it consumed a terminator, or
- ;; 'retry if not enough input was available to reach a value. Upon
- ;; nil return, (notmuch-json-next jp) is always 'value.
-
- (if (eq (notmuch-json-next jp) 'value)
- ;; We're already at a value
- nil
- ;; Drive the state toward 'expect-value
- (skip-chars-forward " \t\r\n")
- (or (when (eobp) 'retry)
- ;; Test for the terminator for the current compound
- (when (and (notmuch-json-allow-term jp)
- (eq (char-after) (car (notmuch-json-term-stack jp))))
- ;; Consume it and expect a comma or terminator next
- (forward-char)
- (setf (notmuch-json-term-stack jp) (cdr (notmuch-json-term-stack jp))
- (notmuch-json-next jp) 'expect-comma
- (notmuch-json-allow-term jp) t)
- 'end)
- ;; Test for a separator
- (when (eq (notmuch-json-next jp) 'expect-comma)
- (when (/= (char-after) ?,)
- (signal 'json-readtable-error (list "expected ','")))
- ;; Consume it, switch to 'expect-value, and disallow a
- ;; terminator
- (forward-char)
- (skip-chars-forward " \t\r\n")
- (setf (notmuch-json-next jp) 'expect-value
- (notmuch-json-allow-term jp) nil)
- ;; We moved point, so test for eobp again and fall through
- ;; to the next test if there's more input
- (when (eobp) 'retry))
- ;; Next must be 'expect-value and we know this isn't
- ;; whitespace, EOB, or a terminator, so point must be on a
- ;; value
+This function combines FACE with any existing faces between START
+and END in OBJECT. Attributes specified by FACE take precedence
+over existing attributes unless BELOW is non-nil.
+
+OBJECT may be a string, a buffer, or nil (which means the current
+buffer). If object is a string, START and END are 0-based;
+otherwise they are buffer positions (integers or markers). FACE
+must be a face name (a symbol or string), a property list of face
+attributes, or a list of these. If START and/or END are omitted,
+they default to the beginning/end of OBJECT. For convenience
+when applied to strings, this returns OBJECT."
+ ;; A face property can have three forms: a face name (a string or
+ ;; symbol), a property list, or a list of these two forms. In the
+ ;; list case, the faces will be combined, with the earlier faces
+ ;; taking precedent. Here we canonicalize everything to list form
+ ;; to make it easy to combine.
+ (let ((pos (cond (start start)
+ ((stringp object) 0)
+ (t 1)))
+ (end (cond (end end)
+ ((stringp object) (length object))
+ (t (1+ (buffer-size object)))))
+ (face-list (notmuch-face-ensure-list-form face)))
+ (while (< pos end)
+ (let* ((cur (get-text-property pos 'face object))
+ (cur-list (notmuch-face-ensure-list-form cur))
+ (new (cond ((null cur-list) face)
+ (below (append cur-list face-list))
+ (t (append face-list cur-list))))
+ (next (next-single-property-change pos 'face object end)))
+ (put-text-property pos next 'face new object)
+ (setq pos next))))
+ object)
+
+(defun notmuch-map-text-property (start end prop func &optional object)
+ "Transform text property PROP using FUNC.
+
+Applies FUNC to each distinct value of the text property PROP
+between START and END of OBJECT, setting PROP to the value
+returned by FUNC."
+ (while (< start end)
+ (let ((value (get-text-property start prop object))
+ (next (next-single-property-change start prop object end)))
+ (put-text-property start next prop (funcall func value) object)
+ (setq start next))))
+
+;;; Running Notmuch
+
+(defun notmuch-logged-error (msg &optional extra)
+ "Log MSG and EXTRA to *Notmuch errors* and signal MSG.
+
+This logs MSG and EXTRA to the *Notmuch errors* buffer and
+signals MSG as an error. If EXTRA is non-nil, text referring the
+user to the *Notmuch errors* buffer will be appended to the
+signaled error. This function does not return."
+ (with-current-buffer (get-buffer-create "*Notmuch errors*")
+ (goto-char (point-max))
+ (unless (bobp)
+ (newline))
+ (save-excursion
+ (insert "[" (current-time-string) "]\n" msg)
+ (unless (bolp)
+ (newline))
+ (when extra
+ (insert extra)
+ (unless (bolp)
+ (newline)))))
+ (error "%s%s" msg (if extra " (see *Notmuch errors* for more details)" "")))
+
+(defun notmuch-check-async-exit-status (proc msg &optional command err)
+ "If PROC exited abnormally, pop up an error buffer and signal an error.
+
+This is a wrapper around `notmuch-check-exit-status' for
+asynchronous process sentinels. PROC and MSG must be the
+arguments passed to the sentinel. COMMAND and ERR, if provided,
+are passed to `notmuch-check-exit-status'. If COMMAND is not
+provided, it is taken from `process-command'."
+ (let ((exit-status
+ (cl-case (process-status proc)
+ ((exit) (process-exit-status proc))
+ ((signal) msg))))
+ (when exit-status
+ (notmuch-check-exit-status exit-status
+ (or command (process-command proc))
+ nil err))))
+
+(defun notmuch-check-exit-status (exit-status command &optional output err)
+ "If EXIT-STATUS is non-zero, pop up an error buffer and signal an error.
+
+If EXIT-STATUS is non-zero, pop up a notmuch error buffer
+describing the error and signal an Elisp error. EXIT-STATUS must
+be a number indicating the exit status code of a process or a
+string describing the signal that terminated the process (such as
+returned by `call-process'). COMMAND must be a list giving the
+command and its arguments. OUTPUT, if provided, is a string
+giving the output of command. ERR, if provided, is the error
+output of command. OUTPUT and ERR will be included in the error
+message."
+ (cond
+ ((eq exit-status 0) t)
+ ((eq exit-status 20)
+ (notmuch-logged-error "notmuch CLI version mismatch
+Emacs requested an older output format than supported by the notmuch CLI.
+You may need to restart Emacs or upgrade your notmuch Emacs package."))
+ ((eq exit-status 21)
+ (notmuch-logged-error "notmuch CLI version mismatch
+Emacs requested a newer output format than supported by the notmuch CLI.
+You may need to restart Emacs or upgrade your notmuch package."))
+ (t
+ (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
+ (replace-regexp-in-string "[ \n\r\t\f]*\\'" "" err) extra)
+ ;; 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"
+ command exit-status)
+ extra))
+ ;; `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.
+
+This wraps `call-process'. DESTINATION has the same meaning as
+for `call-process'. ARGS is as described for
+`notmuch-call-notmuch-process'."
+ (let (stdin-string)
+ (while (keywordp (car args))
+ (cl-case (car args)
+ (:stdin-string (setq stdin-string (cadr args))
+ (setq args (cddr args)))
+ (otherwise
+ (error "Unknown keyword argument: %s" (car args)))))
+ (if (null stdin-string)
+ (apply #'notmuch--call-process notmuch-command nil destination nil args)
+ (insert stdin-string)
+ (apply #'notmuch--call-process-region (point-min) (point-max)
+ notmuch-command t destination nil args))))
+
+(defun notmuch-call-notmuch-process (&rest args)
+ "Synchronously invoke `notmuch-command' with ARGS.
+
+The caller may provide keyword arguments before ARGS. Currently
+supported keyword arguments are:
+
+ :stdin-string STRING - Write STRING to stdin
+
+If notmuch exits with a non-zero status, output from the process
+will appear in a buffer named \"*Notmuch errors*\" and an error
+will be signaled."
+ (with-temp-buffer
+ (let ((status (notmuch-call-notmuch--helper t args)))
+ (notmuch-check-exit-status status (cons notmuch-command args)
+ (buffer-string)))))
+
+(defun notmuch-call-notmuch-sexp (&rest args)
+ "Invoke `notmuch-command' with ARGS and return the parsed S-exp output.
+
+This is equivalent to `notmuch-call-notmuch-process', but parses
+notmuch's output as an S-expression and returns the parsed value.
+Like `notmuch-call-notmuch-process', if notmuch exits with a
+non-zero status, this will report its output and signal an
+error."
+ (with-temp-buffer
+ (let ((err-file (make-temp-file "nmerr")))
+ (unwind-protect
+ (let ((status (notmuch-call-notmuch--helper (list t err-file) args))
+ (err (with-temp-buffer
+ (insert-file-contents err-file)
+ (unless (eobp)
+ (buffer-string)))))
+ (notmuch-check-exit-status status (cons notmuch-command args)
+ (buffer-string) err)
+ (goto-char (point-min))
+ (read (current-buffer)))
+ (delete-file err-file)))))
+
+(defun notmuch-start-notmuch (name buffer sentinel &rest args)
+ "Start and return an asynchronous notmuch command.
+
+This starts and returns an asynchronous process running
+`notmuch-command' with ARGS. The exit status is checked via
+`notmuch-check-async-exit-status'. Output written to stderr is
+redirected and displayed when the process exits (even if the
+process exits successfully). NAME and BUFFER are the same as in
+`start-process'. SENTINEL is a process sentinel function to call
+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* ((command (or (executable-find notmuch-command)
+ (error "Command not found: %s" notmuch-command)))
+ (err-buffer (generate-new-buffer " *notmuch-stderr*"))
+ (proc (notmuch--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)
+ (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-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)))
+ (condition-case err