X-Git-Url: https://git.notmuchmail.org/git?a=blobdiff_plain;f=emacs%2Fnotmuch-lib.el;h=2c8de32868018529c50567f068050b539e39736a;hb=dff7f06711dba1c2d6a84d3e76021da0bf606623;hp=615207edba71071b8d9426fe2875c0600cdea968;hpb=6fb7d35069c8770b872128156cb4f0511da6b6e9;p=notmuch diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el index 615207ed..2c8de328 100644 --- a/emacs/notmuch-lib.el +++ b/emacs/notmuch-lib.el @@ -19,8 +19,6 @@ ;; ;; Authors: Carl Worth -;; This is an part of an emacs-based interface to the notmuch mail system. - ;;; Code: (require 'cl-lib) @@ -35,9 +33,6 @@ (defconst notmuch-emacs-version "unknown" "Placeholder variable when notmuch-version.el[c] is not available.")) -(autoload 'notmuch-jump-search "notmuch-jump" - "Jump to a saved search by shortcut key." t) - (defgroup notmuch nil "Notmuch mail reader for Emacs." :group 'mail) @@ -56,9 +51,8 @@ (defgroup notmuch-send nil "Sending messages from Notmuch." - :group 'notmuch) - -(custom-add-to-group 'notmuch-send 'message 'custom-group) + :group 'notmuch + :group 'message) (defgroup notmuch-tag nil "Tags and tagging in Notmuch." @@ -153,6 +147,7 @@ For example, if you wanted to remove an \"inbox\" tag and add an (defvar notmuch-common-keymap (let ((map (make-sparse-keymap))) (define-key map "?" 'notmuch-help) + (define-key map "v" 'notmuch-version) (define-key map "q" 'notmuch-bury-or-kill-this-buffer) (define-key map "s" 'notmuch-search) (define-key map "t" 'notmuch-search-by-tag) @@ -211,7 +206,7 @@ Otherwise the output will be returned." (unless (notmuch-cli-sane-p) (notmuch-logged-error "notmuch cli seems misconfigured or unconfigured." -"Perhaps you haven't run \"notmuch setup\" yet? Try running this + "Perhaps you haven't run \"notmuch setup\" yet? Try running this on the command line, and then retry your notmuch command"))) (defun notmuch-cli-version () @@ -224,6 +219,21 @@ on the command line, and then retry your notmuch command"))) (match-string 2 long-string) "unknown"))) +(defvar notmuch-emacs-version) + +(defun notmuch-version () + "Display the notmuch version. +The versions of the Emacs package and the `notmuch' executable +should match, but if and only if they don't, then this command +displays both values separately." + (interactive) + (let ((cli-version (notmuch-cli-version))) + (message "notmuch version %s" + (if (string= notmuch-emacs-version cli-version) + cli-version + (concat cli-version + " (emacs mua version " notmuch-emacs-version ")"))))) + (defun notmuch-config-get (item) "Return a value from the notmuch configuration." (let* ((val (notmuch-command-to-string "config" "get" item)) @@ -259,11 +269,13 @@ on the command line, and then retry your notmuch command"))) Invokes `notmuch-poll-script', \"notmuch new\", or does nothing depending on the value of `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) (error "Notmuch: poll script `%s' failed!" notmuch-poll-script))) - (notmuch-call-notmuch-process "new"))) + (notmuch-call-notmuch-process "new")) + (message "Polling mail...done")) (defun notmuch-bury-or-kill-this-buffer () "Undisplay the current buffer. @@ -275,18 +287,6 @@ it, in which case it is killed." (bury-buffer) (kill-buffer))) -(defun notmuch-documentation-first-line (symbol) - "Return the first line of the documentation string for SYMBOL." - (let ((doc (documentation symbol))) - (if doc - (with-temp-buffer - (insert (documentation symbol t)) - (goto-char (point-min)) - (let ((beg (point))) - (end-of-line) - (buffer-substring beg (point)))) - ""))) - (defun notmuch-prefix-key-description (key) "Given a prefix key code, return a human-readable string representation. @@ -319,9 +319,12 @@ It does not prepend if ACTUAL-KEY is already listed in TAIL." (or (and (symbolp binding) (get binding 'notmuch-doc)) (and (functionp binding) - (notmuch-documentation-first-line binding)))) + (let ((doc (documentation binding))) + (and doc + (string-match "\\`.+" doc) + (match-string 0 doc)))))) tail))) - tail) + tail) (defun notmuch-describe-remaps (remap-keymap ua-keys base-keymap prefix tail) ;; Remappings are represented as a binding whose first "event" is @@ -413,11 +416,11 @@ of its command symbol." "Show help for a subkeymap." (interactive) (let* ((key (this-command-keys-vector)) - (prefix (make-vector (1- (length key)) nil)) - (i 0)) + (prefix (make-vector (1- (length key)) nil)) + (i 0)) (while (< i (length prefix)) (aset prefix i (aref key i)) - (setq i (1+ i))) + (cl-incf i)) (let* ((subkeymap (key-binding prefix)) (ua-keys (where-is-internal 'universal-argument nil t)) (prefix-string (notmuch-prefix-key-description prefix)) @@ -522,15 +525,6 @@ This replaces spaces, percents, and double quotes in STR with ;; -(defun notmuch-remove-if-not (predicate list) - "Return a copy of LIST with all items not satisfying PREDICATE removed." - (let (out) - (while list - (when (funcall predicate (car list)) - (push (car list) out)) - (setq list (cdr list))) - (nreverse out))) - (defun notmuch-plist-delete (plist property) (let* ((xplist (cons nil plist)) (pred xplist)) @@ -540,14 +534,10 @@ This replaces spaces, percents, and double quotes in STR with (setq pred (cddr pred))) (cdr xplist))) -(defun notmuch-split-content-type (content-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." - (let ((st1 (notmuch-split-content-type t1)) - (st2 (notmuch-split-content-type 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. @@ -555,13 +545,11 @@ This replaces spaces, percents, and double quotes in STR with (string= (downcase t1) (downcase t2))))) (defvar notmuch-multipart/alternative-discouraged - '( - ;; Avoid HTML parts. + '(;; Avoid HTML parts. "text/html" ;; multipart/related usually contain a text/html part and some ;; associated graphics. - "multipart/related" - )) + "multipart/related")) (defun notmuch-multipart/alternative-determine-discouraged (msg) "Return the discouraged alternatives for the specified message." @@ -610,10 +598,11 @@ the given type." (set-buffer-multibyte nil)) (let ((args `("show" "--format=raw" ,(format "--part=%s" (plist-get part :id)) - ,@(when process-crypto '("--decrypt=true")) + ,@(and process-crypto '("--decrypt=true")) ,(notmuch-id-to-query (plist-get msg :id)))) (coding-system-for-read - (if binaryp 'no-conversion + (if binaryp + 'no-conversion (let ((coding-system (mm-charset-to-coding-system (plist-get part :content-charset)))) @@ -658,20 +647,6 @@ If CACHE is non-nil, the content of this part will be saved in MSG (if it isn't already)." (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 -;; part with images in it (demonstrated in 24.1 and 24.2 on Debian and -;; Fedora 17, though unreproducable in other configurations). -;; `mm-shr' references the variable `gnus-inhibit-images' without -;; first loading gnus-art, which defines it, resulting in a -;; void-variable error. Hence, we advise `mm-shr' to ensure gnus-art -;; is loaded. -(if (>= emacs-major-version 24) - (defadvice mm-shr (before load-gnus-arts activate) - (require 'gnus-art nil t) - (ad-disable-advice 'mm-shr 'before 'load-gnus-arts) - (ad-activate 'mm-shr))) - (defun notmuch-mm-display-part-inline (msg part content-type process-crypto) "Use the mm-decode/mm-view functions to display a part in the current buffer, if possible." @@ -682,7 +657,8 @@ current buffer, if possible." ;; `gnus-decoded' charset. Otherwise, we'll fetch the binary ;; part content and let mm-* decode it. (let* ((have-content (plist-member part :content)) - (charset (if have-content 'gnus-decoded + (charset (if have-content + 'gnus-decoded (plist-get part :content-charset))) (handle (mm-make-handle (current-buffer) `(,content-type (charset . ,charset))))) @@ -783,8 +759,7 @@ signaled error. This function does not return." (insert extra) (unless (bolp) (newline))))) - (error "%s" (concat msg (when extra - " (see *Notmuch errors* for more details)")))) + (error "%s%s" msg (if extra " (see *Notmuch errors* for more details)" ""))) (defun notmuch-check-async-exit-status (proc msg &optional command err) "If PROC exited abnormally, pop up an error buffer and signal an error. @@ -835,24 +810,22 @@ You may need to restart Emacs or upgrade your notmuch package.")) command " ")) (extra (concat "command: " command-string "\n" - (if (integerp exit-status) - (format "exit status: %s\n" exit-status) - (format "exit signal: %s\n" exit-status)) - (when err - (concat "stderr:\n" err)) - (when output - (concat "stdout:\n" output))))) - (if err - ;; We have an error message straight from the CLI. - (notmuch-logged-error - (replace-regexp-in-string "[ \n\r\t\f]*\\'" "" err) extra) - ;; We only have combined output from the CLI; don't inundate - ;; the user with it. Mimic `process-lines'. - (notmuch-logged-error (format "%s exited with status %s" - (car command) exit-status) - extra)) - ;; `notmuch-logged-error' does not return. - )))) + (if (integerp exit-status) + (format "exit status: %s\n" exit-status) + (format "exit signal: %s\n" exit-status)) + (and err (concat "stderr:\n" err)) + (and output (concat "stdout:\n" output))))) + (if err + ;; We have an error message straight from the CLI. + (notmuch-logged-error + (replace-regexp-in-string "[ \n\r\t\f]*\\'" "" err) extra) + ;; We only have combined output from the CLI; don't inundate + ;; the user with it. Mimic `process-lines'. + (notmuch-logged-error (format "%s exited with status %s" + (car command) exit-status) + extra)) + ;; `notmuch-logged-error' does not return. + )))) (defun notmuch-call-notmuch--helper (destination args) "Helper for synchronous notmuch invocation commands. @@ -863,8 +836,8 @@ for `call-process'. ARGS is as described for (let (stdin-string) (while (keywordp (car args)) (cl-case (car args) - (:stdin-string (setq stdin-string (cadr args) - args (cddr args))) + (:stdin-string (setq stdin-string (cadr args)) + (setq args (cddr args))) (otherwise (error "Unknown keyword argument: %s" (car args))))) (if (null stdin-string) @@ -925,9 +898,9 @@ invoke `set-process-sentinel' directly on the returned process, as that will interfere with the handling of stderr and the exit status." (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)))) + ;; 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*")) @@ -941,8 +914,8 @@ status." :buffer buffer :command (cons command args) :connection-type 'pipe - :stderr err-buffer) - err-proc (get-buffer-process err-buffer)) + :stderr err-buffer)) + (setq err-proc (get-buffer-process err-buffer)) (process-put proc 'err-buffer err-buffer) (process-put err-proc 'err-file err-file) @@ -970,8 +943,8 @@ status." (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)))) + (err (and (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 @@ -989,16 +962,17 @@ status." ;; If that didn't signal an error, then any error output was ;; really warning output. Show warnings, if any. (let ((warnings - (when err - (with-current-buffer err-buffer - (goto-char (point-min)) - (end-of-line) - ;; Show first line; stuff remaining lines in the - ;; errors buffer. - (let ((l1 (buffer-substring (point-min) (point)))) - (skip-chars-forward "\n") - (cons l1 (unless (eobp) - (buffer-substring (point) (point-max))))))))) + (and err + (with-current-buffer err-buffer + (goto-char (point-min)) + (end-of-line) + ;; Show first line; stuff remaining lines in the + ;; errors buffer. + (let ((l1 (buffer-substring (point-min) (point)))) + (skip-chars-forward "\n") + (cons l1 (and (not (eobp)) + (buffer-substring (point) + (point-max))))))))) (when warnings (notmuch-logged-error (car warnings) (cdr warnings))))) (error @@ -1030,8 +1004,8 @@ region if the region is active, or both `point' otherwise." (list (point) (point)))) (define-obsolete-function-alias - 'notmuch-search-interactive-region - 'notmuch-interactive-region + 'notmuch-search-interactive-region + 'notmuch-interactive-region "notmuch 0.29") (provide 'notmuch-lib)