X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=emacs%2Fnotmuch-lib.el;h=45817e1311dc7d4f4940e8573a924e05f7d9f10e;hp=c7bb2091f8edcc457ed2f36569ce9bf744c90253;hb=HEAD;hpb=9d6f4641d17a6100cb8d96bc1e09d3d4999c34f3 diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el index c7bb2091..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 @@ -860,6 +880,32 @@ You may need to restart Emacs or upgrade your notmuch package.")) ;; `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. @@ -874,9 +920,9 @@ 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 #'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) @@ -933,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) @@ -994,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 () @@ -1010,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)