]> git.eshelyaron.com Git - emacs.git/commitdiff
Merge from master
authorAndrew G Cohen <cohen@andy.bu.edu>
Mon, 5 Mar 2018 21:12:28 +0000 (05:12 +0800)
committerAndrew G Cohen <cohen@andy.bu.edu>
Mon, 5 Mar 2018 21:12:28 +0000 (05:12 +0800)
1  2 
lisp/gnus/gnus-group.el
lisp/gnus/gnus-sum.el
lisp/gnus/gnus.el
lisp/gnus/nnir.el

Simple merge
Simple merge
Simple merge
index 3423bc3824966808aadeea9bfca79eb53ebc7ca0,0a7d82961476995ebab0148a79b92ec154fc005d..7081007590721464516c14b68a6b3248213e30a9
@@@ -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."