X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=emacs%2Fnotmuch-lib.el;h=0bb08eb26ad46d372b5802ecafc9e49d8b1bd94c;hp=5dc6797068c876619bc36f57cd2ffa4c9ae5e9ab;hb=ed40579ad3882e6f9bbe9b1ba5e707ab289ca203;hpb=71f1228a518f08e94dc1ea4e2147f80d3484c615 diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el index 5dc67970..0bb08eb2 100644 --- a/emacs/notmuch-lib.el +++ b/emacs/notmuch-lib.el @@ -23,10 +23,12 @@ ;;; Code: +(require 'cl-lib) + (require 'mm-util) (require 'mm-view) (require 'mm-decode) -(require 'cl) + (require 'notmuch-compat) (unless (require 'notmuch-version nil t) @@ -74,6 +76,10 @@ "Running external commands from within Notmuch." :group 'notmuch) +(defgroup notmuch-address nil + "Address completion." + :group 'notmuch) + (defgroup notmuch-faces nil "Graphical attributes for displaying text" :group 'notmuch) @@ -149,8 +155,11 @@ For example, if you wanted to remove an \"inbox\" tag and add an (define-key map "?" 'notmuch-help) (define-key map "q" 'notmuch-bury-or-kill-this-buffer) (define-key map "s" 'notmuch-search) + (define-key map "t" 'notmuch-search-by-tag) (define-key map "z" 'notmuch-tree) + (define-key map "u" 'notmuch-unthreaded) (define-key map "m" 'notmuch-mua-new-mail) + (define-key map "g" 'notmuch-refresh-this-buffer) (define-key map "=" 'notmuch-refresh-this-buffer) (define-key map (kbd "M-=") 'notmuch-refresh-all-buffers) (define-key map "G" 'notmuch-poll-and-refresh-this-buffer) @@ -180,7 +189,7 @@ 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" +Otherwise the output will be returned." (with-temp-buffer (let* ((status (apply #'call-process notmuch-command nil t nil args)) (output (buffer-string))) @@ -290,10 +299,10 @@ This is basically just `format-kbd-macro' but we also convert ESC to M-." (defun notmuch-describe-key (actual-key binding prefix ua-keys tail) - "Prepend cons cells describing prefix-arg ACTUAL-KEY and ACTUAL-KEY to TAIL + "Prepend cons cells describing prefix-arg ACTUAL-KEY and ACTUAL-KEY to TAIL. It does not prepend if ACTUAL-KEY is already listed in TAIL." - (let ((key-string (concat prefix (format-kbd-macro actual-key)))) + (let ((key-string (concat prefix (key-description actual-key)))) ;; We don't include documentation if the key-binding is ;; over-ridden. Note, over-riding a binding automatically hides the ;; prefixed version too. @@ -308,7 +317,7 @@ It does not prepend if ACTUAL-KEY is already listed in TAIL." ;; Documentation for command (push (cons key-string (or (and (symbolp binding) (get binding 'notmuch-doc)) - (notmuch-documentation-first-line binding))) + (and (functionp binding) (notmuch-documentation-first-line binding)))) tail))) tail) @@ -521,11 +530,11 @@ This replaces spaces, percents, and double quotes in STR with (cdr xplist))) (defun notmuch-split-content-type (content-type) - "Split content/type into 'content' and 'type'" + "Split content/type into 'content' and 'type'." (split-string content-type "/")) (defun notmuch-match-content-type (t1 t2) - "Return t if t1 and t2 are matching content types, taking wildcards into account" + "Return t if t1 and t2 are matching content types, taking wildcards into account." (let ((st1 (notmuch-split-content-type t1)) (st2 (notmuch-split-content-type t2))) (if (or (string= (cadr st1) "*") @@ -567,7 +576,7 @@ for this message, if present." (defun notmuch-parts-filter-by-type (parts type) "Given a list of message parts, return a list containing the ones matching the given type." - (remove-if-not + (cl-remove-if-not (lambda (part) (notmuch-match-content-type (plist-get part :content-type) type)) parts)) @@ -589,7 +598,7 @@ the given type." (set-buffer-multibyte nil)) (let ((args `("show" "--format=raw" ,(format "--part=%s" (plist-get part :id)) - ,@(when process-crypto '("--decrypt")) + ,@(when process-crypto '("--decrypt=true")) ,(notmuch-id-to-query (plist-get msg :id)))) (coding-system-for-read (if binaryp 'no-conversion @@ -678,8 +687,8 @@ current buffer, if possible." ;; have symbols of the form :Header as keys, and the resulting alist will have ;; symbols of the form 'Header as keys. (defun notmuch-headers-plist-to-alist (plist) - (loop for (key value . rest) on plist by #'cddr - collect (cons (intern (substring (symbol-name key) 1)) value))) + (cl-loop for (key value . rest) on plist by #'cddr + collect (cons (intern (substring (symbol-name key) 1)) value))) (defun notmuch-face-ensure-list-form (face) "Return FACE in face list form. @@ -764,23 +773,23 @@ signaled error. This function does not return." (error "%s" (concat msg (when extra " (see *Notmuch errors* for more details)")))) -(defun notmuch-check-async-exit-status (proc msg &optional command err-file) +(defun notmuch-check-async-exit-status (proc msg &optional command err) "If PROC exited abnormally, pop up an error buffer and signal an error. This is a wrapper around `notmuch-check-exit-status' for asynchronous process sentinels. PROC and MSG must be the -arguments passed to the sentinel. COMMAND and ERR-FILE, if -provided, are passed to `notmuch-check-exit-status'. If COMMAND -is not provided, it is taken from `process-command'." +arguments passed to the sentinel. COMMAND and ERR, if provided, +are passed to `notmuch-check-exit-status'. If COMMAND is not +provided, it is taken from `process-command'." (let ((exit-status - (case (process-status proc) + (cl-case (process-status proc) ((exit) (process-exit-status proc)) ((signal) msg)))) (when exit-status (notmuch-check-exit-status exit-status (or command (process-command proc)) - nil err-file)))) + nil err)))) -(defun notmuch-check-exit-status (exit-status command &optional output err-file) +(defun notmuch-check-exit-status (exit-status command &optional output err) "If EXIT-STATUS is non-zero, pop up an error buffer and signal an error. If EXIT-STATUS is non-zero, pop up a notmuch error buffer @@ -789,9 +798,9 @@ be a number indicating the exit status code of a process or a string describing the signal that terminated the process (such as returned by `call-process'). COMMAND must be a list giving the command and its arguments. OUTPUT, if provided, is a string -giving the output of command. ERR-FILE, if provided, is the name -of a file containing the error output of command. OUTPUT and the -contents of ERR-FILE will be included in the error message." +giving the output of command. ERR, if provided, is the error +output of command. OUTPUT and ERR will be included in the error +message." (cond ((eq exit-status 0) t) @@ -804,12 +813,7 @@ You may need to restart Emacs or upgrade your notmuch Emacs package.")) Emacs requested a newer output format than supported by the notmuch CLI. You may need to restart Emacs or upgrade your notmuch package.")) (t - (let* ((err (when err-file - (with-temp-buffer - (insert-file-contents err-file) - (unless (eobp) - (buffer-string))))) - (command-string + (let* ((command-string (mapconcat (lambda (arg) (shell-quote-argument (cond ((stringp arg) arg) @@ -846,7 +850,7 @@ for `call-process'. ARGS is as described for (let (stdin-string) (while (keywordp (car args)) - (case (car args) + (cl-case (car args) (:stdin-string (setq stdin-string (cadr args) args (cddr args))) (otherwise @@ -885,9 +889,13 @@ error." (with-temp-buffer (let ((err-file (make-temp-file "nmerr"))) (unwind-protect - (let ((status (notmuch-call-notmuch--helper (list t err-file) args))) + (let ((status (notmuch-call-notmuch--helper (list t err-file) args)) + (err (with-temp-buffer + (insert-file-contents err-file) + (unless (eobp) + (buffer-string))))) (notmuch-check-exit-status status (cons notmuch-command args) - (buffer-string) err-file) + (buffer-string) err) (goto-char (point-min)) (read (current-buffer))) (delete-file err-file))))) @@ -906,30 +914,58 @@ invoke `set-process-sentinel' directly on the returned process, as that will interfere with the handling of stderr and the exit status." - ;; There is no way (as of Emacs 24.3) to capture stdout and stderr - ;; separately for asynchronous processes, or even to redirect stderr - ;; to a file, so we use a trivial shell wrapper to send stderr to a - ;; temporary file and clean things up in the sentinel. - (let* ((err-file (make-temp-file "nmerr")) - ;; Use a pipe - (process-connection-type nil) - ;; Find notmuch using Emacs' `exec-path' - (command (or (executable-find notmuch-command) - (error "command not found: %s" notmuch-command))) - (proc (apply #'start-process name buffer - "/bin/sh" "-c" - "exec 2>\"$1\"; shift; exec \"$0\" \"$@\"" - command err-file args))) - (process-put proc 'err-file err-file) + (let (err-file err-buffer proc err-proc + ;; Find notmuch using Emacs' `exec-path' + (command (or (executable-find notmuch-command) + (error "Command not found: %s" notmuch-command)))) + (if (fboundp 'make-process) + (progn + (setq err-buffer (generate-new-buffer " *notmuch-stderr*")) + ;; Emacs 25 and newer has `make-process', which allows + ;; redirecting stderr independently from stdout to a + ;; separate buffer. As this allows us to avoid using a + ;; temporary file and shell invocation, use it when + ;; available. + (setq proc (make-process + :name name + :buffer buffer + :command (cons command args) + :connection-type 'pipe + :stderr err-buffer) + err-proc (get-buffer-process err-buffer)) + (process-put proc 'err-buffer err-buffer) + + (process-put err-proc 'err-file err-file) + (process-put err-proc 'err-buffer err-buffer) + (set-process-sentinel err-proc #'notmuch-start-notmuch-error-sentinel)) + + ;; On Emacs versions before 25, there is no way to capture + ;; stdout and stderr separately for asynchronous processes, or + ;; even to redirect stderr to a file, so we use a trivial shell + ;; wrapper to send stderr to a temporary file and clean things + ;; up in the sentinel. + (setq err-file (make-temp-file "nmerr")) + (let ((process-connection-type nil)) ;; Use a pipe + (setq proc (apply #'start-process name buffer + "/bin/sh" "-c" + "exec 2>\"$1\"; shift; exec \"$0\" \"$@\"" + command err-file args))) + (process-put proc 'err-file err-file)) + (process-put proc 'sub-sentinel sentinel) (process-put proc 'real-command (cons notmuch-command args)) (set-process-sentinel proc #'notmuch-start-notmuch-sentinel) proc)) (defun notmuch-start-notmuch-sentinel (proc event) - (let ((err-file (process-get proc 'err-file)) - (sub-sentinel (process-get proc 'sub-sentinel)) - (real-command (process-get proc 'real-command))) + "Process sentinel function used by `notmuch-start-notmuch'." + (let* ((err-file (process-get proc 'err-file)) + (err-buffer (or (process-get proc 'err-buffer) + (find-file-noselect err-file))) + (err (when (not (zerop (buffer-size err-buffer))) + (with-current-buffer err-buffer (buffer-string)))) + (sub-sentinel (process-get proc 'sub-sentinel)) + (real-command (process-get proc 'real-command))) (condition-case err (progn ;; Invoke the sub-sentinel, if any @@ -941,12 +977,13 @@ status." ;; and there's no point in telling the user that (but we ;; still check for and report stderr output below). (when (buffer-live-p (process-buffer proc)) - (notmuch-check-async-exit-status proc event real-command err-file)) + (notmuch-check-async-exit-status proc event real-command err)) ;; If that didn't signal an error, then any error output was ;; really warning output. Show warnings, if any. (let ((warnings - (with-temp-buffer - (unless (= (second (insert-file-contents err-file)) 0) + (when err + (with-current-buffer err-buffer + (goto-char (point-min)) (end-of-line) ;; Show first line; stuff remaining lines in the ;; errors buffer. @@ -960,17 +997,35 @@ status." ;; Emacs behaves strangely if an error escapes from a sentinel, ;; so turn errors into messages. (message "%s" (error-message-string err)))) - (ignore-errors (delete-file err-file)))) + (when err-file (ignore-errors (delete-file err-file))))) + +(defun notmuch-start-notmuch-error-sentinel (proc event) + (let* ((err-file (process-get proc 'err-file)) + ;; When `make-process' is available, use the error buffer + ;; associated with the process, otherwise the error file. + (err-buffer (or (process-get proc 'err-buffer) + (find-file-noselect err-file)))) + (when err-buffer (kill-buffer err-buffer)))) ;; 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) (make-variable-buffer-local 'notmuch-show-process-crypto) -(provide 'notmuch-lib) +(defun notmuch-interactive-region () + "Return the bounds of the current interactive region. + +This returns (BEG END), where BEG and END are the bounds of the +region if the region is active, or both `point' otherwise." + (if (region-active-p) + (list (region-beginning) (region-end)) + (list (point) (point)))) -;; Local Variables: -;; byte-compile-warnings: (not cl-functions) -;; End: +(define-obsolete-function-alias + 'notmuch-search-interactive-region + 'notmuch-interactive-region + "notmuch 0.29") + +(provide 'notmuch-lib) ;;; notmuch-lib.el ends here