X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=emacs%2Fnotmuch-lib.el;h=45817e1311dc7d4f4940e8573a924e05f7d9f10e;hp=207ea4c21749ba295fc87d033f0ad1845b25f0e6;hb=HEAD;hpb=5e5f2122f91413e93761ca4a3d30b0b8b0d5e38e diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el index 207ea4c2..bf9c4a53 100644 --- a/emacs/notmuch-lib.el +++ b/emacs/notmuch-lib.el @@ -105,6 +105,16 @@ search." :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. @@ -166,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 [remap undo] 'notmuch-tag-undo) map) "Keymap shared by all notmuch modes.") @@ -195,7 +206,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))) @@ -206,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 - (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) @@ -286,7 +297,7 @@ depending on the value of `notmuch-poll-script'." (message "Polling mail...") (if (stringp notmuch-poll-script) (unless (string-empty-p notmuch-poll-script) - (unless (equal (call-process notmuch-poll-script nil nil) 0) + (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")) @@ -413,9 +424,9 @@ 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 -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 -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) (let ((doc (substitute-command-keys @@ -566,12 +577,20 @@ Take wildcards into account." (string= (downcase t1) (downcase t2)))))) -(defvar notmuch-multipart/alternative-discouraged +(defcustom notmuch-multipart/alternative-discouraged '(;; 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." @@ -639,7 +658,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) @@ -694,6 +713,7 @@ current buffer, if possible." (when (mm-inlinable-p handle) (set-buffer display-buffer) (mm-display-part handle) + (plist-put part :undisplayer (mm-handle-undisplayer handle)) t)))))) ;;; Generic Utilities @@ -716,7 +736,7 @@ single element face list." (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 @@ -869,6 +889,11 @@ You may need to restart Emacs or upgrade your notmuch package.")) 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) @@ -877,6 +902,10 @@ 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. @@ -891,7 +920,7 @@ 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 #'notmuch--call-process-region (point-min) (point-max) notmuch-command t destination nil args)))) @@ -950,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*")) - (proc (make-process + (proc (notmuch--make-process :name name :buffer buffer :command (cons command args) @@ -1011,6 +1040,20 @@ status." (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 () @@ -1027,6 +1070,14 @@ region if the region is active, or both `point' otherwise." '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)