* [RFC] Generalized search queries for Gnus/nnir
@ 2017-03-31 22:57 Eric Abrahamsen
2017-03-31 23:12 ` Eric Abrahamsen
0 siblings, 1 reply; 2+ messages in thread
From: Eric Abrahamsen @ 2017-03-31 22:57 UTC (permalink / raw)
To: ding; +Cc: emacs-devel
The discussion about nnir last week prompted me to finish up something
I've had half-done for a while: generalized nnir search queries.
What I mean is a single search syntax for all searches, which is then
transformed into backend-specific search strings. I did this by stealing
the IMAP parsing mini-language, and generalizing it. Each backend would
then know how to turn the parsed queries into usable strings.
Advantages:
- You only have to remember one search syntax
- You can search groups from different backends at once, with a single
query. Each backend is responsible for making what sense it can of
the search query, and silently ignoring criteria it can't use.
Characteristics:
- Single words or quoted phrases
- Key/value queries that look like key:value.
- Implicit and, explicit or
- Negation with a "not" keyword, or key prefixed with "-"
- Parenthesized sub-expressions
- Abbreviated keywords
- Reasonable good mark/flag parsing
- Rudimentary relative date parsing
- A "contacts" keyword (requires setup)
The attached patch is a first stab at this. It implements the parsing,
and the transformation for the IMAP search backends. I haven't done the
other backends yet, I'll wait and see if this is basically acceptable
before doing that work. If you eval this patch, it will break your
searching of other groups.
There is ugliness in here, and no doubt plenty of bugs, and also lots of
things to argue about. But if it seems like the general thrust is
acceptable, I'd like to push a scratch branch.
Code speaks louder than words, so here are some examples:
#+BEGIN_SRC elisp
(defalias 'n-p 'nnir-search-parse-query)
(fset 'nnir-imap (apply-partially 'nnir-search-transform-top-level 'imap))
(n-p "from:bob")
-> ((from . "bob"))
(nnir-imap (n-p "from:bob"))
-> "FROM bob"
(n-p "f:bob")
-> ((from . "bob"))
(n-p "recipient:bob \"bob you're fired\"")
-> ((or ((to . "bob") (cc . "bob") (bcc . "bob")))
"bob you're fired")
(n-p "after:1m")
-> ((since 22710 29040))
(nnir-imap (n-p "date:tuesday"))
-> "ON 28-Mar-2017"
(n-p "(f:jane sub:holiday) not (f:mom sub:thanksgiving)")
-> (((from . "jane") (subject . "holiday"))
(not ((from . "mom") (subject . "thanksgiving"))))
(setq nnir-search-contact-sources
'(("bob" "bob1@somewhere.org" "bob2@elsewhere.com")))
(n-p "contact-from:bob")
-> ((or (from . "bob1@somewhere.org") (from . "bob2@elsewhere.com")))
(n-p "-mark:read")
-> ((not (mark . "read")))
(nnir-imap (n-p "-mark:read or since:2017"))
-> "OR UNSEEN SINCE 1-Jan-2017"
(nnir-imap (n-p "X-No-Such-Header:spam"))
-> "HEADER X-No-Such-Header spam"
#+END_SRC
^ permalink raw reply [flat|nested] 2+ messages in thread
* Re: [RFC] Generalized search queries for Gnus/nnir
2017-03-31 22:57 [RFC] Generalized search queries for Gnus/nnir Eric Abrahamsen
@ 2017-03-31 23:12 ` Eric Abrahamsen
0 siblings, 0 replies; 2+ messages in thread
From: Eric Abrahamsen @ 2017-03-31 23:12 UTC (permalink / raw)
To: ding; +Cc: emacs-devel
[-- Attachment #1: Type: text/plain, Size: 54 bytes --]
I knew I was going to forget the attach the patch...
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: nnirsearch.patch --]
[-- Type: text/x-patch, Size: 27483 bytes --]
diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el
index 9640f2c746..713c2b8f7d 100644
--- a/lisp/gnus/nnir.el
+++ b/lisp/gnus/nnir.el
@@ -326,15 +326,6 @@ nnir-retrieve-headers-override-function
:type '(choice (const :tag "gnus-retrieve-headers" nil) function)
:group 'nnir)
-(defcustom nnir-imap-default-search-key "whole message"
- "The default IMAP search key for an nnir search. Must be one of
- the keys in `nnir-imap-search-arguments'. To use raw imap queries
- by default set this to \"imap\"."
- :version "24.1"
- :type `(choice ,@(mapcar (lambda (elem) (list 'const (car elem)))
- nnir-imap-search-arguments))
- :group 'nnir)
-
(defcustom nnir-swish++-configuration-file
(expand-file-name "~/Mail/swish++.conf")
"Configuration file for swish++."
@@ -603,7 +594,7 @@ gnus-group-make-nnir-group
(apply
'append
(list (cons 'query
- (read-string "Query: " nil 'nnir-search-history)))
+ (nnir-read-and-parse-query)))
(when nnir-extra-parms
(mapcar
(lambda (x)
@@ -621,6 +612,16 @@ gnus-group-make-nnir-group
(cons 'nnir-group-spec group-spec)))
(cons 'nnir-artlist nil)))))
+(defun nnir-read-and-parse-query (&optional prompt history)
+ "Read a query string, and return parsed query.
+
+Optional arguments PROMPT and HISTORY are passed to
+`read-string'."
+ (let ((prompt (or prompt "Query: "))
+ (history (or history 'nnir-search-history)))
+ (nnir-search-parse-query
+ (read-string prompt nil history))))
+
(defun gnus-summary-make-nnir-group (nnir-extra-parms)
"Search a group from the summary buffer."
(interactive "P")
@@ -942,231 +943,502 @@ nnir-compose-result
(string-to-number article))
(string-to-number score)))))
-;;; Search Engine Interfaces:
+;;; Search language
-(autoload 'nnimap-change-group "nnimap")
-(declare-function nnimap-buffer "nnimap" ())
-(declare-function nnimap-command "nnimap" (&rest args))
+;; This "language" was generalized from the original IMAP search query
+;; parsing routine.
-;; imap interface
-(defun nnir-run-imap (query srv &optional groups)
- "Run a search against an IMAP back-end server.
-This uses a custom query language parser; see `nnir-imap-make-query' for
-details on the language and supported extensions."
- (save-excursion
- (let ((qstring (cdr (assq 'query query)))
- (server (cadr (gnus-server-to-method srv)))
- (defs (nth 2 (gnus-server-to-method srv)))
- (criteria (or (cdr (assq 'criteria query))
- (cdr (assoc nnir-imap-default-search-key
- nnir-imap-search-arguments))))
- (gnus-inhibit-demon t)
- (groups (or groups (nnir-get-active srv))))
- (message "Opening server %s" server)
- (apply
- 'vconcat
- (catch 'found
- (mapcar
- #'(lambda (group)
- (let (artlist)
- (condition-case ()
- (when (nnimap-change-group
- (gnus-group-short-name group) server)
- (with-current-buffer (nnimap-buffer)
- (message "Searching %s..." group)
- (let ((arts 0)
- (result (nnimap-command "UID SEARCH %s"
- (if (string= criteria "")
- qstring
- (nnir-imap-make-query
- criteria qstring)))))
- (mapc
- (lambda (artnum)
- (let ((artn (string-to-number artnum)))
- (when (> artn 0)
- (push (vector group artn 100)
- artlist)
- (when (assq 'shortcut query)
- (throw 'found (list artlist)))
- (setq arts (1+ arts)))))
- (and (car result)
- (cdr (assoc "SEARCH" (cdr result)))))
- (message "Searching %s... %d matches" group arts)))
- (message "Searching %s...done" group))
- (quit nil))
- (nreverse artlist)))
- groups))))))
+(defcustom nnir-search-expandable-keys
+ '("from" "subject" "to" "cc" "bcc" "body" "recipient" "date"
+ "mark" "contact" "contact-from" "contact-to" "before" "after"
+ "larger" "smaller" "attachment" "text" "since")
+ "A list of strings representing expandable search keys.
-(defun nnir-imap-make-query (criteria qstring)
- "Parse the query string and criteria into an appropriate IMAP search
-expression, returning the string query to make.
+\"Expandable\" simply means the key can be abbreviated while
+typing in search queries, ie \"subject\" could be entered as
+\"sub\" or even \"s\". Ambiguous abbreviations will raise an
+error."
+ :group 'nnir
+ :version "26.1"
+ :type '(repeat string))
-This implements a little language designed to return the expected results
-to an arbitrary query string to the end user.
+(defcustom nnir-search-date-keys
+ '("date" "before" "after" "on" "senton" "sentbefore" "sentsince" "since")
+ "A list of keywords whose value should be parsed as a date.
-The search is always case-insensitive, as defined by RFC2060, and supports
-the following features (inspired by the Google search input language):
+See the docstring of `nnir-search-parse-query' for information on
+date parsing."
-Automatic \"and\" queries
- If you specify multiple words then they will be treated as an \"and\"
- expression intended to match all components.
+ :group 'nnir
+ :version "26.1"
+ :type '(repeat string))
-Phrase searches
- If you wrap your query in double-quotes then it will be treated as a
- literal string.
+(defcustom nnir-search-contact-sources nil
+ "A list of sources used to search for messages from contacts.
-Negative terms
- If you precede a term with \"-\" then it will negate that.
+Each list element can be either a function, or an alist.
+Functions should accept a search string, and return a list of
+email addresses of matching contacts. An alist should map single
+strings to lists of mail addresses, usable as search keys in mail
+headers."
+ :group 'nnir
+ :version "26.1"
+ :type '(repeat (choice function
+ (alist
+ :key-type string
+ :value-type (repeat string)))))
-\"OR\" queries
- If you include an upper-case \"OR\" in your search it will cause the
- term before it and the term after it to be treated as alternatives.
+(defun nnir-search-parse-query (string)
+ "Turn STRING into an s-expression based query.
-In future the following will be added to the language:
- * support for date matches
- * support for location of text matching within the query
- * from/to/etc headers
- * additional search terms
- * flag based searching
- * anything else that the RFC supports, basically."
- ;; Walk through the query and turn it into an IMAP query string.
- (nnir-imap-query-to-imap criteria (nnir-imap-parse-query qstring)))
+The resulting query structure is passed to the various search
+backends, each of which adapts it as needed.
+The search \"language\" is essentially a series of key:value
+expressions. Key is most often a mail header, but there are
+other keys. Value is a string, quoted if it contains spaces.
+Key and value are separated by a colon, no space. Expressions
+are implictly ANDed; the \"or\" keyword can be used to
+OR. \"not\" will negate the following expression, or keys can be
+prefixed with a \"-\". Parenthetical groups work as expected.
-(defun nnir-imap-query-to-imap (criteria query)
- "Turn a s-expression format query into IMAP."
- (mapconcat
- ;; Turn the expressions into IMAP text
- (lambda (item)
- (nnir-imap-expr-to-imap criteria item))
- ;; The query, already in s-expr format.
- query
- ;; Append a space between each expression
- " "))
+A key that matches the name of a mail header will search that
+header.
+Search keys can be abbreviated so long as they remains
+unambiguous, ie \"f\" will search the \"from\" header.
-(defun nnir-imap-expr-to-imap (criteria expr)
- "Convert EXPR into an IMAP search expression on CRITERIA"
- ;; What sort of expression is this, eh?
- (cond
- ;; Simple string term
- ((stringp expr)
- (format "%s %S" criteria expr))
- ;; Trivial term: and
- ((eq expr 'and) nil)
- ;; Composite term: or expression
- ((eq (car-safe expr) 'or)
- (format "OR %s %s"
- (nnir-imap-expr-to-imap criteria (nth 1 expr))
- (nnir-imap-expr-to-imap criteria (nth 2 expr))))
- ;; Composite term: just the fax, mam
- ((eq (car-safe expr) 'not)
- (format "NOT (%s)" (nnir-imap-query-to-imap criteria (cdr expr))))
- ;; Composite term: just expand it all.
- ((consp expr)
- (format "(%s)" (nnir-imap-query-to-imap criteria expr)))
- ;; Complex value, give up for now.
- (t (error "Unhandled input: %S" expr))))
-
-
-(defun nnir-imap-parse-query (string)
- "Turn STRING into an s-expression based query based on the IMAP
-query language as defined in `nnir-imap-make-query'.
-
-This involves turning individual tokens into higher level terms
-that the search language can then understand and use."
+Other keys:
+
+\"address\" will search all sender and recipient headers.
+
+\"recipient\" will search \"To\", \"Cc\", and \"Bcc\".
+
+\"before\" will search messages sent before the specified
+date (date specifications to come later). Date is exclusive.
+
+\"after\" (or its synonym \"since\") will search messages sent
+after the specified date. Date is inclusive.
+
+\"mark\" will search messages that have some sort of mark.
+Likely values include \"flag\", \"seen\", \"read\", \"replied\".
+At some point this should also be used to search marks in the
+Gnus registry. Also should allow Gnus marks, ie \"mark:!\".
+
+\"contact\" will search messages to/from a contact. Contact
+management packages must push a function onto
+`nnir-search-contact-sources', the docstring of which see, for
+this to work.
+
+\"contact-from\" does what you'd expect.
+
+\"contact-to\" searches the same headers as \"recipient\".
+
+Other keys can be specified, provided that the search backends
+know how to interpret them.
+
+Date values (any key in `nnir-search-date-keys') can be provided
+in any format that `parse-time-string' can parse (note that this
+can produce weird results). Dates with missing bits will be
+interpreted as the most recent occurance thereof (ie \"march 03\"
+is the most recent March 3rd). Lastly, relative specifications
+such as 1d (one day ago) are understood. This also accepts w, m,
+and y. m is assumed to be 30 days.
+
+This function will accept pretty much anything as input. Its
+only job is to parse the query into a sexp, and pass that on --
+it is the job of the search backends to make sense of the
+structured query. Malformed or invalid queries will typically be
+silently ignored, the only exception being search keys so
+abbreviated as to be ambiguous."
(with-temp-buffer
;; Set up the parsing environment.
(insert string)
(goto-char (point-min))
;; Now, collect the output terms and return them.
(let (out)
- (while (not (nnir-imap-end-of-input))
- (push (nnir-imap-next-expr) out))
+ (while (not (nnir-query-end-of-input))
+ (push (nnir-query-next-expr) out))
(reverse out))))
-
-(defun nnir-imap-next-expr (&optional count)
+(defun nnir-query-next-expr (&optional count halt)
"Return the next expression from the current buffer."
- (let ((term (nnir-imap-next-term count))
- (next (nnir-imap-peek-symbol)))
+ (let ((term (nnir-query-next-term count))
+ (next (nnir-query-peek-symbol)))
;; Are we looking at an 'or' expression?
(cond
;; Handle 'expr or expr'
- ((eq next 'or)
- (list 'or term (nnir-imap-next-expr 2)))
+ ((and (eq next 'or)
+ (null halt))
+ (list 'or term (nnir-query-next-expr 2)))
;; Anything else
(t term))))
-
-(defun nnir-imap-next-term (&optional count)
+(defun nnir-query-next-term (&optional count)
"Return the next TERM from the current buffer."
- (let ((term (nnir-imap-next-symbol count)))
+ (let ((term (nnir-query-next-symbol count)))
;; What sort of term is this?
(cond
- ;; and -- just ignore it
- ((eq term 'and) 'and)
;; negated term
- ((eq term 'not) (list 'not (nnir-imap-next-expr)))
+ ((eq term 'not) (list 'not (nnir-query-next-expr nil 'halt)))
;; generic term
(t term))))
-
-(defun nnir-imap-peek-symbol ()
+(defun nnir-query-peek-symbol ()
"Return the next symbol from the current buffer, but don't consume it."
(save-excursion
- (nnir-imap-next-symbol)))
+ (nnir-query-next-symbol)))
-(defun nnir-imap-next-symbol (&optional count)
+(defun nnir-query-next-symbol (&optional count)
"Return the next symbol from the current buffer, or nil if we are
at the end of the buffer. If supplied COUNT skips some symbols before
returning the one at the supplied position."
(when (and (numberp count) (> count 1))
- (nnir-imap-next-symbol (1- count)))
+ (nnir-query-next-symbol (1- count)))
(let ((case-fold-search t))
;; end of input stream?
- (unless (nnir-imap-end-of-input)
+ (unless (nnir-query-end-of-input)
;; No, return the next symbol from the stream.
(cond
- ;; negated expression -- return it and advance one char.
+ ;; Negated expression -- return it and advance one char.
((looking-at "-") (forward-char 1) 'not)
- ;; quoted string
- ((looking-at "\"") (nnir-imap-delimited-string "\""))
- ;; list expression -- we parse the content and return this as a list.
+ ;; List expression -- we parse the content and return this as a list.
((looking-at "(")
- (nnir-imap-parse-query (nnir-imap-delimited-string ")")))
- ;; keyword input -- return a symbol version
+ (nnir-search-parse-query (nnir-query-return-string ")")))
+ ;; Keyword input -- return a symbol version.
((looking-at "\\band\\b") (forward-char 3) 'and)
((looking-at "\\bor\\b") (forward-char 2) 'or)
((looking-at "\\bnot\\b") (forward-char 3) 'not)
- ;; Simple, boring keyword
- (t (let ((start (point))
- (end (if (search-forward-regexp "[[:blank:]]" nil t)
- (prog1
- (match-beginning 0)
- ;; unskip if we hit a non-blank terminal character.
- (when (string-match "[^[:blank:]]" (match-string 0))
- (backward-char 1)))
- (goto-char (point-max)))))
- (buffer-substring start end)))))))
-
-(defun nnir-imap-delimited-string (delimiter)
- "Return a delimited string from the current buffer."
+ ;; Plain string, no keyword
+ ((looking-at "\"?\\b[^:]+\\([[:blank:]]\\|\\'\\)")
+ (nnir-query-return-string
+ (when (looking-at "\"") "\"")))
+ ;; Assume a K:V expression.
+ (t (let ((key (nnir-query-expand-key
+ (buffer-substring
+ (point)
+ (progn
+ (re-search-forward ":" (point-at-eol) t)
+ (1- (point))))))
+ (value (nnir-query-return-string
+ (when (looking-at "\"") "\""))))
+ (nnir-query-parse-kv key value)))))))
+
+(defun nnir-query-parse-kv (key value)
+ "Handle KEY and VALUE, parsing and expanding as necessary.
+
+This may result in (key value) being turned into a larger query
+structure.
+
+In the simplest case, they are simply consed together. KEY comes
+in as a string, goes out as a symbol."
+ (let (return)
+ (cond
+ ((member key nnir-search-date-keys)
+ (when (string= "after" key)
+ (setq key "since"))
+ (setq value (nnir-query-parse-date value)))
+ ((string-match-p "contact" key)
+ (setq return (nnir-query-parse-contact key value)))
+ ((member key '("address" "recipient"))
+ (setq return (list 'or (nnir-query-parse-multi key value)))))
+ (or return
+ (cons (intern key) value))))
+
+(defun nnir-query-parse-date (value)
+ "Interpret VALUE as a date specification.
+
+See the docstring of `nnir-search-parse-query' for details.
+
+The result is an absolute time value."
+ ;; In pretty much all cases, we'll want time to start at
+ ;; midnight.
+ (let ((now (append '(0 0 0)
+ (seq-subseq (decode-time (current-time))
+ 3)))
+ ;; Time parsing doesn't seem to work with slashes.
+ (value (replace-regexp-in-string "/" "-" value)))
+ ;; Check for relative time parsing.
+ (if (string-match "\\([[:digit:]]+\\)\\([dwmy]\\)" value)
+ (time-subtract
+ (apply #'encode-time now)
+ (days-to-time
+ (* (string-to-number (match-string 1 value))
+ (cdr (assoc (match-string 2 value)
+ '(("d" . 1)
+ ("w" . 7)
+ ("m" . 30)
+ ("y" . 365)))))))
+ ;; Otherwise, do the gross parsing.
+
+ ;; (SEC MIN HOUR DAY MON YEAR DOW DST TZ)
+ (let ((d-time (append '(0 0 0)
+ (seq-subseq (parse-time-string value)
+ 3))))
+ (if (seq-every-p #'integerp (seq-subseq d-time 3 6))
+ ;; VALUE is more or less a date.
+ (apply #'encode-time d-time)
+ ;; VALUE only contains some elements, interpret them
+ ;; relative to now. If DOW is given, handle that specially.
+ (if (and (seq-elt d-time 6) (null (seq-elt d-time 3)))
+ (time-subtract (apply #'encode-time now)
+ (days-to-time
+ (+ (if (> (seq-elt d-time 6)
+ (seq-elt now 6))
+ 7 0)
+ (- (seq-elt now 6) (seq-elt d-time 6)))))
+ ;; Set nil values to 1, 1, current-year.
+ (unless (seq-elt d-time 3)
+ (setf (seq-elt d-time 3) 1))
+ (unless (seq-elt d-time 4)
+ (setf (seq-elt d-time 4) 1))
+ (unless (seq-elt d-time 5)
+ (setf (seq-elt d-time 5)
+ (seq-elt now 5)))
+ ;; Fiddle with the date until it's in the past. There
+ ;; must be a way to combine all these steps.
+ (unless (< (seq-elt d-time 5)
+ (seq-elt now 5))
+ (when (< (seq-elt now 3)
+ (seq-elt d-time 3))
+ (cl-decf (seq-elt d-time 4)))
+ (cond ((zerop (seq-elt d-time 4))
+ (setf (seq-elt d-time 4) 1)
+ (cl-decf (seq-elt d-time 5)))
+ ((< (seq-elt now 4)
+ (seq-elt d-time 4))
+ (cl-decf (seq-elt d-time 5)))))
+ (apply #'encode-time d-time)))))))
+
+(defun nnir-query-parse-contact (key value)
+ "Handle VALUE as the name of a contact.
+
+Runs VALUE through the elements of
+`nnir-search-contact-sources' until one of them returns a list
+of email addresses. Turns those addresses into an appropriate
+chunk of query syntax."
+ (let ((funcs (or (copy-sequence nnir-search-contact-sources)
+ (error "No functions for handling contacts.")))
+ func addresses)
+ (while (and (setq func (pop funcs))
+ (null addresses))
+ (setq addresses (if (functionp func)
+ (funcall func value)
+ (when (string= value (car func))
+ (cdr func)))))
+ (unless addresses
+ (setq addresses (list value)))
+ ;; Simplest case: single From address.
+ (if (and (null (cdr addresses))
+ (equal key "contact-from"))
+ (cons 'from (car addresses))
+ (cons
+ 'or
+ (mapcan
+ (lambda (a)
+ (pcase key
+ ("contact-from"
+ (list (cons 'from a)))
+ ("contact-to"
+ (nnir-query-parse-multi "recipient" a))
+ ("contact"
+ (nnir-query-parse-multi "address" a))))
+ addresses)))))
+
+(defun nnir-query-parse-multi (key value)
+ "Parse a KEY and VALUE where KEY is expected to return multiple
+ search clauses.
+
+Ie, \"recipient\" should expand to \"To\", \"Cc,\" and \"Bcc\".
+
+All resulting clauses will be ORed together."
+ (pcase key
+ ("recipient"
+ (list `(to . ,value) `(cc . ,value) `(bcc . ,value)))
+ ("address"
+ (cons `(from . ,value)
+ (nnir-query-parse-multi "recipient" value)))))
+
+(defun nnir-query-expand-key (key)
+ "Attempt to expand KEY to a full keyword."
+ (let ((bits (split-string key "-"))
+ out-bits comp)
+ (if (try-completion (car bits) nnir-search-expandable-keys)
+ (progn
+ (while (setq bit (pop bits))
+ (setq comp (try-completion bit nnir-search-expandable-keys))
+ (if (stringp comp)
+ (if (and (equal bit comp)
+ (null (member comp nnir-search-expandable-keys)))
+ (error "Ambiguous keyword: %s" key)
+ (push comp out-bits))
+ (push bit out-bits)))
+ (mapconcat #'identity (reverse out-bits) "-"))
+ key)))
+
+(defun nnir-query-return-string (&optional delimiter)
+ "Return a string from the current buffer.
+
+If DELIMITER is given, return everything between point and the
+next occurance of DELIMITER. Otherwise, return one word."
(let ((start (point)) end)
- (forward-char 1) ; skip the first delimiter.
- (while (not end)
- (unless (search-forward delimiter nil t)
- (error "Unmatched delimited input with %s in query" delimiter))
- (let ((here (point)))
- (unless (equal (buffer-substring (- here 2) (- here 1)) "\\")
- (setq end (point)))))
- (buffer-substring (1+ start) (1- end))))
-
-(defun nnir-imap-end-of-input ()
+ (if delimiter
+ (progn
+ (forward-char 1) ; skip the first delimiter.
+ (while (not end)
+ (unless (search-forward delimiter nil t)
+ (error "Unmatched delimited input with %s in query" delimiter))
+ (let ((here (point)))
+ (unless (equal (buffer-substring (- here 2) (- here 1)) "\\")
+ (setq end (1- (point))
+ start (1+ start))))))
+ (setq end (progn (re-search-forward "\\([[:blank:]]+\\|$\\)" (point-max) t)
+ (match-beginning 0))))
+ (buffer-substring start end)))
+
+(defun nnir-query-end-of-input ()
"Are we at the end of input?"
(skip-chars-forward "[[:blank:]]")
(looking-at "$"))
+;;; Search query transformation
+
+;; The transformation of sexp queries into backend-specific search
+;; strings is done partially with generic functions.
+
+(cl-defgeneric nnir-search-transform-top-level (backend expression)
+ "Transform sexp EXPRESSION into a string search query usable by BACKEND.
+
+Responsible for handling and, or, and parenthetical expressions.")
+
+(cl-defgeneric nnir-search-transform-expression (backend expression)
+ "Transform a basic EXPRESSION into a string usable by BACKEND.")
+
+;;; Search Engine Interfaces:
+
+(autoload 'nnimap-change-group "nnimap")
+(declare-function nnimap-buffer "nnimap" ())
+(declare-function nnimap-command "nnimap" (&rest args))
+
+;; imap interface
+(defun nnir-run-imap (query srv &optional groups)
+ "Run a search against an IMAP back-end server."
+ (save-excursion
+ (let ((qstring (nnir-search-transform-top-level
+ 'imap (cdr (assq 'query query))))
+ (server (cadr (gnus-server-to-method srv)))
+ (defs (nth 2 (gnus-server-to-method srv)))
+ (gnus-inhibit-demon t)
+ (groups (or groups (nnir-get-active srv))))
+ (message "Opening server %s" server)
+ (apply
+ 'vconcat
+ (catch 'found
+ (mapcar
+ #'(lambda (group)
+ (let (artlist)
+ (condition-case ()
+ (when (nnimap-change-group
+ (gnus-group-short-name group) server)
+ (with-current-buffer (nnimap-buffer)
+ (message "Searching %s..." group)
+ (let ((arts 0)
+ (result (nnimap-command "UID SEARCH %s"
+ qstring)))
+ (mapc
+ (lambda (artnum)
+ (let ((artn (string-to-number artnum)))
+ (when (> artn 0)
+ (push (vector group artn 100)
+ artlist)
+ (when (assq 'shortcut query)
+ (throw 'found (list artlist)))
+ (setq arts (1+ arts)))))
+ (and (car result)
+ (cdr (assoc "SEARCH" (cdr result)))))
+ (message "Searching %s... %d matches" group arts)))
+ (message "Searching %s...done" group))
+ (quit nil))
+ (nreverse artlist)))
+ groups))))))
+
+(defvar nnir-imap-search-keys
+ '(body cc from header keyword larger smaller subject text to uid)
+ "Known IMAP search keys, excluding booleans and date keys.")
+
+(cl-defmethod nnir-search-transform-top-level ((backend (eql imap))
+ (query list))
+ (mapconcat
+ (lambda (item)
+ ;; Need to catch parenthesized expressions, using a
+ ;; transform-expression method.
+ (nnir-search-transform-expression backend item))
+ query
+ " "))
+
+(cl-defmethod nnir-search-transform-expression ((_ (eql imap))
+ (expr string))
+ (format "TEXT %s" expr))
+
+(cl-defmethod nnir-search-transform-expression ((_ (eql imap))
+ (expr (eql and)))
+ nil)
+
+(cl-defmethod nnir-search-transform-expression ((backend (eql imap))
+ (expr (head or)))
+ (format "OR %s %s"
+ (nnir-search-transform-expression backend (nth 1 expr))
+ (nnir-search-transform-expression backend (nth 2 expr))))
+
+(cl-defmethod nnir-search-transform-expression ((backend (eql imap))
+ (expr (head not)))
+ "Transform IMAP NOT.
+
+If the term to be negated is a flag, then use the appropriate UN*
+boolean instead."
+ (if (eql (caadr expr) 'mark)
+ (if (string= (cdadr expr) "new")
+ "OLD"
+ (format "UN%s" (nnir-imap-handle-flag (cdadr expr))))
+ (format "NOT %s"
+ (nnir-search-transform-expression backend (cadr expr)))))
+
+(cl-defmethod nnir-search-transform-expression ((backend (eql imap))
+ (expr (head mark)))
+ (nnir-imap-handle-flag (cdr expr)))
+
+(cl-defmethod nnir-search-transform-expression ((backend (eql imap))
+ (expr list))
+ ;; Search keyword. All IMAP search keywords that take a value are
+ ;; supported directly. Keywords that are boolean are supported
+ ;; through other means (usually the "mark" keyword).
+ (when (eql (car expr) 'date)
+ (setf (car expr) 'on))
+ (cond
+ ((consp (car expr))
+ (format "(%s)" (nnir-search-transform-top-level backend expr)))
+ ((memq (car expr) nnir-imap-search-keys)
+ (format "%s %s"
+ (upcase (symbol-name (car expr)))
+ (cdr expr)))
+ ((memq (car expr) '(before since on sentbefore senton sentsince))
+ (format "%s %s"
+ (upcase (symbol-name (car expr)))
+ (format-time-string "%e-%b-%Y" (cdr expr))))
+ ;; Treat what can't be handled as a HEADER search
+ (t (format "HEADER %s %s" (car expr) (cdr expr)))))
+
+(defun nnir-imap-handle-flag (flag)
+ "Make sure string FLAG is something IMAP will recognize."
+ ;; What else?
+ (setq flag
+ (pcase flag
+ ("flag" "flagged")
+ ("read" "seen")
+ (_ flag)))
+ (if (member flag '("seen" "answered" "deleted" "draft" "flagged"))
+ (upcase flag)
+ ""))
;; Swish++ interface.
;; -cc- Todo
@@ -1893,7 +2165,7 @@ nnir-request-create-group
(query-spec
(or (cdr (assq 'nnir-query-spec specs))
(list (cons 'query
- (read-string "Query: " nil 'nnir-search-history)))))
+ (nnir-read-and-parse-query)))))
(group-spec
(or (cdr (assq 'nnir-group-spec specs))
(list (list (read-string "Server: " nil nil)))))
^ permalink raw reply [flat|nested] 2+ messages in thread
end of thread, other threads:[~2017-03-31 23:12 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2017-03-31 22:57 [RFC] Generalized search queries for Gnus/nnir Eric Abrahamsen
2017-03-31 23:12 ` Eric Abrahamsen
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for NNTP newsgroup(s).