ghh@vertigo.princeton.edu (Gilbert Harman) (08/07/89)
I like to browse through the junk newsgroup which contains
messages of newsgroups not currently recognized by our
system administrator. Clearly it is useful to have my
junk.KILL file recognize such newsgroups that I do or don't
want to read. But simply including a line like
(gnus-kill "Newsgroups" "hongkong") produces an error,
since the header's that gnus keeps track of do not include
the Newsgroups header. So, I had to modify nntp.el and
gnus.el. The result follows. In order to use this code you
need to include in your gnus-Group-mode-hook:
'(lambda () (require 'gnus-headers))
and then put the following code into gnus-headers.el
------------------------------------------------------------------------
(provide 'gnus-headers)
;;;
;;; Extended Command for retrieving many headers.
;;;
;; Retrieving lots of headers by sending command asynchronously.
;; Access functions to headers are defined as macro.
;; a supplement to functions in gnus.el and nntp.el to allow headers to
;; include newsgroups
(defmacro nntp-header-newsgroups (header)
"Return newsgroups in HEADER."
(` (aref (, header) 7)))
(defmacro nntp-set-header-id (header newsgroups)
"Set article newsgroups of HEADER to NEWSGROUPS."
(` (aset (, header) 7 (, newsgroups))))
(defun gnus-header-newsgroups (header)
"Return newsgroups in HEADER."
(nntp-header-newsgroups header))
(defun nntp-retrieve-headers (sequence)
"Return list of article headers specified by SEQUENCE of article id.
The format of list is `([NUMBER SUBJECT FROM XREF LINES DATE MESSAGE-ID NEWSGROUPS] ...)'.
Reader macros for the vector are defined as `nntp-header-FIELD'.
Writer macros for the vector are defined as `nntp-set-header-FIELD'.
News group must be selected before calling me."
(save-excursion
(set-buffer nntp-server-buffer)
(erase-buffer)
(let ((number (length sequence))
(last-point (point-min))
(received 0)
(count 0)
(headers nil) ;Result list.
(article 0)
(subject nil)
(message-id)
(from nil)
(xref nil)
(lines 0)
(newsgroups nil)
(date nil))
;; Send HEAD command.
(while sequence
(nntp-send-strings-to-server "HEAD" (car sequence))
(setq sequence (cdr sequence))
(setq count (1+ count))
;; Every 400 header requests we have to read stream in order
;; to avoid deadlock.
(if (or (null sequence) ;All requests have been sent.
(zerop (% count nntp-maximum-request)))
(progn
(accept-process-output)
(while (progn
(goto-char last-point)
;; Count replies.
(while (re-search-forward "^[0-9]" nil t)
(setq received (1+ received)))
(setq last-point (point))
(< received count))
;; If number of headers is greater than 100, give
;; informative messages.
(and (> number nntp-large-newsgroup)
(zerop (% received 20))
(message "NNTP: %d%% of headers received."
(/ (* received 100) number)))
(nntp-accept-response))
))
)
;; Wait for text of last command.
(goto-char (point-max))
(re-search-backward "^[0-9]" nil t)
(if (looking-at "^[23]")
(while (progn
(goto-char (- (point-max) 3))
(not (looking-at "^\\.\r$")))
(nntp-accept-response)
))
(if (> number nntp-large-newsgroup)
(message "NNTP: 100%% of headers received."))
;; Now all of replies are received.
;; First, delete unnecessary lines.
(goto-char (point-min))
(delete-non-matching-lines
"^Newsgroups:\\|^Subject:\\|^Xref:\\|^From:\\|^Lines:\\|^Date:\\|^[23]")
(if (> number nntp-large-newsgroup)
(message "NNTP: Parsing headers..."))
(setq received number)
;; Then examines replies.
(while (not (eobp))
(cond ((looking-at "^[23].*[ \t]+\\([0-9]+\\)[ \t]+\\(<.+>\\)")
(setq article
(string-to-int
(buffer-substring (match-beginning 1) (match-end 1))))
(setq message-id
(buffer-substring (match-beginning 2) (match-end 2)))
(forward-line 1)
;; Set default value.
(setq subject nil)
(setq xref nil)
(setq from nil)
(setq lines 0)
(setq date nil)
;; It is better to extract From:, Newsgroups:, Subject:, Date:,
;; Lines: and Xref: field values in *THIS* order.
;; Forward-line each time after getting expected value
;; in order to reduce count of string matching.
(while (looking-at "^[^23]")
(if (looking-at "^From:[ \t]\\(.*\\)\r$")
(progn
(setq from (buffer-substring (match-beginning 1)
(match-end 1)))
(forward-line 1)))
(if (looking-at "^Newsgroups:[ \t]\\(.*\\)\r$")
(progn
(setq newsgroups (buffer-substring (match-beginning 1)
(match-end 1)))
(forward-line 1)))
(if (looking-at "^Subject:[ \t]\\(.*\\)\r$")
(progn
(setq subject (buffer-substring (match-beginning 1)
(match-end 1)))
(forward-line 1)))
(if (looking-at "^Date:[ \t]\\(.*\\)\r$")
(progn
(setq date (buffer-substring (match-beginning 1)
(match-end 1)))
(forward-line 1)))
(if (looking-at "^Lines:[ \t]\\(.*\\)\r$")
(progn
(setq lines (string-to-int
(buffer-substring (match-beginning 1)
(match-end 1))))
(forward-line 1)))
(if (looking-at "^Xref:[ \t]\\(.*\\)\r$")
(progn
(setq xref (buffer-substring (match-beginning 1)
(match-end 1)))
(forward-line 1)))
;; Skip invalid field (ex. Subject:abc)
(if (looking-at "^[^:]*:[^ \t]")
(forward-line 1))
)
(if (null subject)
(setq subject "(None)"))
(if (null from)
(setq from "Unknown User"))
(setq headers
(cons (vector article subject from
xref lines date message-id newsgroups)
headers))
)
(t (forward-line 1)) ;Skip invalid field (ex. Subject:abc)
)
(setq received (1- received))
(and (> number nntp-large-newsgroup)
(zerop (% received 20))
(message "NNTP: Parsing headers... %d%%"
(/ (* received 100) number)))
)
(if (> number nntp-large-newsgroup)
(message "NNTP: Parsing headers... done"))
(nreverse headers)
)))
--
Gilbert Harman
Princeton University Cognitive Science Laboratory
221 Nassau Street, Princeton, NJ 08542
ghh@princeton.edu
HARMAN@PUCC.BITNET