emacs: Add new option notmuch-search-hide-excluded

[notmuch] / emacs / notmuch-lib.el

diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index 3add992b46f1dbe4479f48576a77297b8d322da1..bf9c4a534a24f5d5c088857ce420600604259326 100644 (file)
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -22,6 +22,8 @@
 ;;; Code:
 
 (require 'cl-lib)
 ;;; Code:
 
 (require 'cl-lib)

+(require 'pcase)
+(require 'subr-x)

 
 (require 'mm-util)
 (require 'mm-view)
 
 (require 'mm-util)
 (require 'mm-view)


@@ -101,6 +103,17 @@ search results. Note that any filtered searches created by
 search."
   :type 'boolean
   :group 'notmuch-search)
 search."
   :type 'boolean
   :group 'notmuch-search)

+(make-variable-buffer-local 'notmuch-search-oldest-first)
+
+(defcustom notmuch-search-hide-excluded t
+  "Hide mail tagged with a excluded tag.
+
+Excluded tags are defined in the users configuration file under
+the search section. When this variable is true, any mail with
+such a tag will not be shown in the search output."
+  :type 'boolean
+  :group 'notmuch-search)
+(make-variable-buffer-local 'notmuch-search-hide-excluded)

 
 (defcustom notmuch-poll-script nil
   "[Deprecated] Command to run to incorporate new mail into the notmuch database.
 
 (defcustom notmuch-poll-script nil
   "[Deprecated] Command to run to incorporate new mail into the notmuch database.


@@ -163,6 +176,7 @@ For example, if you wanted to remove an \"inbox\" tag and add an
     (define-key map (kbd "M-=") 'notmuch-refresh-all-buffers)
     (define-key map "G" 'notmuch-poll-and-refresh-this-buffer)
     (define-key map "j" 'notmuch-jump-search)
     (define-key map (kbd "M-=") 'notmuch-refresh-all-buffers)
     (define-key map "G" 'notmuch-poll-and-refresh-this-buffer)
     (define-key map "j" 'notmuch-jump-search)

+    (define-key map [remap undo] 'notmuch-tag-undo)

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


@@ -192,7 +206,7 @@ will be signaled.
 
 Otherwise the output will be returned."
   (with-temp-buffer
 
 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)))
          (output (buffer-string)))
       (notmuch-check-exit-status status (cons notmuch-command args) output)
       output)))


@@ -203,7 +217,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
 (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)
                                "config" "get" "user.primary_email")))
       (setq notmuch--cli-sane-p (= status 0))))
   notmuch--cli-sane-p)


@@ -247,7 +261,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
   (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)
     (if (and (> len 0)
             (= (aref val (- len 1)) ?\n))
        (substring val 0 -1)


@@ -282,8 +296,8 @@ depending on the value of `notmuch-poll-script'."
   (interactive)
   (message "Polling mail...")
   (if (stringp 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"))
          (error "Notmuch: poll script `%s' failed!" notmuch-poll-script)))
     (notmuch-call-notmuch-process "new"))
   (message "Polling mail...done"))


@@ -410,14 +424,14 @@ This is similar to `describe-function' for the current major
 mode, but bindings tables are shown with documentation strings
 rather than command names.  By default, this uses the first line
 of each command's documentation string.  A command can override
 mode, but bindings tables are shown with documentation strings
 rather than command names.  By default, this uses the first line
 of each command's documentation string.  A command can override

-this by setting the 'notmuch-doc property of its command symbol.
+this by setting the \\='notmuch-doc property of its command symbol.

 A command that supports a prefix argument can explicitly document
 A command that supports a prefix argument can explicitly document

-its prefixed behavior by setting the 'notmuch-prefix-doc property
+its prefixed behavior by setting the \\='notmuch-prefix-doc property

 of its command symbol."
   (interactive)
 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))
     (with-current-buffer (generate-new-buffer "*notmuch-help*")
       (insert doc)
       (goto-char (point-min))


@@ -483,8 +497,8 @@ be displayed."
 ;;; String Utilities
 
 (defun notmuch-prettify-subject (subject)
 ;;; 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))
   (save-match-data
     (if (and subject
             (string-match "^[ \t]*$" subject))


@@ -549,23 +563,34 @@ This replaces spaces, percents, and double quotes in STR with
 ;;; MML Utilities
 
 (defun notmuch-match-content-type (t1 t2)
 ;;; 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)))))
-
-(defvar notmuch-multipart/alternative-discouraged
+  "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))))))
+
+(defcustom notmuch-multipart/alternative-discouraged

   '(;; Avoid HTML parts.
     "text/html"
     ;; multipart/related usually contain a text/html part and some
     ;; associated graphics.
   '(;; Avoid HTML parts.
     "text/html"
     ;; multipart/related usually contain a text/html part and some
     ;; associated graphics.

-    "multipart/related"))
+    "multipart/related")
+  "Which mime types to hide by default for multipart messages.
+
+Can either be a list of mime types (as strings) or a function
+mapping a plist representing the current message to such a list.
+See Info node `(notmuch-emacs) notmuch-show' for a sample function."
+  :group 'notmuch-show
+  :type '(radio (repeat :tag "MIME Types" string)
+               (function :tag "Function")))

 
 (defun notmuch-multipart/alternative-determine-discouraged (msg)
   "Return the discouraged alternatives for the specified message."
 
 (defun notmuch-multipart/alternative-determine-discouraged (msg)
   "Return the discouraged alternatives for the specified message."


@@ -633,7 +658,7 @@ the given type."
                                  ;; charset is US-ASCII. RFC6657
                                  ;; complicates this somewhat.
                                  'us-ascii)))))
                                  ;; 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)
                              notmuch-command nil '(t nil) nil args)
                       (buffer-string))))))
     (when (and cache data)


@@ -688,6 +713,7 @@ current buffer, if possible."
          (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)

+           (plist-put part :undisplayer (mm-handle-undisplayer handle))

            t))))))
 
 ;;; Generic Utilities
            t))))))
 
 ;;; Generic Utilities


@@ -710,7 +736,7 @@ single element face list."
     (list face)))
 
 (defun notmuch-apply-face (object face &optional below start end)
     (list face)))
 
 (defun notmuch-apply-face (object face &optional below start end)

-  "Combine FACE into the 'face text property of OBJECT between START and END.
+  "Combine FACE into the \\='face text property of OBJECT between START and END.

 
 This function combines FACE with any existing faces between START
 and END in OBJECT.  Attributes specified by FACE take precedence
 
 This function combines FACE with any existing faces between START
 and END in OBJECT.  Attributes specified by FACE take precedence


@@ -854,6 +880,32 @@ You may need to restart Emacs or upgrade your notmuch package."))
       ;; `notmuch-logged-error' does not return.
       ))))
 
       ;; `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.
 
 (defun notmuch-call-notmuch--helper (destination args)
   "Helper for synchronous notmuch invocation commands.
 


@@ -868,9 +920,9 @@ for `call-process'.  ARGS is as described for
        (otherwise
         (error "Unknown keyword argument: %s" (car args)))))
     (if (null stdin-string)
        (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)
       (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)
             notmuch-command t destination nil args))))
 
 (defun notmuch-call-notmuch-process (&rest args)


@@ -927,7 +979,7 @@ status."
   (let* ((command (or (executable-find notmuch-command)
                      (error "Command not found: %s" notmuch-command)))
         (err-buffer (generate-new-buffer " *notmuch-stderr*"))
   (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)
                :name name
                :buffer buffer
                :command (cons command args)


@@ -988,6 +1040,20 @@ status."
 
 (defvar-local notmuch-show-process-crypto nil)
 
 
 (defvar-local notmuch-show-process-crypto nil)
 

+(defun notmuch--run-show (search-terms &optional duplicate)
+  "Return a list of threads of messages matching SEARCH-TERMS.
+
+A thread is a forest or list of trees. A tree is a two element
+list where the first element is a message, and the second element
+is a possibly empty forest of replies."
+  (let ((args '("show" "--format=sexp" "--format-version=5")))
+    (when notmuch-show-process-crypto
+      (setq args (append args '("--decrypt=true"))))
+    (when duplicate
+      (setq args (append args (list (format "--duplicate=%d" duplicate)))))
+    (setq args (append args search-terms))
+    (apply #'notmuch-call-notmuch-sexp args)))
+

 ;;; Generic Utilities
 
 (defun notmuch-interactive-region ()
 ;;; Generic Utilities
 
 (defun notmuch-interactive-region ()


@@ -1004,6 +1070,14 @@ region if the region is active, or both `point' otherwise."
   'notmuch-interactive-region
   "notmuch 0.29")
 
   'notmuch-interactive-region
   "notmuch 0.29")
 

+(defun notmuch--inline-override-types ()
+  "Override mm-inline-override-types to stop application/*
+parts from being displayed unless the user has customized
+it themselves."
+  (if (equal mm-inline-override-types
+            (eval (car (get 'mm-inline-override-types 'standard-value))))
+      (cons "application/.*" mm-inline-override-types)
+    mm-inline-override-types))

 ;;; _
 
 (provide 'notmuch-lib)
 ;;; _
 
 (provide 'notmuch-lib)