From: Andrew G Cohen Date: Mon, 5 Mar 2018 21:12:28 +0000 (+0800) Subject: Merge from master X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=0e48e63770f7a46c62f7c224f75a9a725f26aba8;p=emacs.git Merge from master --- 0e48e63770f7a46c62f7c224f75a9a725f26aba8 diff --cc lisp/gnus/nnir.el index 3423bc38249,0a7d8296147..70810075907 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@@ -467,8 -573,339 +467,6 @@@ Add an entry here when adding a new sea ,@(mapcar (lambda (elem) (list 'const (car elem))) nnir-engines))))) -;; Gnus glue. - -(declare-function gnus-group-topic-name "gnus-topic" ()) - -(defun gnus-group-make-nnir-group (nnir-extra-parms &optional specs) - "Create an nnir group. Prompt for a search query and determine -the groups to search as follows: if called from the *Server* -buffer search all groups belonging to the server on the current -line; if called from the *Group* buffer search any marked groups, -or the group on the current line, or all the groups under the -current topic. Calling with a prefix-arg prompts for additional -search-engine specific constraints. A non-nil `specs' arg must be -an alist with `nnir-query-spec' and `nnir-group-spec' keys, and -skips all prompting." - (interactive "P") - (let* ((group-spec - (or (cdr (assq 'nnir-group-spec specs)) - (if (gnus-server-server-name) - (list (list (gnus-server-server-name))) - (nnir-categorize - (or gnus-group-marked - (if (gnus-group-group-name) - (list (gnus-group-group-name)) - (cdr (assoc (gnus-group-topic-name) gnus-topic-alist)))) - gnus-group-server)))) - (query-spec - (or (cdr (assq 'nnir-query-spec specs)) - (apply - 'append - (list (cons 'query - (read-string "Query: " nil 'nnir-search-history))) - (when nnir-extra-parms - (mapcar - (lambda (x) - (nnir-read-parms (nnir-server-to-search-engine (car x)))) - group-spec)))))) - (gnus-group-read-ephemeral-group - (concat "nnir-" (message-unique-id)) - (list 'nnir "nnir") - nil -; (cons (current-buffer) gnus-current-window-configuration) - nil - nil nil - (list - (cons 'nnir-specs (list (cons 'nnir-query-spec query-spec) - (cons 'nnir-group-spec group-spec))) - (cons 'nnir-artlist nil))))) - -(defun gnus-summary-make-nnir-group (nnir-extra-parms) - "Search a group from the summary buffer." - (interactive "P") - (gnus-warp-to-article) - (let ((spec - (list - (cons 'nnir-group-spec - (list (list - (gnus-group-server gnus-newsgroup-name) - (list gnus-newsgroup-name))))))) - (gnus-group-make-nnir-group nnir-extra-parms spec))) - - -;; Gnus backend interface functions. - -(deffoo nnir-open-server (server &optional definitions) - ;; Just set the server variables appropriately. - (let ((backend (car (gnus-server-to-method server)))) - (if backend - (nnoo-change-server backend server definitions) - (add-hook 'gnus-summary-mode-hook 'nnir-mode) - (nnoo-change-server 'nnir server definitions)))) - -(deffoo nnir-request-group (group &optional server dont-check _info) - (nnir-possibly-change-group group server) - (let ((pgroup (gnus-group-guess-full-name-from-command-method group)) - length) - ;; Check for cached search result or run the query and cache the - ;; result. - (unless (and nnir-artlist dont-check) - (gnus-group-set-parameter - pgroup 'nnir-artlist - (setq nnir-artlist - (nnir-run-query - (gnus-group-get-parameter pgroup 'nnir-specs t)))) - (nnir-request-update-info pgroup (gnus-get-info pgroup))) - (with-current-buffer nntp-server-buffer - (if (zerop (setq length (nnir-artlist-length nnir-artlist))) - (progn - (nnir-close-group group) - (nnheader-report 'nnir "Search produced empty results.")) - (nnheader-insert "211 %d %d %d %s\n" - length ; total # - 1 ; first # - length ; last # - group)))) ; group name - nnir-artlist) - -(defvar gnus-inhibit-demon) - -(deffoo nnir-retrieve-headers (articles &optional _group _server _fetch-old) - (with-current-buffer nntp-server-buffer - (let ((gnus-inhibit-demon t) - (articles-by-group (nnir-categorize - articles nnir-article-group nnir-article-ids)) - headers) - (while (not (null articles-by-group)) - (let* ((group-articles (pop articles-by-group)) - (artgroup (car group-articles)) - (articleids (cadr group-articles)) - (artlist (sort (mapcar 'cdr articleids) '<)) - (server (gnus-group-server artgroup)) - (gnus-override-method (gnus-server-to-method server)) - parsefunc) - ;; (nnir-possibly-change-group nil server) - (erase-buffer) - (pcase (setq gnus-headers-retrieved-by - (or - (and - nnir-retrieve-headers-override-function - (funcall nnir-retrieve-headers-override-function - artlist artgroup)) - (gnus-retrieve-headers artlist artgroup nil))) - ('nov - (setq parsefunc 'nnheader-parse-nov)) - ('headers - (setq parsefunc 'nnheader-parse-head)) - (_ (error "Unknown header type %s while requesting articles \ - of group %s" gnus-headers-retrieved-by artgroup))) - (goto-char (point-min)) - (while (not (eobp)) - (let* ((novitem (funcall parsefunc)) - (artno (and novitem - (mail-header-number novitem))) - (art (car (rassq artno articleids)))) - (when art - (mail-header-set-number novitem art) - (push novitem headers)) - (forward-line 1))))) - (setq headers - (sort headers - (lambda (x y) - (< (mail-header-number x) (mail-header-number y))))) - (erase-buffer) - (mapc 'nnheader-insert-nov headers) - 'nov))) - -(defvar gnus-article-decode-hook) - -(deffoo nnir-request-article (article &optional group server to-buffer) - (nnir-possibly-change-group group server) - (if (and (stringp article) - (not (eq 'nnimap (car (gnus-server-to-method server))))) - (nnheader-report - 'nnir - "nnir-request-article only groks message ids for nnimap servers: %s" - server) - (save-excursion - (let ((article article) - query) - (when (stringp article) - (setq gnus-override-method (gnus-server-to-method server)) - (setq query - (list - (cons 'query (format "HEADER Message-ID %s" article)) - (cons 'criteria "") - (cons 'shortcut t))) - (unless (and nnir-artlist (equal query nnir-memo-query) - (equal server nnir-memo-server)) - (setq nnir-artlist (nnir-run-imap query server) - nnir-memo-query query - nnir-memo-server server)) - (setq article 1)) - (unless (zerop (nnir-artlist-length nnir-artlist)) - (let ((artfullgroup (nnir-article-group article)) - (artno (nnir-article-number article))) - (message "Requesting article %d from group %s" - artno artfullgroup) - (if to-buffer - (with-current-buffer to-buffer - (let ((gnus-article-decode-hook nil)) - (gnus-request-article-this-buffer artno artfullgroup))) - (gnus-request-article artno artfullgroup)) - (cons artfullgroup artno))))))) - -(deffoo nnir-request-move-article (article group server accept-form - &optional last _internal-move-group) - (nnir-possibly-change-group group server) - (let* ((artfullgroup (nnir-article-group article)) - (artno (nnir-article-number article)) - (to-newsgroup (nth 1 accept-form)) - (to-method (gnus-find-method-for-group to-newsgroup)) - (from-method (gnus-find-method-for-group artfullgroup)) - (move-is-internal (gnus-server-equal from-method to-method))) - (unless (gnus-check-backend-function - 'request-move-article artfullgroup) - (error "The group %s does not support article moving" artfullgroup)) - (gnus-request-move-article - artno - artfullgroup - (nth 1 from-method) - accept-form - last - (and move-is-internal - to-newsgroup ; Not respooling - (gnus-group-real-name to-newsgroup))))) - -(deffoo nnir-request-expire-articles (articles group &optional server force) - (nnir-possibly-change-group group server) - (if force - (let ((articles-by-group (nnir-categorize - articles nnir-article-group nnir-article-ids)) - not-deleted) - (while (not (null articles-by-group)) - (let* ((group-articles (pop articles-by-group)) - (artgroup (car group-articles)) - (articleids (cadr group-articles)) - (artlist (sort (mapcar 'cdr articleids) '<))) - (unless (gnus-check-backend-function 'request-expire-articles - artgroup) - (error "The group %s does not support article deletion" artgroup)) - (unless (gnus-check-server (gnus-find-method-for-group artgroup)) - (error "Couldn't open server for group %s" artgroup)) - (push (gnus-request-expire-articles - artlist artgroup force) - not-deleted))) - (sort (delq nil not-deleted) '<)) - articles)) - -(deffoo nnir-warp-to-article () - (nnir-possibly-change-group gnus-newsgroup-name) - (let* ((cur (if (> (gnus-summary-article-number) 0) - (gnus-summary-article-number) - (error "Can't warp to a pseudo-article"))) - (backend-article-group (nnir-article-group cur)) - (backend-article-number (nnir-article-number cur)) -; (quit-config (gnus-ephemeral-group-p gnus-newsgroup-name)) - ) - - ;; what should we do here? we could leave all the buffers around - ;; and assume that we have to exit from them one by one. or we can - ;; try to clean up directly - - ;;first exit from the nnir summary buffer. -; (gnus-summary-exit) - ;; and if the nnir summary buffer in turn came from another - ;; summary buffer we have to clean that summary up too. - ; (when (not (eq (cdr quit-config) 'group)) -; (gnus-summary-exit)) - (gnus-summary-read-group-1 backend-article-group t t nil - nil (list backend-article-number)))) - -(deffoo nnir-request-update-mark (_group article mark) - (let ((artgroup (nnir-article-group article)) - (artnumber (nnir-article-number article))) - (or (and artgroup - artnumber - (gnus-request-update-mark artgroup artnumber mark)) - mark))) - -(deffoo nnir-request-set-mark (group actions &optional server) - (nnir-possibly-change-group group server) - (let (mlist) - (dolist (action actions) - (cl-destructuring-bind (range action marks) action - (let ((articles-by-group (nnir-categorize - (gnus-uncompress-range range) - nnir-article-group nnir-article-number))) - (dolist (artgroup articles-by-group) - (push (list - (car artgroup) - (list (gnus-compress-sequence - (sort (cadr artgroup) '<)) - action marks)) - mlist))))) - (dolist (request (nnir-categorize mlist car cadr)) - (gnus-request-set-mark (car request) (cadr request))))) - - -(deffoo nnir-request-update-info (group info &optional server) - (nnir-possibly-change-group group server) - ;; clear out all existing marks. - (gnus-info-set-marks info nil) - (gnus-info-set-read info nil) - (let ((group (gnus-group-guess-full-name-from-command-method group)) - (articles-by-group - (nnir-categorize - (gnus-uncompress-range (cons 1 (nnir-artlist-length nnir-artlist))) - nnir-article-group nnir-article-ids))) - (gnus-set-active group - (cons 1 (nnir-artlist-length nnir-artlist))) - (while (not (null articles-by-group)) - (let* ((group-articles (pop articles-by-group)) - (articleids (reverse (cadr group-articles))) - (group-info (gnus-get-info (car group-articles))) - (marks (gnus-info-marks group-info)) - (read (gnus-info-read group-info))) - (gnus-info-set-read - info - (gnus-add-to-range - (gnus-info-read info) - (delq nil - (mapcar - #'(lambda (art) - (when (gnus-member-of-range (cdr art) read) (car art))) - articleids)))) - (dolist (mark marks) - (cl-destructuring-bind (type . range) mark - (gnus-add-marked-articles - group type - (delq nil - (mapcar - #'(lambda (art) - (when (gnus-member-of-range (cdr art) range) (car art))) - articleids))))))))) - - -(deffoo nnir-close-group (group &optional server) - (nnir-possibly-change-group group server) - (let ((pgroup (gnus-group-guess-full-name-from-command-method group))) - (when (and nnir-artlist (not (gnus-ephemeral-group-p pgroup))) - (gnus-group-set-parameter pgroup 'nnir-artlist nnir-artlist)) - (setq nnir-artlist nil) - (when (gnus-ephemeral-group-p pgroup) - (gnus-kill-ephemeral-group pgroup) - (setq gnus-ephemeral-servers - (delq (assq 'nnir gnus-ephemeral-servers) - gnus-ephemeral-servers))))) -;; (gnus-opened-servers-remove -;; (car (assoc '(nnir "nnir-ephemeral" (nnir-address "nnir")) -;; gnus-opened-servers)))) - - -- -- (defmacro nnir-add-result (dirnam artno score prefix server artlist) "Ask `nnir-compose-result' to construct a result vector, and if it is non-nil, add it to artlist."