X-Git-Url: https://git.cworth.org/git?a=blobdiff_plain;f=emacs%2Fnotmuch-lib.el;h=546ab6fda41f654e8e64d1a85408f64fc6f78ffe;hb=9956a326db2dbdd32863a67acb28abc82d16a5c8;hp=1c3a9fe1865f13048c23dbc1b00b702cf15f1081;hpb=ca076ce2736b5db2ec03afe1b0e09299b24f05ff;p=notmuch
diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index 1c3a9fe1..546ab6fd 100644
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -1,4 +1,4 @@
-;; notmuch-lib.el --- common variables, functions and function declarations
+;;; notmuch-lib.el --- common variables, functions and function declarations
;;
;; Copyright © Carl Worth
;;
@@ -15,15 +15,19 @@
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
-;; along with Notmuch. If not, see .
+;; along with Notmuch. If not, see .
;;
;; Authors: Carl Worth
;; This is an part of an emacs-based interface to the notmuch mail system.
+;;; Code:
+
+(require 'mm-util)
(require 'mm-view)
(require 'mm-decode)
(require 'cl)
+(require 'notmuch-compat)
(unless (require 'notmuch-version nil t)
(defconst notmuch-emacs-version "unknown"
@@ -54,6 +58,10 @@
(custom-add-to-group 'notmuch-send 'message 'custom-group)
+(defgroup notmuch-tag nil
+ "Tags and tagging in Notmuch."
+ :group 'notmuch)
+
(defgroup notmuch-crypto nil
"Processing and display of cryptographic MIME parts."
:group 'notmuch)
@@ -66,6 +74,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)
@@ -143,7 +155,9 @@ For example, if you wanted to remove an \"inbox\" tag and add an
(define-key map "s" 'notmuch-search)
(define-key map "z" 'notmuch-tree)
(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)
(define-key map "j" 'notmuch-jump-search)
map)
@@ -243,8 +257,9 @@ depending on the value of `notmuch-poll-script'."
(interactive)
(if (stringp notmuch-poll-script)
(unless (string= notmuch-poll-script "")
- (call-process notmuch-poll-script nil nil))
- (call-process notmuch-command nil nil nil "new")))
+ (unless (equal (call-process notmuch-poll-script nil nil) 0)
+ (error "Notmuch: poll script `%s' failed!" notmuch-poll-script)))
+ (notmuch-call-notmuch-process "new")))
(defun notmuch-bury-or-kill-this-buffer ()
"Undisplay the current buffer.
@@ -283,7 +298,7 @@ This is basically just `format-kbd-macro' but we also convert ESC to M-."
"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.
@@ -298,7 +313,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)
@@ -409,10 +424,8 @@ of its command symbol."
"Refresh the current buffer."
(interactive)
(when notmuch-buffer-refresh-function
- (if (commandp notmuch-buffer-refresh-function)
- ;; Pass prefix argument, etc.
- (call-interactively notmuch-buffer-refresh-function)
- (funcall notmuch-buffer-refresh-function))))
+ ;; Pass prefix argument, etc.
+ (call-interactively notmuch-buffer-refresh-function)))
(defun notmuch-poll-and-refresh-this-buffer ()
"Invoke `notmuch-poll' to import mail, then refresh the current buffer."
@@ -420,6 +433,21 @@ of its command symbol."
(notmuch-poll)
(notmuch-refresh-this-buffer))
+(defun notmuch-refresh-all-buffers ()
+ "Invoke `notmuch-refresh-this-buffer' on all notmuch major-mode buffers.
+
+The buffers are silently refreshed, i.e. they are not forced to
+be displayed."
+ (interactive)
+ (dolist (buffer (buffer-list))
+ (let ((buffer-mode (buffer-local-value 'major-mode buffer)))
+ (when (memq buffer-mode '(notmuch-show-mode
+ notmuch-tree-mode
+ notmuch-search-mode
+ notmuch-hello-mode))
+ (with-current-buffer buffer
+ (notmuch-refresh-this-buffer))))))
+
(defun notmuch-prettify-subject (subject)
;; This function is used by `notmuch-search-process-filter' which
;; requires that we not disrupt its' matching state.
@@ -519,11 +547,23 @@ This replaces spaces, percents, and double quotes in STR with
"multipart/related"
))
-(defun notmuch-multipart/alternative-choose (types)
- "Return a list of preferred types from the given list of types"
+(defun notmuch-multipart/alternative-determine-discouraged (msg)
+ "Return the discouraged alternatives for the specified message."
+ ;; If a function, return the result of calling it.
+ (if (functionp notmuch-multipart/alternative-discouraged)
+ (funcall notmuch-multipart/alternative-discouraged msg)
+ ;; Otherwise simply return the value of the variable, which is
+ ;; assumed to be a list of discouraged alternatives. This is the
+ ;; default behaviour.
+ notmuch-multipart/alternative-discouraged))
+
+(defun notmuch-multipart/alternative-choose (msg types)
+ "Return a list of preferred types from the given list of types
+for this message, if present."
;; Based on `mm-preferred-alternative-precedence'.
- (let ((seq types))
- (dolist (pref (reverse notmuch-multipart/alternative-discouraged))
+ (let ((discouraged (notmuch-multipart/alternative-determine-discouraged msg))
+ (seq types))
+ (dolist (pref (reverse discouraged))
(dolist (elem (copy-sequence seq))
(when (string-match pref elem)
(setq seq (nconc (delete elem seq) (list elem))))))
@@ -536,6 +576,47 @@ the given type."
(lambda (part) (notmuch-match-content-type (plist-get part :content-type) type))
parts))
+(defun notmuch--get-bodypart-raw (msg part process-crypto binaryp cache)
+ (let* ((plist-elem (if binaryp :content-binary :content))
+ (data (or (plist-get part plist-elem)
+ (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.
+ (when binaryp
+ (set-buffer-multibyte nil))
+ (let ((args `("show" "--format=raw"
+ ,(format "--part=%s" (plist-get part :id))
+ ,@(when process-crypto '("--decrypt=true"))
+ ,(notmuch-id-to-query (plist-get msg :id))))
+ (coding-system-for-read
+ (if binaryp 'no-conversion
+ (let ((coding-system (mm-charset-to-coding-system
+ (plist-get part :content-charset))))
+ ;; Sadly,
+ ;; `mm-charset-to-coding-system' seems
+ ;; to return things that are not
+ ;; considered acceptable values for
+ ;; `coding-system-for-read'.
+ (if (coding-system-p coding-system)
+ coding-system
+ ;; RFC 2047 says that the default
+ ;; charset is US-ASCII. RFC6657
+ ;; complicates this somewhat.
+ 'us-ascii)))))
+ (apply #'call-process notmuch-command nil '(t nil) nil args)
+ (buffer-string))))))
+ (when (and cache data)
+ (plist-put part plist-elem data))
+ data))
+
(defun notmuch-get-bodypart-binary (msg part process-crypto &optional cache)
"Return the unprocessed content of PART in MSG as a unibyte string.
@@ -546,57 +627,18 @@ 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))
+ (notmuch--get-bodypart-raw msg part process-crypto t cache))
(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.
+necessary charset decoding.
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))
+ (notmuch--get-bodypart-raw msg part process-crypto nil cache))
;; 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
@@ -727,23 +769,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)
((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
@@ -752,9 +794,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)
@@ -767,14 +809,15 @@ 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)))))
+ (let* ((command-string
+ (mapconcat (lambda (arg)
+ (shell-quote-argument
+ (cond ((stringp arg) arg)
+ ((symbolp arg) (symbol-name arg))
+ (t "*UNKNOWN ARGUMENT*"))))
+ command " "))
(extra
- (concat
- "command: " (mapconcat #'shell-quote-argument command " ") "\n"
+ (concat "command: " command-string "\n"
(if (integerp exit-status)
(format "exit status: %s\n" exit-status)
(format "exit signal: %s\n" exit-status))
@@ -842,9 +885,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)))))
@@ -863,30 +910,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
@@ -898,12 +973,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.
@@ -917,7 +993,15 @@ 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.
@@ -929,3 +1013,5 @@ status."
;; Local Variables:
;; byte-compile-warnings: (not cl-functions)
;; End:
+
+;;; notmuch-lib.el ends here