emacs: Fix trimming regexp in notmuch-check-exit-status

[notmuch] / emacs / notmuch-lib.el

diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index e7e71ea6cc64d9aabf2049c336c8074a2cdf01e3..59b1ce3ffecfaf1e310ac3667446e93cc260d39f 100644 (file)
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -112,13 +112,25 @@ For example, if you wanted to remove an \"inbox\" tag and add an
                  (select-window (posn-window (event-start last-input-event)))
                  (button-activate button)))
 
                  (select-window (posn-window (event-start last-input-event)))
                  (button-activate button)))
 

+(defun notmuch-command-to-string (&rest args)
+  "Synchronously invoke \"notmuch\" with the given list of arguments.
+
+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.
+
+Otherwise the output will be returned"
+  (with-temp-buffer
+    (let* ((status (apply #'call-process notmuch-command nil t nil args))
+          (output (buffer-string)))
+      (notmuch-check-exit-status status (cons notmuch-command args) output)
+      output)))
+

 (defun notmuch-version ()
   "Return a string with the notmuch version number."
   (let ((long-string
         ;; Trim off the trailing newline.
 (defun notmuch-version ()
   "Return a string with the notmuch version number."
   (let ((long-string
         ;; Trim off the trailing newline.

-        (substring (shell-command-to-string
-                    (concat notmuch-command " --version"))
-                   0 -1)))
+        (substring (notmuch-command-to-string "--version") 0 -1)))

     (if (string-match "^notmuch\\( version\\)? \\(.*\\)$"
                      long-string)
        (match-string 2 long-string)
     (if (string-match "^notmuch\\( version\\)? \\(.*\\)$"
                      long-string)
        (match-string 2 long-string)


@@ -127,9 +139,7 @@ For example, if you wanted to remove an \"inbox\" tag and add an
 (defun notmuch-config-get (item)
   "Return a value from the notmuch configuration."
   ;; Trim off the trailing newline
 (defun notmuch-config-get (item)
   "Return a value from the notmuch configuration."
   ;; Trim off the trailing newline

-  (substring (shell-command-to-string
-             (concat notmuch-command " config get " item))
-             0 -1))
+  (substring (notmuch-command-to-string "config" "get" item) 0 -1))

 
 (defun notmuch-database-path ()
   "Return the database.path value from the notmuch configuration."
 
 (defun notmuch-database-path ()
   "Return the database.path value from the notmuch configuration."


@@ -203,19 +213,6 @@ user-friendly queries."
       (setq list (cdr list)))
     (nreverse out)))
 
       (setq list (cdr list)))
     (nreverse out)))
 

-;; This lets us avoid compiling these replacement functions when emacs
-;; is sufficiently new enough to supply them alone. We do the macro
-;; treatment rather than just wrapping our defun calls in a when form
-;; specifically so that the compiler never sees the code on new emacs,
-;; (since the code is triggering warnings that we don't know how to get
-;; rid of.
-;;
-;; A more clever macro here would accept a condition and a list of forms.
-(defmacro compile-on-emacs-prior-to-23 (form)
-  "Conditionally evaluate form only on emacs < emacs-23."
-  (list 'when (< emacs-major-version 23)
-       form))
-

 (defun notmuch-split-content-type (content-type)
   "Split content/type into 'content' and 'type'"
   (split-string content-type "/"))
 (defun notmuch-split-content-type (content-type)
   "Split content/type into 'content' and 'type'"
   (split-string content-type "/"))


@@ -326,13 +323,16 @@ single element face list."
       face
     (list face)))
 
       face
     (list face)))
 

-(defun notmuch-combine-face-text-property (start end face)
+(defun notmuch-combine-face-text-property (start end face &optional below object)

   "Combine FACE into the 'face text property between START and END.
 
 This function combines FACE with any existing faces between START
   "Combine FACE into the 'face text property between START and END.
 
 This function combines FACE with any existing faces between START

-and END.  Attributes specified by FACE take precedence over
-existing attributes.  FACE must be a face name (a symbol or
-string), a property list of face attributes, or a list of these."
+and END in OBJECT (which defaults to the current buffer).
+Attributes specified by FACE take precedence over existing
+attributes unless BELOW is non-nil.  FACE must be a face name (a
+symbol or string), a property list of face attributes, or a list
+of these.  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
 
   ;; 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


@@ -342,13 +342,23 @@ string), a property list of face attributes, or a list of these."
   (let ((pos start)
        (face-list (notmuch-face-ensure-list-form face)))
     (while (< pos end)
   (let ((pos start)
        (face-list (notmuch-face-ensure-list-form face)))
     (while (< pos end)

-      (let* ((cur (get-text-property pos 'face))
+      (let* ((cur (get-text-property pos 'face object))

             (cur-list (notmuch-face-ensure-list-form cur))
             (new (cond ((null cur-list) face)
             (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))))
                        (t (append face-list cur-list))))

-            (next (next-single-property-change pos 'face nil end)))
-       (put-text-property pos next 'face new)
-       (setq pos next)))))
+            (next (next-single-property-change pos 'face object end)))
+       (put-text-property pos next 'face new object)
+       (setq pos next))))
+  object)
+
+(defun notmuch-combine-face-text-property-string (string face &optional below)
+  (notmuch-combine-face-text-property
+   0
+   (length string)
+   face
+   below
+   string))

 
 (defun notmuch-logged-error (msg &optional extra)
   "Log MSG and EXTRA to *Notmuch errors* and signal MSG.
 
 (defun notmuch-logged-error (msg &optional extra)
   "Log MSG and EXTRA to *Notmuch errors* and signal MSG.


@@ -428,7 +438,7 @@ You may need to restart Emacs or upgrade your notmuch package."))
        (if err
            ;; We have an error message straight from the CLI.
            (notmuch-logged-error
        (if err
            ;; We have an error message straight from the CLI.
            (notmuch-logged-error

-            (replace-regexp-in-string "\\s $" "" err) extra)
+            (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"
          ;; 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"


@@ -459,29 +469,6 @@ an error."
              (json-read)))
        (delete-file err-file)))))
 
              (json-read)))
        (delete-file err-file)))))
 

-;; 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)
 ;; 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)