emacs: renamed function notmuch-version to notmuch-cli-version

[notmuch] / emacs / notmuch-lib.el

diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index a54a055e6f32f5fee3511f02da1d37df8340e935..e16a1b971bd5e29bb3b78ba9f3a823c0b39acb85 100644 (file)
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -25,8 +25,8 @@
 (require 'mm-decode)
 (require 'cl)
 
 (require 'mm-decode)
 (require 'cl)
 

-(defvar notmuch-command "notmuch"
-  "Command to run the notmuch binary.")
+(autoload 'notmuch-jump-search "notmuch-jump"
+  "Jump to a saved search by shortcut key." t)

 
 (defgroup notmuch nil
   "Notmuch mail reader for Emacs."
 
 (defgroup notmuch nil
   "Notmuch mail reader for Emacs."


@@ -66,6 +66,16 @@
   "Graphical attributes for displaying text"
   :group 'notmuch)
 
   "Graphical attributes for displaying text"
   :group 'notmuch)
 

+(defcustom notmuch-command "notmuch"
+  "Name of the notmuch binary.
+
+This can be a relative or absolute path to the notmuch binary.
+If this is a relative path, it will be searched for in all of the
+directories given in `exec-path' (which is, by default, based on
+$PATH)."
+  :type 'string
+  :group 'notmuch-external)
+

 (defcustom notmuch-search-oldest-first t
   "Show the oldest mail first when searching.
 
 (defcustom notmuch-search-oldest-first t
   "Show the oldest mail first when searching.
 


@@ -77,7 +87,11 @@ search."
   :group 'notmuch-search)
 
 (defcustom notmuch-poll-script nil
   :group 'notmuch-search)
 
 (defcustom notmuch-poll-script nil

-  "An external script to incorporate new mail into the notmuch database.
+  "[Deprecated] Command to run to incorporate new mail into the notmuch database.
+
+This option has been deprecated in favor of \"notmuch new\"
+hooks (see man notmuch-hooks).  To change the path to the notmuch
+binary, customize `notmuch-command'.

 
 This variable controls the action invoked by
 `notmuch-poll-and-refresh-this-buffer' (bound by default to 'G')
 
 This variable controls the action invoked by
 `notmuch-poll-and-refresh-this-buffer' (bound by default to 'G')


@@ -93,10 +107,7 @@ the user's needs:
 
 1. Invoke a program to transfer mail to the local mail store
 2. Invoke \"notmuch new\" to incorporate the new mail
 
 1. Invoke a program to transfer mail to the local mail store
 2. Invoke \"notmuch new\" to incorporate the new mail

-3. Invoke one or more \"notmuch tag\" commands to classify the mail
-
-Note that the recommended way of achieving the same is using
-\"notmuch new\" hooks."
+3. Invoke one or more \"notmuch tag\" commands to classify the mail"

   :type '(choice (const :tag "notmuch new" nil)
                 (const :tag "Disabled" "")
                 (string :tag "Custom script"))
   :type '(choice (const :tag "notmuch new" nil)
                 (const :tag "Disabled" "")
                 (string :tag "Custom script"))


@@ -107,50 +118,6 @@ Note that the recommended way of achieving the same is using
 (defvar notmuch-search-history nil
   "Variable to store notmuch searches history.")
 
 (defvar notmuch-search-history nil
   "Variable to store notmuch searches history.")
 

-(defun notmuch--saved-searches-to-plist (symbol)
-  "Extract a saved-search variable into plist form.
-
-The new style saved search is just a plist, but for backwards
-compatatibility we use this function to extract old style saved
-searches so they still work in customize."
-  (let ((saved-searches (default-value symbol)))
-    (mapcar #'notmuch-hello-saved-search-to-plist saved-searches)))
-
-(define-widget 'notmuch-saved-search-plist 'list
-  "A single saved search property list."
-  :tag "Saved Search"
-  :args '((list :inline t
-               :format "%v"
-               (group :format "%v" :inline t (const :format "   Name: " :name) (string :format "%v"))
-               (group :format "%v" :inline t (const :format "  Query: " :query) (string :format "%v")))
-         (checklist :inline t
-                    :format "%v"
-                    (group :format "%v" :inline t (const :format "Count-Query: " :count-query) (string :format "%v")))))
-
-(defcustom notmuch-saved-searches '((:name "inbox" :query "tag:inbox")
-                                   (:name "unread" :query "tag:unread"))
-  "A list of saved searches to display.
-
-The saved search can be given in 3 forms. The preferred way is as
-a plist. Supported properties are
-
-  :name            Name of the search (required).
-  :query           Search to run (required).
-  :count-query     Optional extra query to generate the count
-                   shown. If not present then the :query property
-                   is used.
-
-Other accepted forms are a cons cell of the form (NAME . QUERY)
-or a list of the form (NAME QUERY COUNT-QUERY)."
-;; The saved-search format is also used by the all-tags notmuch-hello
-;; section. This section generates its own saved-search list in one of
-;; the latter two forms.
-
-  :get 'notmuch--saved-searches-to-plist
-  :type '(repeat notmuch-saved-search-plist)
-  :tag "List of Saved Searches"
-  :group 'notmuch-hello)
-

 (defcustom notmuch-archive-tags '("-inbox")
   "List of tag changes to apply to a message or a thread when it is archived.
 
 (defcustom notmuch-archive-tags '("-inbox")
   "List of tag changes to apply to a message or a thread when it is archived.
 


@@ -168,12 +135,13 @@ For example, if you wanted to remove an \"inbox\" tag and add an
 (defvar notmuch-common-keymap
   (let ((map (make-sparse-keymap)))
     (define-key map "?" 'notmuch-help)
 (defvar notmuch-common-keymap
   (let ((map (make-sparse-keymap)))
     (define-key map "?" 'notmuch-help)

-    (define-key map "q" 'notmuch-kill-this-buffer)
+    (define-key map "q" 'notmuch-bury-or-kill-this-buffer)

     (define-key map "s" 'notmuch-search)
     (define-key map "z" 'notmuch-tree)
     (define-key map "m" 'notmuch-mua-new-mail)
     (define-key map "=" 'notmuch-refresh-this-buffer)
     (define-key map "G" 'notmuch-poll-and-refresh-this-buffer)
     (define-key map "s" 'notmuch-search)
     (define-key map "z" 'notmuch-tree)
     (define-key map "m" 'notmuch-mua-new-mail)
     (define-key map "=" 'notmuch-refresh-this-buffer)
     (define-key map "G" 'notmuch-poll-and-refresh-this-buffer)

+    (define-key map "j" 'notmuch-jump-search)

     map)
   "Keymap shared by all notmuch modes.")
 
     map)
   "Keymap shared by all notmuch modes.")
 


@@ -224,8 +192,8 @@ Otherwise the output will be returned"
 "Perhaps you haven't run \"notmuch setup\" yet? Try running this
 on the command line, and then retry your notmuch command")))
 
 "Perhaps you haven't run \"notmuch setup\" yet? Try running this
 on the command line, and then retry your notmuch command")))
 

-(defun notmuch-version ()
-  "Return a string with the notmuch version number."
+(defun notmuch-cli-version ()
+  "Return a string with the notmuch cli command version number."

   (let ((long-string
         ;; Trim off the trailing newline.
         (substring (notmuch-command-to-string "--version") 0 -1)))
   (let ((long-string
         ;; Trim off the trailing newline.
         (substring (notmuch-command-to-string "--version") 0 -1)))


@@ -271,10 +239,15 @@ depending on the value of `notmuch-poll-script'."
        (call-process notmuch-poll-script nil nil))
     (call-process notmuch-command nil nil nil "new")))
 
        (call-process notmuch-poll-script nil nil))
     (call-process notmuch-command nil nil nil "new")))
 

-(defun notmuch-kill-this-buffer ()
-  "Kill the current buffer."
+(defun notmuch-bury-or-kill-this-buffer ()
+  "Undisplay the current buffer.
+
+Bury the current buffer, unless there is only one window showing
+it, in which case it is killed."

   (interactive)
   (interactive)

-  (kill-buffer (current-buffer)))
+  (if (> (length (get-buffer-window-list nil nil t)) 1)
+      (bury-buffer)
+    (kill-buffer)))

 
 (defun notmuch-documentation-first-line (symbol)
   "Return the first line of the documentation string for SYMBOL."
 
 (defun notmuch-documentation-first-line (symbol)
   "Return the first line of the documentation string for SYMBOL."


@@ -508,6 +481,15 @@ This replaces spaces, percents, and double quotes in STR with
       (setq list (cdr list)))
     (nreverse out)))
 
       (setq list (cdr list)))
     (nreverse out)))
 

+(defun notmuch-plist-delete (plist property)
+  (let* ((xplist (cons nil plist))
+        (pred xplist))
+    (while (cdr pred)
+      (when (eq (cadr pred) property)
+       (setcdr pred (cdddr pred)))
+      (setq pred (cddr pred)))
+    (cdr xplist)))
+

 (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 "/"))


@@ -547,24 +529,67 @@ the given type."
    (lambda (part) (notmuch-match-content-type (plist-get part :content-type) type))
    parts))
 
    (lambda (part) (notmuch-match-content-type (plist-get part :content-type) type))
    parts))
 

-;; Helper for parts which are generally not included in the default
-;; SEXP output.
-(defun notmuch-get-bodypart-internal (query part-number process-crypto)
-  (let ((args '("show" "--format=raw"))
-       (part-arg (format "--part=%s" part-number)))
-    (setq args (append args (list part-arg)))
-    (if process-crypto
-       (setq args (append args '("--decrypt"))))
-    (setq args (append args (list query)))
-    (with-temp-buffer
-      (let ((coding-system-for-read 'no-conversion))
-       (progn
-         (apply 'call-process (append (list notmuch-command nil (list t nil) nil) args))
-         (buffer-string))))))
-
-(defun notmuch-get-bodypart-content (msg part nth process-crypto)
-  (or (plist-get part :content)
-      (notmuch-get-bodypart-internal (notmuch-id-to-query (plist-get msg :id)) nth process-crypto)))
+(defun notmuch-get-bodypart-binary (msg part process-crypto &optional cache)
+  "Return the unprocessed content of PART in MSG as a unibyte string.
+
+This returns the \"raw\" content of the given part after content
+transfer decoding, but with no further processing (see the
+discussion of --format=raw in man notmuch-show).  In particular,
+this does no charset conversion.
+
+If CACHE is non-nil, the content of this part will be saved in
+MSG (if it isn't already)."
+  (let ((data (plist-get part :binary-content)))
+    (when (not data)
+      (let ((args `("show" "--format=raw"
+                   ,(format "--part=%d" (plist-get part :id))
+                   ,@(when process-crypto '("--decrypt"))
+                   ,(notmuch-id-to-query (plist-get msg :id)))))
+       (with-temp-buffer
+         ;; Emacs internally uses a UTF-8-like multibyte string
+         ;; representation by default (regardless of the coding
+         ;; system, which only affects how it goes from outside data
+         ;; to this internal representation).  This *almost* never
+         ;; matters.  Annoyingly, it does matter if we use this data
+         ;; in an image descriptor, since Emacs will use its internal
+         ;; data buffer directly and this multibyte representation
+         ;; corrupts binary image formats.  Since the caller is
+         ;; asking for binary data, a unibyte string is a more
+         ;; appropriate representation anyway.
+         (set-buffer-multibyte nil)
+         (let ((coding-system-for-read 'no-conversion))
+           (apply #'call-process notmuch-command nil '(t nil) nil args)
+           (setq data (buffer-string)))))
+      (when cache
+       ;; Cheat.  part is non-nil, and `plist-put' always modifies
+       ;; the list in place if it's non-nil.
+       (plist-put part :binary-content data)))
+    data))
+
+(defun notmuch-get-bodypart-text (msg part process-crypto &optional cache)
+  "Return the text content of PART in MSG.
+
+This returns the content of the given part as a multibyte Lisp
+string after performing content transfer decoding and any
+necessary charset decoding.  It is an error to use this for
+non-text/* parts.
+
+If CACHE is non-nil, the content of this part will be saved in
+MSG (if it isn't already)."
+  (let ((content (plist-get part :content)))
+    (when (not content)
+      ;; Use show --format=sexp to fetch decoded content
+      (let* ((args `("show" "--format=sexp" "--include-html"
+                    ,(format "--part=%s" (plist-get part :id))
+                    ,@(when process-crypto '("--decrypt"))
+                    ,(notmuch-id-to-query (plist-get msg :id))))
+            (npart (apply #'notmuch-call-notmuch-sexp args)))
+       (setq content (plist-get npart :content))
+       (when (not content)
+         (error "Internal error: No :content from %S" args)))
+      (when cache
+       (plist-put part :content content)))
+    content))

 
 ;; Workaround: The call to `mm-display-part' below triggers a bug in
 ;; Emacs 24 if it attempts to use the shr renderer to display an HTML
 
 ;; Workaround: The call to `mm-display-part' below triggers a bug in
 ;; Emacs 24 if it attempts to use the shr renderer to display an HTML


@@ -580,23 +605,26 @@ the given type."
       (ad-disable-advice 'mm-shr 'before 'load-gnus-arts)
       (ad-activate 'mm-shr)))
 
       (ad-disable-advice 'mm-shr 'before 'load-gnus-arts)
       (ad-activate 'mm-shr)))
 

-(defun notmuch-mm-display-part-inline (msg part nth content-type process-crypto)
+(defun notmuch-mm-display-part-inline (msg part content-type process-crypto)

   "Use the mm-decode/mm-view functions to display a part in the
 current buffer, if possible."
   (let ((display-buffer (current-buffer)))
     (with-temp-buffer
   "Use the mm-decode/mm-view functions to display a part in the
 current buffer, if possible."
   (let ((display-buffer (current-buffer)))
     (with-temp-buffer

-      ;; In case there is :content, the content string is already converted
-      ;; into emacs internal format. `gnus-decoded' is a fake charset,
-      ;; which means no further decoding (to be done by mm- functions).
-      (let* ((charset (if (plist-member part :content)
-                         'gnus-decoded
+      ;; In case we already have :content, use it and tell mm-* that
+      ;; it's already been charset-decoded by using the fake
+      ;; `gnus-decoded' charset.  Otherwise, we'll fetch the binary
+      ;; part content and let mm-* decode it.
+      (let* ((have-content (plist-member part :content))
+            (charset (if have-content 'gnus-decoded

                        (plist-get part :content-charset)))
             (handle (mm-make-handle (current-buffer) `(,content-type (charset . ,charset)))))
        ;; If the user wants the part inlined, insert the content and
        ;; test whether we are able to inline it (which includes both
        ;; capability and suitability tests).
        (when (mm-inlined-p handle)
                        (plist-get part :content-charset)))
             (handle (mm-make-handle (current-buffer) `(,content-type (charset . ,charset)))))
        ;; If the user wants the part inlined, insert the content and
        ;; test whether we are able to inline it (which includes both
        ;; capability and suitability tests).
        (when (mm-inlined-p handle)

-         (insert (notmuch-get-bodypart-content msg part nth process-crypto))
+         (if have-content
+             (insert (notmuch-get-bodypart-text msg part process-crypto))
+           (insert (notmuch-get-bodypart-binary msg part process-crypto)))

          (when (mm-inlinable-p handle)
            (set-buffer display-buffer)
            (mm-display-part handle)
          (when (mm-inlinable-p handle)
            (set-buffer display-buffer)
            (mm-display-part handle)