Function: nnselect-request-thread

nnselect-request-thread is a byte-compiled function defined in nnselect.el.gz.

Signature

(nnselect-request-thread HEADER &optional GROUP SERVER)

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/nnselect.el.gz
(deffoo nnselect-request-thread (header &optional group server)
  (with-current-buffer gnus-summary-buffer
    (let* ((group (nnselect-add-prefix group))
           ;; Find the best group for the originating article.  If its
           ;; a pseudo-article check for real articles in the same
           ;; thread to see where they come from.
           (artgroup
            (nnselect-article-group
             (cond
              ((> (mail-header-number header) 0)
               (mail-header-number header))
              ((> (gnus-summary-article-number) 0)
               (gnus-summary-article-number))
              (t (cl-some
                  (lambda (x) (when (and x (> x 0)) x))
                  (gnus-articles-in-thread
                   (gnus-id-to-thread (mail-header-id header))))))))
           (server (or server (gnus-group-server artgroup))))
      ;; Check if search-based thread referral is available.
      (if (ignore-errors (gnus-search-server-to-engine server))
          ;; We perform the query, massage the result, and return
          ;; the new headers back to the caller to incorporate into
          ;; the current summary buffer.
          (let* ((gnus-search-use-parsed-queries t)
                 (group-spec
                  (if (not gnus-refer-thread-use-search)
                      (list (list server artgroup))
                    (if (listp gnus-refer-thread-use-search)
                        gnus-refer-thread-use-search
                      (list (list server)))))
                 (ids (cons (mail-header-id header)
                            (split-string
                             (or (mail-header-references header)
                                 ""))))
                 (query-spec
                  (list (cons 'query
                              (mapconcat (lambda (i) (format "id:%s" i))
                                         ids " or ")) (cons 'thread t)))
                 (last (nnselect-artlist-length gnus-newsgroup-selection))
                 (first (1+ last))
                 old-arts seq headers)
            (mapc
             (lambda (article)
               (if (setq seq
                         (cl-position
                          article
                          gnus-newsgroup-selection
                          :test
                          (lambda (x y)
                            (and (equal (nnselect-artitem-group x)
                                        (nnselect-artitem-group y))
                                 (eql (nnselect-artitem-number x)
                                      (nnselect-artitem-number y))))))
                   (push (1+ seq) old-arts)
                 (setq gnus-newsgroup-selection
                       (vconcat gnus-newsgroup-selection (vector article)))
                 (incf last)))
             (gnus-search-run-query
              (list (cons 'search-query-spec query-spec)
                    (cons 'search-group-spec group-spec))))
            (setq headers
                  (gnus-fetch-headers
                   (append (sort old-arts #'<) (number-sequence first last))
                   nil t))
            (nnselect-store-artlist group gnus-newsgroup-selection)
            (when (>= last first)
              (let (new-marks)
                (pcase-dolist (`(,artgroup . ,artids)
                               (ids-by-group (number-sequence first last)))
                  (pcase-dolist (`(,type . ,marked)
                                 (gnus-info-marks (gnus-get-info artgroup)))
                    (when
                        (setq new-marks
                              (delq nil
                                    (if (eq (gnus-article-mark-to-type type)
                                            'tuple)
                                        (mapcar
                                         (lambda (art)
                                           (let ((mtup
                                                  (assq (cdr art) marked)))
                                             (when mtup
                                               (cons (car art) (cdr mtup)))))
                                         artids)
                                      (setq marked
                                            (gnus-uncompress-sequence marked))
                                      (mapcar
                                       (lambda (art)
                                         (when (memq (cdr art) marked)
                                           (car art)))
                                       artids))))
                      (nconc
                       (symbol-value
                        (intern
                         (format "gnus-newsgroup-%s"
                                 (car
                                  (rassq type gnus-article-mark-lists)))))
                       new-marks)))))
              (gnus-set-active
               group
               (setq
                gnus-newsgroup-active
                (cons 1 (nnselect-artlist-length gnus-newsgroup-selection)))))
            headers)
        ;; If we can't use search, just warp to the original group and
        ;; punt back to gnus-summary-refer-thread.
        (and (gnus-warp-to-article) (gnus-summary-refer-thread))))))