;; When looking at the retrieval result (in the Summary buffer) you
;; can type `A W' (aka M-x gnus-warp-to-article RET) on an article. You
-;; will be warped into the group this article came from. Typing `A W'
+;; will be warped into the group this article came from. Typing `A T'
;; (aka M-x gnus-summary-refer-thread RET) will warp to the group and
;; also show the thread this article is part of.
(defcustom nnir-method-default-engines
'((nnimap . imap)
(nntp . gmane))
- "*Alist of default search engines keyed by server method"
+ "*Alist of default search engines keyed by server method."
:type '(alist)
: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\""
+ by default set this to \"Imap\"."
:type '(string)
:group 'nnir)
Add an entry here when adding a new search engine.")
-(defvar nnir-get-article-nov-override-function nil
- "If non-nil, a function that will be passed each search result. This
-should return a message's headers in NOV format.
+(defvar nnir-retrieve-headers-override-function nil
+ "If non-nil, a function that accepts an article list and group
+and populates the `nntp-server-buffer' with the retrieved
+headers. Must return either 'nov or 'headers indicating the
+retrieved header format.
If this variable is nil, or if the provided function returns nil for a search
result, `gnus-retrieve-headers' will be called instead.")
;;; Code:
+;;; Helper macros
+
+(defmacro nnir-article-group (article)
+ "Returns the group for ARTICLE"
+ `(nnir-artitem-group (nnir-artlist-article nnir-artlist ,article)))
+
+(defmacro nnir-article-number (article)
+ "Returns the number for ARTICLE"
+ `(nnir-artitem-number (nnir-artlist-article nnir-artlist ,article)))
+
+(defmacro nnir-article-rsv (article)
+ "Returns the rsv for ARTICLE"
+ `(nnir-artitem-rsv (nnir-artlist-article nnir-artlist ,article)))
+
+(defmacro nnir-article-ids (article)
+ "Returns the pair `(nnir id . real id)' of ARTICLE"
+ `(cons ,article (nnir-article-number ,article)))
+
+(defmacro nnir-categorize (sequence keyfunc &optional valuefunc)
+ "Sorts a sequence into categories and returns a list of the form
+`((key1 (element11 element12)) (key2 (element21 element22))'.
+The category key for a member of the sequence is obtained
+as `(keyfunc member)' and the corresponding element is just
+`member'. If `valuefunc' is non-nil, the element of the list
+is `(valuefunc member)'."
+ `(if (null ,sequence)
+ nil
+ (let (value)
+ (mapcar
+ (lambda (member)
+ (let ((y (,keyfunc member))
+ (x ,(if valuefunc
+ `(,valuefunc member)
+ 'member)))
+ (if (assoc y value)
+ (push x (cadr (assoc y value)))
+ (push (list y (list x)) value))))
+ ,sequence)
+ value)))
+
;; Gnus glue.
(defun gnus-group-make-nnir-group (nnir-extra-parms)
group)))) ; group name
(deffoo nnir-retrieve-headers (articles &optional group server fetch-old)
- (save-excursion
- (let ((artlist (copy-sequence articles))
- art artitem artgroup artno artrsv artfullgroup
- novitem novdata foo server)
- (while (not (null artlist))
- (setq art (car artlist))
- (or (numberp art)
- (nnheader-report
- 'nnir
- "nnir-retrieve-headers doesn't grok message ids: %s"
- art))
- (setq artitem (nnir-artlist-article nnir-artlist art))
- (setq artrsv (nnir-artitem-rsv artitem))
- (setq artfullgroup (nnir-artitem-group artitem))
- (setq artno (nnir-artitem-number artitem))
- (setq artgroup (gnus-group-real-name artfullgroup))
- (setq server (gnus-group-server artfullgroup))
- ;; retrieve NOV or HEAD data for this article, transform into
- ;; NOV data and prepend to `novdata'
- (set-buffer nntp-server-buffer)
- (nnir-possibly-change-server server)
- (let ((gnus-override-method
- (gnus-server-to-method server)))
- ;; if nnir-get-article-nov-override-function is set, use it
- (if nnir-get-article-nov-override-function
- (setq novitem (funcall nnir-get-article-nov-override-function
- artitem))
- ;; else, set novitem through nnheader-parse-nov/nnheader-parse-head
- (case (setq foo (gnus-retrieve-headers (list artno)
- artfullgroup nil))
- (nov
- (goto-char (point-min))
- (setq novitem (nnheader-parse-nov)))
- (headers
- (goto-char (point-min))
- (setq novitem (nnheader-parse-head)))
- (t (error "Unknown header type %s while requesting article %s of group %s"
- foo artno artfullgroup)))))
- ;; replace article number in original group with article number
- ;; in nnir group
- (when novitem
- (mail-header-set-number novitem art)
- (mail-header-set-subject
- novitem
- (format "[%d: %s/%d] %s"
- artrsv artgroup artno
- (mail-header-subject novitem)))
- (push novitem novdata)
- (setq artlist (cdr artlist))))
- (setq novdata (nreverse novdata))
- (set-buffer nntp-server-buffer) (erase-buffer)
- (mapc 'nnheader-insert-nov novdata)
+ (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)
+ ;; (or (numberp art)
+ ;; (nnheader-report
+ ;; 'nnir
+ ;; "nnir-retrieve-headers doesn't grok message ids: %s"
+ ;; art))
+ (nnir-possibly-change-server server)
+ ;; is this needed?
+ (erase-buffer)
+ (case (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))
+ (t (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 (mail-header-number novitem))
+ (art (car (rassoc artno articleids))))
+ (when art
+ (mail-header-set-number novitem art)
+ (mail-header-set-subject
+ novitem
+ (format "[%d: %s/%d] %s"
+ (nnir-article-rsv art) artgroup artno
+ (mail-header-subject novitem)))
+ (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)))
-(deffoo nnir-request-article (article
- &optional group server to-buffer)
+(deffoo nnir-request-article (article &optional group server to-buffer)
(if (stringp article)
(nnheader-report
'nnir
"nnir-retrieve-headers doesn't grok message ids: %s"
article)
(save-excursion
- (let* ((artitem (nnir-artlist-article nnir-artlist
- article))
- (artfullgroup (nnir-artitem-group artitem))
- (artno (nnir-artitem-number artitem))
- ;; Bug?
- ;; Why must we bind nntp-server-buffer here? It won't
- ;; work if `buf' is used, say. (Of course, the set-buffer
- ;; line below must then be updated, too.)
- (nntp-server-buffer (or to-buffer nntp-server-buffer)))
+ (let ((artfullgroup (nnir-article-group article))
+ (artno (nnir-article-number article))
+ ;; Bug?
+ ;; Why must we bind nntp-server-buffer here? It won't
+ ;; work if `buf' is used, say. (Of course, the set-buffer
+ ;; line below must then be updated, too.)
+ (nntp-server-buffer (or to-buffer nntp-server-buffer)))
(set-buffer nntp-server-buffer)
(erase-buffer)
(message "Requesting article %d from group %s"
(deffoo nnir-request-move-article (article group server accept-form
&optional last internal-move-group)
- (let* ((artitem (nnir-artlist-article nnir-artlist
- article))
- (artfullgroup (nnir-artitem-group artitem))
- (artno (nnir-artitem-number artitem))
+ (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))
(let* ((cur (if (> (gnus-summary-article-number) 0)
(gnus-summary-article-number)
(error "This is not a real article.")))
- (gnus-newsgroup-name (nnir-artlist-artitem-group nnir-artlist cur))
- (backend-number (nnir-artlist-artitem-number nnir-artlist cur)))
+ (gnus-newsgroup-name (nnir-article-group cur))
+ (backend-number (nnir-article-number cur)))
(gnus-summary-read-group-1 gnus-newsgroup-name t t gnus-summary-buffer
nil (list backend-number))))
(gnus-replace-in-string dirnam "^[./\\]" "" t)
"[/\\]" "." t)))
- (vector (nnir-group-full-name group server)
+ (vector (gnus-group-full-name group server)
(if (string= (gnus-group-server server) "nnmaildir")
(nnmaildir-base-name-to-article-number
(substring article 0 (string-match ":" article))
;; Windows "\\" -> "."
(setq group (gnus-replace-in-string group "\\\\" "."))
- (push (vector (nnir-group-full-name group server)
+ (push (vector (gnus-group-full-name group server)
(string-to-number artno)
(string-to-number score))
artlist))))
score (match-string 3))
(when (string-match prefix dirnam)
(setq dirnam (replace-match "" t t dirnam)))
- (push (vector (nnir-group-full-name
+ (push (vector (gnus-group-full-name
(gnus-replace-in-string dirnam "/" ".") server)
(string-to-number artno)
(string-to-number score))
(nreverse res))
".")))
(push
- (vector (nnir-group-full-name group server) art 0)
+ (vector (gnus-group-full-name group server) art 0)
artlist))
(forward-line 1)))
(message "Searching %s using find-grep...done"
(server (cadr (gnus-server-to-method srv)))
(groupspec (if groups
(mapconcat
- (function (lambda (x)
- (format "group:%s"
- (gnus-group-short-name x))))
+ (lambda (x)
+ (format "group:%s" (gnus-group-short-name x)))
groups " ") ""))
(authorspec
(if (assq 'author query)
(string-to-number (match-string 2 xref)) xscore)
artlist)))))
(forward-line 1)))
- ;; Sort by score
- (apply 'vector
- (sort artlist
- (function (lambda (x y)
- (> (nnir-artitem-rsv x)
- (nnir-artitem-rsv y)))))))
+ (apply 'vector (nreverse (delete-dups artlist))))
(message "Can't search non-gmane nntp groups")
nil))
(groups (if (string= "all-ephemeral" nserver)
(with-current-buffer gnus-server-buffer
(list (list (gnus-server-server-name))))
- (nnir-sort-groups-by-server
+ (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-topic-alist))))
+ gnus-group-server))))
(apply 'vconcat
- (mapcar (lambda (x)
- (let* ((server (car x))
- (nnir-search-engine
- (or (nnir-read-server-parm 'nnir-search-engine
- server)
- (cdr (assoc (car
- (gnus-server-to-method server))
- nnir-method-default-engines))))
- search-func)
- (setq search-func (cadr
- (assoc nnir-search-engine
- nnir-engines)))
- (if search-func
- (funcall search-func
- (if nnir-extra-parms
- (nnir-read-parms q nnir-search-engine)
- q)
- server (cdr x))
- nil)))
- groups))))
+ (mapcar
+ (lambda (x)
+ (let* ((server (car x))
+ (nnir-search-engine
+ (or (nnir-read-server-parm 'nnir-search-engine
+ server)
+ (cdr (assoc (car
+ (gnus-server-to-method server))
+ nnir-method-default-engines))))
+ search-func)
+ (setq search-func (cadr (assoc nnir-search-engine
+ nnir-engines)))
+ (if search-func
+ (funcall search-func
+ (if nnir-extra-parms
+ (nnir-read-parms q nnir-search-engine)
+ q)
+ server (cadr x))
+ nil)))
+ groups))))
(defun nnir-read-server-parm (key server)
"Returns the parameter value of key for the given server, where
(nth 1 (assq key (cddr method))))
(t nil))))
-(defun nnir-group-full-name (shortname server)
- "For the given group name, return a full Gnus group name.
-The Gnus backend/server information is added."
- (gnus-group-prefixed-name shortname (gnus-server-to-method server)))
-
(defun nnir-possibly-change-server (server)
(unless (and server (nnir-server-opened server))
(nnir-open-server server)))
"Returns the group from the ARTITEM."
(elt artitem 0))
-(defun nnir-artlist-artitem-group (artlist n)
- "Returns from ARTLIST the group of the Nth artitem (counting from 1)."
- (nnir-artitem-group (nnir-artlist-article artlist n)))
-
(defun nnir-artitem-number (artitem)
"Returns the number from the ARTITEM."
(elt artitem 1))
-(defun nnir-artlist-artitem-number (artlist n)
- "Returns from ARTLIST the number of the Nth artitem (counting from 1)."
- (nnir-artitem-number (nnir-artlist-article artlist n)))
-
(defun nnir-artitem-rsv (artitem)
"Returns the Retrieval Status Value (RSV, score) from the ARTITEM."
(elt artitem 2))
-(defun nnir-artlist-artitem-rsv (artlist n)
- "Returns from ARTLIST the Retrieval Status Value of the Nth
-artitem (counting from 1)."
- (nnir-artitem-rsv (nnir-artlist-article artlist n)))
;; unused?
(defun nnir-artlist-groups (artlist)
with-dups)
res))
-(defun nnir-sort-groups-by-server (groups)
- "sorts a list of groups into an alist keyed by server"
-(if (car groups)
- (let (value)
- (dolist (var groups value)
- (let ((server (gnus-group-server var)))
- (if (assoc server value)
- (nconc (cdr (assoc server value)) (list var))
- (push (cons server (list var)) value))))
- value)
- nil))
-
(defun nnir-get-active (srv)
(let ((method (gnus-server-to-method srv))
groups)
projects / gnus / commitdiff