From 4f2ca8e5506de6f5be92bf50c45d5ed3987b5458 Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Tue, 27 Jan 2015 05:46:15 +0000 Subject: [PATCH] lisp/gnus/nnir.el (nnir-run-imap): Enable non-ASCII IMAP searches --- lisp/gnus/ChangeLog | 2 ++ lisp/gnus/nnir.el | 84 ++++++++++++++++++++++++++++++--------------- 2 files changed, 59 insertions(+), 27 deletions(-) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index b4c5cea97c..0d105a9b16 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,5 +1,7 @@ 2015-01-27 Eric Abrahamsen + * nnir.el (nnir-run-imap): Enable non-ASCII IMAP searches. + * nnmairix.el ("nnmairix"): Declare nnmairix as virtual. * gnus-bcklg.el (gnus-backlog-enter-article): No virtual groups should diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index 08ca7c7e06..dcb69aabcd 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@ -284,6 +284,8 @@ is `(valuefunc member)'." (eval-when-compile (autoload 'nnimap-buffer "nnimap") (autoload 'nnimap-command "nnimap") + (autoload 'nnimap-capability "nnimap") + (autoload 'nnimap-wait-for-line "nnimap") (autoload 'nnimap-change-group "nnimap") (autoload 'nnimap-make-thread-query "nnimap") (autoload 'gnus-registry-action "gnus-registry") @@ -968,33 +970,52 @@ details on the language and supported extensions." (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))) + (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) + (literal+ (nnimap-capability "LITERAL+")) + (search (split-string + (if (string= criteria "") + qstring + (nnir-imap-make-query + criteria qstring)) + "\n")) + (coding (upcase + (replace-regexp-in-string + "-\\(unix\\|dos\\|mac\\)" "" + (symbol-name + (cdr default-process-coding-system))))) + call result) + (setq call (nnimap-send-command + "UID SEARCH CHARSET %s %s" coding (pop search))) + (while search ; Non-ascii search terms + (unless literal+ + (nnimap-wait-for-line "^\\+\\(.*\\)\n")) + (process-send-string (get-buffer-process (current-buffer)) (pop search)) + (process-send-string (get-buffer-process (current-buffer)) + (if (nnimap-newlinep nnimap-object) + "\n" + "\r\n"))) + (setq result (nnimap-get-response call)) + (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)))))) (defun nnir-imap-make-query (criteria qstring) @@ -1062,6 +1083,10 @@ In future the following will be added to the language: ;; Composite term: just the fax, mam ((eq (car-safe expr) 'not) (format "NOT (%s)" (nnir-imap-query-to-imap criteria (rest expr)))) + ;; Composite term: non-ascii search term + ((numberp (car-safe expr)) + (format "%s {%d%s}\n%s" criteria (car expr) + (if literal+ "+" "") (second expr))) ;; Composite term: just expand it all. ((and (not (null expr)) (listp expr)) (format "(%s)" (nnir-imap-query-to-imap criteria expr))) @@ -1108,6 +1133,11 @@ that the search language can then understand and use." ((eq term 'and) 'and) ;; negated term ((eq term 'not) (list 'not (nnir-imap-next-expr))) + ;; non-ascii search string + ((and (stringp term) + (not (= (string-bytes term) + (length term)))) + (list (string-bytes term) term)) ;; generic term (t term)))) -- 2.39.2