;; `nnir-engines'. Then, users can choose the backend by setting
;; `nnir-search-engine' as a server variable.
-;;; Setup Code:
+;;; Code:
+
+;;; Setup:
;; For Emacs <22.2 and XEmacs.
(eval-and-compile
(require 'nnoo)
(require 'gnus-group)
-(require 'gnus-sum)
(require 'message)
(require 'gnus-util)
(eval-when-compile
(require 'cl))
+;;; Internal Variables:
+
+(defvar nnir-current-query nil
+ "Internal: stores current query (= group name).")
+
+(defvar nnir-current-server nil
+ "Internal: stores current server (does it ever change?).")
+
+(defvar nnir-current-group-marked nil
+ "Internal: stores current list of process-marked groups.")
+
+(defvar nnir-artlist nil
+ "Internal: stores search result.")
+
+(defvar nnir-tmp-buffer " *nnir*"
+ "Internal: temporary buffer.")
+
+(defvar nnir-search-history ()
+ "Internal: the history for querying search options in nnir")
+
+(defvar nnir-extra-parms nil
+ "Internal: stores request for extra search parms")
+
+;; Imap variables
+
+(defvar nnir-imap-search-arguments
+ '(("Whole message" . "TEXT")
+ ("Subject" . "SUBJECT")
+ ("To" . "TO")
+ ("From" . "FROM")
+ ("Imap" . ""))
+ "Mapping from user readable keys to IMAP search items for use in nnir")
+
+(defvar nnir-imap-search-other "HEADER %S"
+ "The IMAP search item to use for anything other than
+ `nnir-imap-search-arguments'. By default this is the name of an
+ email header field")
+
+(defvar nnir-imap-search-argument-history ()
+ "The history for querying search options in nnir")
+
+;;; Helper macros
+
+;; Data type article list.
+
+(defmacro nnir-artlist-length (artlist)
+ "Returns number of articles in artlist."
+ `(length ,artlist))
+
+(defmacro nnir-artlist-article (artlist n)
+ "Returns from ARTLIST the Nth artitem (counting starting at 1)."
+ `(when (> ,n 0)
+ (elt ,artlist (1- ,n))))
+
+(defmacro nnir-artitem-group (artitem)
+ "Returns the group from the ARTITEM."
+ `(elt ,artitem 0))
+
+(defmacro nnir-artitem-number (artitem)
+ "Returns the number from the ARTITEM."
+ `(elt ,artitem 1))
+
+(defmacro nnir-artitem-rsv (artitem)
+ "Returns the Retrieval Status Value (RSV, score) from the ARTITEM."
+ `(elt ,artitem 2))
+
+(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)))
+
+(defsubst 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)'."
+ `(unless (null ,sequence)
+ (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)))
+
+;;; Finish setup:
+
+(require 'gnus-sum)
(eval-when-compile
(autoload 'nnimap-buffer "nnimap")
(autoload 'nnimap-command "nnimap")
- (autoload 'nnimap-possibly-change-group "nnimap"))
+ (autoload 'nnimap-possibly-change-group "nnimap")
+ (autoload 'gnus-registry-action "gnus-registry"))
(nnoo-declare nnir)
(nnoo-define-basics nnir)
:type '(alist)
:group 'nnir)
-(defcustom nnir-ignored-newsgroups nil
+(defcustom nnir-ignored-newsgroups ""
"*A regexp to match newsgroups in the active file that should
be skipped when searching."
:type '(regexp)
:group 'nnir)
+(defcustom nnir-summary-line-format nil
+ "*The format specification of the lines in an nnir summary buffer.
+
+All the items from `gnus-summary-line-format' are available, along
+with three items unique to nnir summary buffers:
+
+%Z Search retrieval score value (integer)
+%G Article original full group name (string)
+%g Article original short group name (string)
+
+If nil this will use `gnus-summary-line-format'."
+ :type '(regexp)
+ :group 'nnir)
+
+(defcustom 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."
+ :type '(function)
+ :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
:type '(directory)
:group 'nnir)
-;; Imap variables
-
-(defvar nnir-imap-search-arguments
- '(("Whole message" . "TEXT")
- ("Subject" . "SUBJECT")
- ("To" . "TO")
- ("From" . "FROM")
- ("Imap" . ""))
- "Mapping from user readable keys to IMAP search items for use in nnir")
-
-(defvar nnir-imap-search-other "HEADER %S"
- "The IMAP search item to use for anything other than
- `nnir-imap-search-arguments'. By default this is the name of an
- email header field")
-
-(defvar nnir-imap-search-argument-history ()
- "The history for querying search options in nnir")
-
;;; Developer Extension Variable:
(defvar nnir-engines
Add an entry here when adding a new search engine.")
-(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.")
-
-;;; Internal Variables:
-
-(defvar nnir-current-query nil
- "Internal: stores current query (= group name).")
-
-(defvar nnir-current-server nil
- "Internal: stores current server (does it ever change?).")
-
-(defvar nnir-current-group-marked nil
- "Internal: stores current list of process-marked groups.")
-
-(defvar nnir-artlist nil
- "Internal: stores search result.")
-
-(defvar nnir-tmp-buffer " *nnir*"
- "Internal: temporary buffer.")
-
-(defvar nnir-search-history ()
- "Internal: the history for querying search options in nnir")
-
-(defvar nnir-extra-parms nil
- "Internal: stores request for extra search parms")
-
-;;; 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.
(deffoo nnir-open-server (server &optional definitions)
;; Just set the server variables appropriately.
+ (add-hook 'gnus-summary-mode-hook 'nnir-mode)
(nnoo-change-server 'nnir server definitions))
(deffoo nnir-request-group (group &optional server fast info)
(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
(artsubject (mail-header-subject
(gnus-data-header
(assoc article (gnus-data-list nil))))))
- (setq gnus-newsgroup-original-name artfullgroup)
- (string-match "^\\[[0-9]+:.+/[0-9]+\\] " artsubject)
- (setq gnus-article-original-subject (substring artsubject (match-end 0)))
+ (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
(nnir-imap-make-query
criteria qstring)))))
(mapc
- (lambda (artnum) (push (vector group artnum 1) artlist)
+ (lambda (artnum) (push (vector group artnum 100) artlist)
(setq arts (1+ arts)))
(and (car result)
(delete 0 (mapcar #'string-to-number
(directory (cadr (assoc sym (cddr method))))
(regexp (cdr (assoc 'query query)))
(grep-options (cdr (assoc 'grep-options query)))
+ (grouplist (or grouplist (nnir-get-active server)))
artlist)
(unless directory
(error "No directory found in method specification of server %s"
;; gmane interface
(defun nnir-run-gmane (query srv &optional groups)
"Run a search against a gmane back-end server."
- (if (gnus-string-match-p "gmane" srv)
+ (if (gnus-string-match-p "gmane.org$" srv)
(let* ((case-fold-search t)
(qstring (cdr (assq 'query query)))
(server (cadr (gnus-server-to-method srv)))
(string-to-number (match-string 2 xref)) xscore)
artlist)))))
(forward-line 1)))
- (apply 'vector (nreverse (delete-dups artlist))))
+ (apply 'vector (nreverse (mm-delete-duplicates artlist))))
(message "Can't search non-gmane nntp groups")
nil))
(nnir-open-server server)))
-;; Data type article list.
-
-(defun nnir-artlist-length (artlist)
- "Returns number of articles in artlist."
- (length artlist))
-
-(defun nnir-artlist-article (artlist n)
- "Returns from ARTLIST the Nth artitem (counting starting at 1)."
- (elt artlist (1- n)))
-
-(defun nnir-artitem-group (artitem)
- "Returns the group from the ARTITEM."
- (elt artitem 0))
-
-(defun nnir-artitem-number (artitem)
- "Returns the number from the ARTITEM."
- (elt artitem 1))
-
-(defun nnir-artitem-rsv (artitem)
- "Returns the Retrieval Status Value (RSV, score) from the ARTITEM."
- (elt artitem 2))
-
;; unused?
(defun nnir-artlist-groups (artlist)
(goto-char (point-min))
(unless (string= nnir-ignored-newsgroups "")
(delete-matching-lines nnir-ignored-newsgroups))
- (while (not (eobp))
- (ignore-errors
- (push (mm-string-as-unibyte
- (let ((p (point)))
- (skip-chars-forward "^ \t\\\\")
- (setq name (buffer-substring (+ p 1) (- (point) 1)))
- (gnus-group-full-name name method)))
- groups))
- (forward-line))))
+ (if (eq (car method) 'nntp)
+ (while (not (eobp))
+ (ignore-errors
+ (push (mm-string-as-unibyte
+ (gnus-group-full-name
+ (buffer-substring
+ (point)
+ (progn
+ (skip-chars-forward "^ \t")
+ (point))) method))
+ groups))
+ (forward-line))
+ (while (not (eobp))
+ (ignore-errors
+ (push (mm-string-as-unibyte
+ (if (eq (char-after) ?\")
+ (gnus-group-full-name (read cur) method)
+ (let ((p (point)) (name ""))
+ (skip-chars-forward "^ \t\\\\")
+ (setq name (buffer-substring p (point)))
+ (while (eq (char-after) ?\\)
+ (setq p (1+ (point)))
+ (forward-char 2)
+ (skip-chars-forward "^ \t\\\\")
+ (setq name (concat name (buffer-substring
+ p (point)))))
+ (gnus-group-full-name name method))))
+ groups))
+ (forward-line)))))
groups))
+(defun nnir-registry-action (action data-header from &optional to method)
+ "Call `gnus-registry-action' with the original article group."
+ (gnus-registry-action
+ action
+ data-header
+ (nnir-article-group (mail-header-number data-header))
+ to
+ method))
+
+(defun nnir-mode ()
+ (when (eq (car (gnus-find-method-for-group gnus-newsgroup-name)) 'nnir)
+ (setq gnus-summary-line-format
+ (or nnir-summary-line-format gnus-summary-line-format))
+ (remove-hook 'gnus-summary-article-delete-hook 'gnus-registry-action t)
+ (remove-hook 'gnus-summary-article-move-hook 'gnus-registry-action t)
+ (add-hook 'gnus-summary-article-delete-hook 'nnir-registry-action t t)
+ (add-hook 'gnus-summary-article-move-hook 'nnir-registry-action t t)))
+
+
+
;; The end.
(provide 'nnir)
projects / gnus / blobdiff