(require 'rmail)
(require 'nnmail)
+(defvar nndoc-article-type 'mbox
+ "*Type of the file - one of `mbox', `babyl' or `digest'.")
+
+(defvar nndoc-digest-type 'traditional
+ "Type of the last digest. Auto-detected from the article header.
+Possible values:
+ `traditional' -- the \"lots of dashes\" (30+) rules used;
+ we currently also do unconditional RFC 934 unquoting.
+ `rfc1341' -- RFC 1341 digest (MIME, unique boundary, no quoting).")
+
+(defconst nndoc-type-to-regexp
+ (list (list 'mbox
+ (concat "^" rmail-unix-mail-delimiter)
+ (concat "^" rmail-unix-mail-delimiter)
+ nil "^$" nil nil nil)
+ (list 'babyl "\^_\^L *\n" "\^_" "^[0-9].*\n" "^$" nil nil
+ "\\*\\*\\* EOOH \\*\\*\\*\n\\(^.+\n\\)*")
+ (list 'digest
+ "^------------------------------*[\n \t]+"
+ "^------------------------------[\n \t]+"
+ nil "^ ?$"
+ "^------------------------------*[\n \t]+"
+ "^End of" nil))
+ "Regular expressions for articles of the various types.")
+
\f
+(defvar nndoc-article-begin nil)
+(defvar nndoc-article-end nil)
+(defvar nndoc-head-begin nil)
+(defvar nndoc-head-end nil)
+(defvar nndoc-first-article nil)
+(defvar nndoc-end-of-file nil)
+(defvar nndoc-body-begin nil)
+
+(defvar nndoc-current-server nil)
+(defvar nndoc-server-alist nil)
+(defvar nndoc-server-variables
+ (list
+ (list 'nndoc-article-type nndoc-article-type)
+ '(nndoc-article-begin nil)
+ '(nndoc-article-end nil)
+ '(nndoc-head-begin nil)
+ '(nndoc-head-end nil)
+ '(nndoc-first-article nil)
+ '(nndoc-current-buffer nil)
+ '(nndoc-group-alist nil)
+ '(nndoc-end-of-file nil)
+ '(nndoc-body-begin nil)
+ '(nndoc-address nil)))
+
(defconst nndoc-version "nndoc 0.1"
"nndoc version.")
(defvar nndoc-current-buffer nil
"Current nndoc news buffer.")
+(defvar nndoc-address nil)
+
+\f
+
(defvar nndoc-status-string "")
(defvar nndoc-group-alist nil)
;;; Interface functions
(defun nndoc-retrieve-headers (sequence &optional newsgroup server)
- "Retrieve the headers for the articles in SEQUENCE.
-Newsgroup must be selected before calling this function."
(save-excursion
(set-buffer nntp-server-buffer)
(erase-buffer)
- (let ((file nil)
- (number (length sequence))
- (count 0)
- beg article art-string start stop lines)
+ (let ((prev 2)
+ article p beg lines)
(nndoc-possibly-change-buffer newsgroup server)
- (while sequence
- (setq article (car sequence))
+ (if (stringp (car sequence))
+ 'headers
(set-buffer nndoc-current-buffer)
- (if (nndoc-search-for-article article)
- (progn
- (setq start
- (save-excursion
- (or
- (re-search-backward
- (concat "^" rmail-unix-mail-delimiter) nil t)
- (point-min))))
- (search-forward "\n\n" nil t)
- (setq lines (count-lines
- (point)
- (or
- (save-excursion
- (re-search-forward
- (concat "^" rmail-unix-mail-delimiter) nil t))
- (point-max))))
- (setq stop (1- (point)))
- (set-buffer nntp-server-buffer)
- (insert (format "221 %d Article retrieved.\n" article))
- (setq beg (point))
- (insert-buffer-substring nndoc-current-buffer start stop)
- (goto-char (point-max))
- (insert (format "Lines: %d\n" lines))
- (insert ".\n")))
- (setq sequence (cdr sequence)))
-
- ;; Fold continuation lines.
- (goto-char (point-min))
- (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
- (replace-match " " t t))
- 'headers)))
-
-(defun nndoc-open-server (host &optional service)
- "Open mbox backend."
- (setq nndoc-status-string "")
- (setq nndoc-group-alist nil)
- (nnheader-init-server-buffer))
+ (goto-char (point-min))
+ (re-search-forward (or nndoc-first-article
+ nndoc-article-begin) nil t)
+ (or (not nndoc-head-begin)
+ (re-search-forward nndoc-head-begin nil t))
+ (re-search-forward nndoc-head-end nil t)
+ (while sequence
+ (setq article (car sequence))
+ (set-buffer nndoc-current-buffer)
+ (if (not (nndoc-forward-article (max 0 (- article prev))))
+ ()
+ (setq p (point))
+ (setq beg (or (and
+ (re-search-backward nndoc-article-begin nil t)
+ (match-end 0))
+ (point-min)))
+ (goto-char p)
+ (setq lines (count-lines
+ (point)
+ (or
+ (and (re-search-forward nndoc-article-end nil t)
+ (goto-char (match-beginning 0)))
+ (goto-char (point-max)))))
+
+ (set-buffer nntp-server-buffer)
+ (insert (format "221 %d Article retrieved.\n" article))
+ (insert-buffer-substring nndoc-current-buffer beg p)
+ (goto-char (point-max))
+ (insert (format "Lines: %d\n" lines))
+ (insert ".\n"))
+
+ (setq prev article
+ sequence (cdr sequence)))
+
+ ;; Fold continuation lines.
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-min))
+ (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
+ (replace-match " " t t))
+ 'headers))))
+
+(defun nndoc-open-server (server &optional defs)
+ (nnheader-init-server-buffer)
+ (if (equal server nndoc-current-server)
+ t
+ (if nndoc-current-server
+ (setq nndoc-server-alist
+ (cons (list nndoc-current-server
+ (nnheader-save-variables nndoc-server-variables))
+ nndoc-server-alist)))
+ (let ((state (assoc server nndoc-server-alist)))
+ (if state
+ (progn
+ (nnheader-restore-variables (nth 1 state))
+ (setq nndoc-server-alist (delq state nndoc-server-alist)))
+ (nnheader-set-init-variables nndoc-server-variables defs)))
+ (setq nndoc-current-server server)
+ (let ((defs (cdr (assq nndoc-article-type nndoc-type-to-regexp))))
+ (setq nndoc-article-begin (nth 0 defs))
+ (setq nndoc-article-end (nth 1 defs))
+ (setq nndoc-head-begin (nth 2 defs))
+ (setq nndoc-head-end (nth 3 defs))
+ (setq nndoc-first-article (nth 4 defs))
+ (setq nndoc-end-of-file (nth 5 defs))
+ (setq nndoc-body-begin (nth 6 defs)))
+ t))
(defun nndoc-close-server (&optional server)
- "Close news server."
t)
(defun nndoc-server-opened (&optional server)
- "Return server process status."
- (and nntp-server-buffer
- (get-buffer nntp-server-buffer)))
+ (and (equal server nndoc-current-server)
+ nntp-server-buffer
+ (buffer-name nntp-server-buffer)))
(defun nndoc-status-message (&optional server)
- "Return server status response as string."
nndoc-status-string)
(defun nndoc-request-article (article &optional newsgroup server buffer)
- "Select ARTICLE by number."
(nndoc-possibly-change-buffer newsgroup server)
- (if (stringp article)
- nil
- (save-excursion
- (set-buffer nndoc-current-buffer)
- (if (nndoc-search-for-article article)
- (let (start stop)
- (re-search-backward (concat "^" rmail-unix-mail-delimiter) nil t)
- (forward-line 1)
- (setq start (point))
- (or (and (re-search-forward
- (concat "^" rmail-unix-mail-delimiter) nil t)
- (forward-line -1))
- (goto-char (point-max)))
- (setq stop (point))
- (let ((nntp-server-buffer (or buffer nntp-server-buffer)))
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (insert-buffer-substring nndoc-current-buffer start stop)
- t))))))
+ (save-excursion
+ (let ((buffer (or buffer nntp-server-buffer)))
+ (set-buffer buffer)
+ (erase-buffer)
+ (if (stringp article)
+ nil
+ (nndoc-insert-article article)
+ ;; Unquote quoted non-separators in digests.
+ (if (and (eq nndoc-article-type 'digest)
+ (eq nndoc-digest-type 'traditional))
+ (progn
+ (goto-char (point-min))
+ (while (re-search-forward "^- -"nil t)
+ (replace-match "-" t t))))
+ t))))
(defun nndoc-request-group (group &optional server dont-check)
"Select news GROUP."
(save-excursion
(if (not (nndoc-possibly-change-buffer group server))
(progn
- (setq nndoc-status-string "No such file")
+ (setq nndoc-status-string "No such file or buffer")
nil)
+ (nndoc-set-header-dependent-regexps) ; hack for MIME digests
(if dont-check
t
(save-excursion
(progn
(nndoc-close-group group)
nil)
- (insert (format "211 %d %d %d %s\n"
- number 1 number group))
+ (insert (format "211 %d %d %d %s\n" number 1 number group))
t)))))))
(defun nndoc-close-group (group &optional server)
(defun nndoc-request-list-newsgroups (&optional server)
nil)
-(defun nndoc-request-post (&optional server)
- (mail-send-and-exit nil))
-
-(fset 'nndoc-request-post-buffer 'nnmail-request-post-buffer)
+(defalias 'nndoc-request-post 'nnmail-request-post)
+(defalias 'nndoc-request-post-buffer 'nnmail-request-post-buffer)
\f
;;; Internal functions.
-(defun nndoc-possibly-change-buffer (group file)
+(defun nndoc-possibly-change-buffer (group source)
(let (buf)
- (or (and nndoc-current-buffer
- (eq nndoc-current-buffer
- (setq buf (cdr (assoc group nndoc-group-alist)))))
- (if buf
- (setq nndoc-current-buffer buf)
- (if (or (not (file-exists-p file))
- (file-directory-p file))
- ()
- (setq nndoc-group-alist
- (cons (cons group (setq nndoc-current-buffer
- (get-buffer-create
- (concat " *nndoc " group "*"))))
- nndoc-group-alist))
- (save-excursion
- (set-buffer nndoc-current-buffer)
- (buffer-disable-undo (current-buffer))
- (erase-buffer)
- (insert-file-contents file)
- t))))))
+ (cond
+ ;; The current buffer is this group's buffer.
+ ((and nndoc-current-buffer
+ (eq nndoc-current-buffer
+ (setq buf (cdr (assoc group nndoc-group-alist))))))
+ ;; We change buffers by taking an old from the group alist.
+ ;; `source' is either a string (a file name) or a buffer object.
+ (buf
+ (setq nndoc-current-buffer buf))
+ ;; It's a totally new group.
+ ((or (and (bufferp nndoc-address)
+ (buffer-name nndoc-address))
+ (and (stringp nndoc-address)
+ (file-exists-p nndoc-address)
+ (not (file-directory-p nndoc-address))))
+ (setq nndoc-group-alist
+ (cons (cons group (setq nndoc-current-buffer
+ (get-buffer-create
+ (concat " *nndoc " group "*"))))
+ nndoc-group-alist))
+ (save-excursion
+ (set-buffer nndoc-current-buffer)
+ (buffer-disable-undo (current-buffer))
+ (erase-buffer)
+ (if (stringp nndoc-address)
+ (insert-file-contents nndoc-address)
+ (save-excursion
+ (set-buffer nndoc-address)
+ (widen))
+ (insert-buffer-substring nndoc-address))
+ t)))))
+
+;; MIME (RFC 1341) digest hack by Ulrik Dickow <dickow@nbi.dk>.
+(defun nndoc-set-header-dependent-regexps ()
+ (if (not (eq nndoc-article-type 'digest))
+ ()
+ (let ((case-fold-search t) ; We match a bit too much, keep it simple.
+ (boundary-id) (b-delimiter))
+ (save-excursion
+ (set-buffer nndoc-current-buffer)
+ (goto-char (point-min))
+ (if (and
+ (re-search-forward
+ (concat "\n\n\\|^Content-Type: multipart/digest;[ \t\n]*[ \t]"
+ "boundary=\"\\([^\"\n]*[^\" \t\n]\\)\"")
+ nil t)
+ (match-beginning 1))
+ (setq nndoc-digest-type 'rfc1341
+ boundary-id (buffer-substring-no-properties
+ (match-beginning 1) (match-end 1))
+ b-delimiter (concat "\n--" boundary-id "[\n \t]+")
+ nndoc-article-begin b-delimiter ; Too strict: "[ \t]*$"
+ nndoc-article-end (concat "\n--" boundary-id
+ "\\(--\\)?[\n \t]+")
+ nndoc-first-article b-delimiter ; ^eof ends article too.
+ nndoc-end-of-file (concat "\n--" boundary-id "--[ \t]*$"))
+ (setq nndoc-digest-type 'traditional))))))
+
+(defun nndoc-forward-article (n)
+ (while (and (> n 0)
+ (re-search-forward nndoc-article-begin nil t)
+ (or (not nndoc-head-begin)
+ (re-search-forward nndoc-head-begin nil t))
+ (re-search-forward nndoc-head-end nil t))
+ (setq n (1- n)))
+ (zerop n))
(defun nndoc-number-of-articles ()
(save-excursion
(set-buffer nndoc-current-buffer)
+ (widen)
(goto-char (point-min))
- (let ((num 0)
- (delim (concat "^" rmail-unix-mail-delimiter)))
- (while (re-search-forward delim nil t)
- (setq num (1+ num)))
+ (let ((num 0))
+ (if (re-search-forward (or nndoc-first-article
+ nndoc-article-begin) nil t)
+ (progn
+ (setq num 1)
+ (while (and (re-search-forward nndoc-article-begin nil t)
+ (or (not nndoc-end-of-file)
+ (not (looking-at nndoc-end-of-file)))
+ (or (not nndoc-head-begin)
+ (re-search-forward nndoc-head-begin nil t))
+ (re-search-forward nndoc-head-end nil t))
+ (setq num (1+ num)))))
num)))
-(defun nndoc-search-for-article (article)
- (let ((obuf (current-buffer)))
+(defun nndoc-narrow-to-article (article)
+ (save-excursion
(set-buffer nndoc-current-buffer)
+ (widen)
(goto-char (point-min))
- (let ((delim (concat "^" rmail-unix-mail-delimiter)))
- (while (and (re-search-forward delim nil t)
+ (while (and (re-search-forward nndoc-article-begin nil t)
+ (not (zerop (setq article (1- article))))))
+ (if (not (zerop article))
+ ()
+ (narrow-to-region
+ (match-end 0)
+ (or (and (re-search-forward nndoc-article-end nil t)
+ (match-beginning 0))
+ (point-max)))
+ t)))
+
+;; Insert article ARTICLE in the current buffer.
+(defun nndoc-insert-article (article)
+ (let ((ibuf (current-buffer)))
+ (save-excursion
+ (set-buffer nndoc-current-buffer)
+ (widen)
+ (goto-char (point-min))
+ (while (and (re-search-forward nndoc-article-begin nil t)
(not (zerop (setq article (1- article))))))
- (set-buffer obuf)
- (if (zerop article)
- (progn
- (forward-line 1)
- t)
- nil))))
+ (if (not (zerop article))
+ ()
+ (narrow-to-region
+ (match-end 0)
+ (or (and (re-search-forward nndoc-article-end nil t)
+ (match-beginning 0))
+ (point-max)))
+ (goto-char (point-min))
+ (and nndoc-head-begin
+ (re-search-forward nndoc-head-begin nil t)
+ (narrow-to-region (point) (point-max)))
+ (or (re-search-forward nndoc-head-end nil t)
+ (goto-char (point-max)))
+ (append-to-buffer ibuf (point-min) (point))
+ (and nndoc-body-begin
+ (re-search-forward nndoc-body-begin nil t))
+ (append-to-buffer ibuf (point) (point-max))
+ t))))
(provide 'nndoc)