X-Git-Url: https://git.notmuchmail.org/git?a=blobdiff_plain;f=emacs%2Fnotmuch-lib.el;h=58f3313d0bb92102bb1841fa3320ead9e68f36d7;hb=fd656d7683ee968eedf11268fb41ad5659aab02f;hp=534f217753cd1f4f474a822f5b3ae801d0ca6489;hpb=634914064bdfa4acb5b489dc03bd4ff5dcda3170;p=notmuch diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el index 534f2177..58f3313d 100644 --- a/emacs/notmuch-lib.el +++ b/emacs/notmuch-lib.el @@ -23,7 +23,6 @@ (require 'mm-view) (require 'mm-decode) -(require 'json) (require 'cl) (defvar notmuch-command "notmuch" @@ -68,10 +67,42 @@ :group 'notmuch) (defcustom notmuch-search-oldest-first t - "Show the oldest mail first when searching." + "Show the oldest mail first when searching. + +This variable defines the default sort order for displaying +search results. Note that any filtered searches created by +`notmuch-search-filter' retain the search order of the parent +search." :type 'boolean :group 'notmuch-search) +(defcustom notmuch-poll-script nil + "An external script to incorporate new mail into the notmuch database. + +This variable controls the action invoked by +`notmuch-search-poll-and-refresh-view' and +`notmuch-hello-poll-and-update' (each have a default keybinding +of 'G') to incorporate new mail into the notmuch database. + +If set to nil (the default), new mail is processed by invoking +\"notmuch new\". Otherwise, this should be set to a string that +gives the name of an external script that processes new mail. If +set to the empty string, no command will be run. + +The external script could do any of the following depending on +the user's needs: + +1. Invoke a program to transfer mail to the local mail store +2. Invoke \"notmuch new\" to incorporate the new mail +3. Invoke one or more \"notmuch tag\" commands to classify the mail + +Note that the recommended way of achieving the same is using +\"notmuch new\" hooks." + :type '(choice (const :tag "notmuch new" nil) + (const :tag "Disabled" "") + (string :tag "Custom script")) + :group 'notmuch-external) + ;; (defvar notmuch-search-history nil @@ -97,6 +128,17 @@ For example, if you wanted to remove an \"inbox\" tag and add an :group 'notmuch-search :group 'notmuch-show) +(defvar notmuch-common-keymap + (let ((map (make-sparse-keymap))) + (define-key map "?" 'notmuch-help) + (define-key map "q" 'notmuch-kill-this-buffer) + (define-key map "s" 'notmuch-search) + (define-key map "m" 'notmuch-mua-new-mail) + (define-key map "=" 'notmuch-refresh-this-buffer) + (define-key map "G" 'notmuch-poll-and-refresh-this-buffer) + map) + "Keymap shared by all notmuch modes.") + ;; By default clicking on a button does not select the window ;; containing the button (as opposed to clicking on a widget which ;; does). This means that the button action is then executed in the @@ -157,11 +199,41 @@ Otherwise the output will be returned" "Return the user.other_email value (as a list) from the notmuch configuration." (split-string (notmuch-config-get "user.other_email") "\n")) +(defun notmuch-poll () + "Run \"notmuch new\" or an external script to import mail. + +Invokes `notmuch-poll-script', \"notmuch new\", or does nothing +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"))) + (defun notmuch-kill-this-buffer () "Kill the current buffer." (interactive) (kill-buffer (current-buffer))) +(defvar notmuch-buffer-refresh-function nil + "Function to call to refresh the current buffer.") +(make-variable-buffer-local 'notmuch-buffer-refresh-function) + +(defun notmuch-refresh-this-buffer () + "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)))) + +(defun notmuch-poll-and-refresh-this-buffer () + "Invoke `notmuch-poll' to import mail, then refresh the current buffer." + (interactive) + (notmuch-poll) + (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. @@ -253,7 +325,7 @@ the given type." parts)) ;; Helper for parts which are generally not included in the default -;; JSON output. +;; SEXP output. (defun notmuch-get-bodypart-internal (query part-number process-crypto) (let ((args '("show" "--format=raw")) (part-arg (format "--part=%s" part-number))) @@ -462,13 +534,11 @@ You may need to restart Emacs or upgrade your notmuch package.")) ;; `notmuch-logged-error' does not return. )))) -(defun notmuch-call-notmuch-json (&rest args) - "Invoke `notmuch-command' with ARGS and return the parsed JSON output. +(defun notmuch-call-notmuch-sexp (&rest args) + "Invoke `notmuch-command' with ARGS and return the parsed S-exp output. -The returned output will represent objects using property lists -and arrays as lists. If notmuch exits with a non-zero status, -this will pop up a buffer containing notmuch's output and signal -an error." +If notmuch exits with a non-zero status, this will pop up a +buffer containing notmuch's output and signal an error." (with-temp-buffer (let ((err-file (make-temp-file "nmerr"))) @@ -478,10 +548,7 @@ an error." (notmuch-check-exit-status status (cons notmuch-command args) (buffer-string) err-file) (goto-char (point-min)) - (let ((json-object-type 'plist) - (json-array-type 'list) - (json-false 'nil)) - (json-read))) + (read (current-buffer))) (delete-file err-file))))) (defun notmuch-start-notmuch (name buffer sentinel &rest args) @@ -559,272 +626,6 @@ status." (defvar notmuch-show-process-crypto nil) (make-variable-buffer-local 'notmuch-show-process-crypto) -;; Incremental JSON parsing - -;; These two variables are internal variables to the parsing -;; routines. They are always used buffer local but need to be declared -;; globally to avoid compiler warnings. - -(defvar notmuch-json-parser nil - "Internal incremental JSON parser object: local to the buffer being parsed.") - -(defvar notmuch-json-state nil - "State of the internal JSON parser: local to the buffer being parsed.") - -(defun notmuch-json-create-parser (buffer) - "Return a streaming JSON parser that consumes input from BUFFER. - -This parser is designed to read streaming JSON whose structure is -known to the caller. Like a typical JSON parsing interface, it -provides a function to read a complete JSON value from the input. -However, it extends this with an additional function that -requires the next value in the input to be a compound value and -descends into it, allowing its elements to be read one at a time -or further descended into. Both functions can return 'retry to -indicate that not enough input is available. - -The parser always consumes input from BUFFER's point. Hence, the -caller is allowed to delete and data before point and may -resynchronize after an error by moving point." - - (list buffer - ;; Terminator stack: a stack of characters that indicate the - ;; end of the compound values enclosing point - '() - ;; Next: One of - ;; * 'expect-value if the next token must be a value, but a - ;; value has not yet been reached - ;; * 'value if point is at the beginning of a value - ;; * 'expect-comma if the next token must be a comma - 'expect-value - ;; Allow terminator: non-nil if the next token may be a - ;; terminator - nil - ;; Partial parse position: If state is 'value, a marker for - ;; the position of the partial parser or nil if no partial - ;; parsing has happened yet - nil - ;; Partial parse state: If state is 'value, the current - ;; `parse-partial-sexp' state - nil)) - -(defmacro notmuch-json-buffer (jp) `(first ,jp)) -(defmacro notmuch-json-term-stack (jp) `(second ,jp)) -(defmacro notmuch-json-next (jp) `(third ,jp)) -(defmacro notmuch-json-allow-term (jp) `(fourth ,jp)) -(defmacro notmuch-json-partial-pos (jp) `(fifth ,jp)) -(defmacro notmuch-json-partial-state (jp) `(sixth ,jp)) - -(defvar notmuch-json-syntax-table - (let ((table (make-syntax-table))) - ;; The standard syntax table is what we need except that "." needs - ;; to have word syntax instead of punctuation syntax. - (modify-syntax-entry ?. "w" table) - table) - "Syntax table used for incremental JSON parsing.") - -(defun notmuch-json-scan-to-value (jp) - ;; Helper function that consumes separators, terminators, and - ;; whitespace from point. Returns nil if it successfully reached - ;; the beginning of a value, 'end if it consumed a terminator, or - ;; 'retry if not enough input was available to reach a value. Upon - ;; nil return, (notmuch-json-next jp) is always 'value. - - (if (eq (notmuch-json-next jp) 'value) - ;; We're already at a value - nil - ;; Drive the state toward 'expect-value - (skip-chars-forward " \t\r\n") - (or (when (eobp) 'retry) - ;; Test for the terminator for the current compound - (when (and (notmuch-json-allow-term jp) - (eq (char-after) (car (notmuch-json-term-stack jp)))) - ;; Consume it and expect a comma or terminator next - (forward-char) - (setf (notmuch-json-term-stack jp) (cdr (notmuch-json-term-stack jp)) - (notmuch-json-next jp) 'expect-comma - (notmuch-json-allow-term jp) t) - 'end) - ;; Test for a separator - (when (eq (notmuch-json-next jp) 'expect-comma) - (when (/= (char-after) ?,) - (signal 'json-readtable-error (list "expected ','"))) - ;; Consume it, switch to 'expect-value, and disallow a - ;; terminator - (forward-char) - (skip-chars-forward " \t\r\n") - (setf (notmuch-json-next jp) 'expect-value - (notmuch-json-allow-term jp) nil) - ;; We moved point, so test for eobp again and fall through - ;; to the next test if there's more input - (when (eobp) 'retry)) - ;; Next must be 'expect-value and we know this isn't - ;; whitespace, EOB, or a terminator, so point must be on a - ;; value - (progn - (assert (eq (notmuch-json-next jp) 'expect-value)) - (setf (notmuch-json-next jp) 'value) - nil)))) - -(defun notmuch-json-begin-compound (jp) - "Parse the beginning of a compound value and traverse inside it. - -Returns 'retry if there is insufficient input to parse the -beginning of the compound. If this is able to parse the -beginning of a compound, it moves point past the token that opens -the compound and returns t. Later calls to `notmuch-json-read' -will return the compound's elements. - -Entering JSON objects is currently unimplemented." - - (with-current-buffer (notmuch-json-buffer jp) - ;; Disallow terminators - (setf (notmuch-json-allow-term jp) nil) - ;; Save "next" so we can restore it if there's a syntax error - (let ((saved-next (notmuch-json-next jp))) - (or (notmuch-json-scan-to-value jp) - (if (/= (char-after) ?\[) - (progn - (setf (notmuch-json-next jp) saved-next) - (signal 'json-readtable-error (list "expected '['"))) - (forward-char) - (push ?\] (notmuch-json-term-stack jp)) - ;; Expect a value or terminator next - (setf (notmuch-json-next jp) 'expect-value - (notmuch-json-allow-term jp) t) - t))))) - -(defun notmuch-json-read (jp) - "Parse the value at point in JP's buffer. - -Returns 'retry if there is insufficient input to parse a complete -JSON value (though it may still move point over separators or -whitespace). If the parser is currently inside a compound value -and the next token ends the list or object, this moves point just -past the terminator and returns 'end. Otherwise, this moves -point to just past the end of the value and returns the value." - - (with-current-buffer (notmuch-json-buffer jp) - (or - ;; Get to a value state - (notmuch-json-scan-to-value jp) - - ;; Can we parse a complete value? - (let ((complete - (if (looking-at "[-+0-9tfn]") - ;; This is a number or a keyword, so the partial - ;; parser isn't going to help us because a truncated - ;; number or keyword looks like a complete symbol to - ;; it. Look for something that clearly ends it. - (save-excursion - (skip-chars-forward "^]},: \t\r\n") - (not (eobp))) - - ;; We're looking at a string, object, or array, which we - ;; can partial parse. If we just reached the value, set - ;; up the partial parser. - (when (null (notmuch-json-partial-state jp)) - (setf (notmuch-json-partial-pos jp) (point-marker))) - - ;; Extend the partial parse until we either reach EOB or - ;; get the whole value - (save-excursion - (let ((pstate - (with-syntax-table notmuch-json-syntax-table - (parse-partial-sexp - (notmuch-json-partial-pos jp) (point-max) 0 nil - (notmuch-json-partial-state jp))))) - ;; A complete value is available if we've reached - ;; depth 0 or less and encountered a complete - ;; subexpression. - (if (and (<= (first pstate) 0) (third pstate)) - t - ;; Not complete. Update the partial parser state - (setf (notmuch-json-partial-pos jp) (point-marker) - (notmuch-json-partial-state jp) pstate) - nil)))))) - - (if (not complete) - 'retry - ;; We have a value. Reset the partial parse state and expect - ;; a comma or terminator after the value. - (setf (notmuch-json-next jp) 'expect-comma - (notmuch-json-allow-term jp) t - (notmuch-json-partial-pos jp) nil - (notmuch-json-partial-state jp) nil) - ;; Parse the value - (let ((json-object-type 'plist) - (json-array-type 'list) - (json-false nil)) - (json-read))))))) - -(defun notmuch-json-eof (jp) - "Signal a json-error if there is more data in JP's buffer. - -Moves point to the beginning of any trailing data or to the end -of the buffer if there is only trailing whitespace." - - (with-current-buffer (notmuch-json-buffer jp) - (skip-chars-forward " \t\r\n") - (unless (eobp) - (signal 'json-error (list "Trailing garbage following JSON data"))))) - -(defun notmuch-json-parse-partial-list (result-function error-function results-buf) - "Parse a partial JSON list from current buffer. - -This function consumes a JSON list from the current buffer, -applying RESULT-FUNCTION in buffer RESULT-BUFFER to each complete -value in the list. It operates incrementally and should be -called whenever the buffer has been extended with additional -data. - -If there is a syntax error, this will attempt to resynchronize -with the input and will apply ERROR-FUNCTION in buffer -RESULT-BUFFER to any input that was skipped. - -It sets up all the needed internal variables: the caller just -needs to call it with point in the same place that the parser -left it." - (let (done) - (unless (local-variable-p 'notmuch-json-parser) - (set (make-local-variable 'notmuch-json-parser) - (notmuch-json-create-parser (current-buffer))) - (set (make-local-variable 'notmuch-json-state) 'begin)) - (while (not done) - (condition-case nil - (case notmuch-json-state - ((begin) - ;; Enter the results list - (if (eq (notmuch-json-begin-compound - notmuch-json-parser) 'retry) - (setq done t) - (setq notmuch-json-state 'result))) - ((result) - ;; Parse a result - (let ((result (notmuch-json-read notmuch-json-parser))) - (case result - ((retry) (setq done t)) - ((end) (setq notmuch-json-state 'end)) - (otherwise (with-current-buffer results-buf - (funcall result-function result)))))) - ((end) - ;; Any trailing data is unexpected - (notmuch-json-eof notmuch-json-parser) - (setq done t))) - (json-error - ;; Do our best to resynchronize and ensure forward - ;; progress - (let ((bad (buffer-substring (line-beginning-position) - (line-end-position)))) - (forward-line) - (with-current-buffer results-buf - (funcall error-function "%s" bad)))))) - ;; Clear out what we've parsed - (delete-region (point-min) (point)))) - - - - (provide 'notmuch-lib) ;; Local Variables: