X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnnmbox.el;h=914adfd41f4f5bc88821cd512b429c87497dd929;hb=ccb621a7efd32d36ae5171426338d575451ea6cb;hp=3c3a88cc40c91632b6193ea4c3c3c4d4b4930524;hpb=9da31b2c73efa8807205df69551f7576cc2477bc;p=gnus diff --git a/lisp/nnmbox.el b/lisp/nnmbox.el index 3c3a88cc4..914adfd41 100644 --- a/lisp/nnmbox.el +++ b/lisp/nnmbox.el @@ -1,7 +1,7 @@ ;;; nnmbox.el --- mail mbox access for Gnus -;; Copyright (C) 1995 Free Software Foundation, Inc. +;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. -;; Author: Lars Ingebrigtsen +;; Author: Lars Magne Ingebrigtsen ;; Masanobu UMEDA ;; Keywords: news, mail @@ -12,417 +12,546 @@ ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. ;;; Commentary: +;; For an overview of what the interface functions do, please see the +;; Gnus sources. + ;;; Code: (require 'nnheader) -(require 'rmail) +(require 'message) (require 'nnmail) +(require 'nnoo) +(eval-when-compile (require 'cl)) -(defvar nnmbox-mbox-file (expand-file-name "~/mbox") - "The name of the mail box file in the users home directory.") +(nnoo-declare nnmbox) -(defvar nnmbox-active-file (expand-file-name "~/.mbox-active") +(defvoo nnmbox-mbox-file (expand-file-name "~/mbox") + "The name of the mail box file in the user's home directory.") + +(defvoo nnmbox-active-file (expand-file-name "~/.mbox-active") "The name of the active file for the mail box.") -(defvar nnmbox-get-new-mail t - "If non-nil, nnml will check the incoming mail file and split the mail.") +(defvoo nnmbox-get-new-mail t + "If non-nil, nnmbox will check the incoming mail file and split the mail.") + +(defvoo nnmbox-prepare-save-mail-hook nil + "Hook run narrowed to an article before saving.") -(defconst nnmbox-version "nnmbox 0.1" +(defconst nnmbox-version "nnmbox 1.0" "nnmbox version.") -(defvar nnmbox-current-group nil +(defvoo nnmbox-current-group nil "Current nnmbox news group directory.") -(defconst nnmbox-mbox-buffer " *nnmbox mbox buffer*") +(defconst nnmbox-mbox-buffer nil) -(defvar nnmbox-status-string "") +(defvoo nnmbox-status-string "") -(defvar nnmbox-group-alist nil) +(defvoo nnmbox-group-alist nil) +(defvoo nnmbox-active-timestamp nil) + + ;;; Interface functions -(defun nnmbox-retrieve-headers (sequence &optional newsgroup server) - "Retrieve the headers for the articles in SEQUENCE. -Newsgroup must be selected before calling this function." +(nnoo-define-basics nnmbox) + +(deffoo nnmbox-retrieve-headers (sequence &optional newsgroup server fetch-old) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) - (let ((file nil) - (number (length sequence)) + (let ((number (length sequence)) (count 0) - beg article art-string start stop) - (nnmbox-possibly-change-newsgroup newsgroup) + article art-string start stop) + (nnmbox-possibly-change-newsgroup newsgroup server) (while sequence (setq article (car sequence)) (setq art-string (nnmbox-article-string article)) (set-buffer nnmbox-mbox-buffer) - (if (or (search-forward art-string nil t) - (progn (goto-char 1) - (search-forward art-string nil t))) - (progn - (setq start - (save-excursion - (re-search-backward - (concat "^" rmail-unix-mail-delimiter) nil t) - (point))) - (search-forward "\n\n" nil t) - (setq stop (1- (point))) - (set-buffer nntp-server-buffer) - (insert (format "221 %d Article retrieved.\n" article)) - (setq beg (point)) - (insert-buffer-substring nnmbox-mbox-buffer start stop) - (goto-char (point-max)) - (insert ".\n"))) + (when (or (search-forward art-string nil t) + (progn (goto-char (point-min)) + (search-forward art-string nil t))) + (setq start + (save-excursion + (re-search-backward + (concat "^" message-unix-mail-delimiter) nil t) + (point))) + (search-forward "\n\n" nil t) + (setq stop (1- (point))) + (set-buffer nntp-server-buffer) + (insert (format "221 %d Article retrieved.\n" article)) + (insert-buffer-substring nnmbox-mbox-buffer start stop) + (goto-char (point-max)) + (insert ".\n")) (setq sequence (cdr sequence)) (setq count (1+ count)) (and (numberp nnmail-large-newsgroup) (> number nnmail-large-newsgroup) (zerop (% count 20)) - gnus-verbose-backends - (message "nnmbox: Receiving headers... %d%%" - (/ (* count 100) number)))) + (nnheader-message 5 "nnmbox: Receiving headers... %d%%" + (/ (* count 100) number)))) (and (numberp nnmail-large-newsgroup) (> number nnmail-large-newsgroup) - gnus-verbose-backends - (message "nnmbox: Receiving headers... done")) + (nnheader-message 5 "nnmbox: Receiving headers...done")) - ;; Fold continuation lines. - (goto-char 1) - (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) - (replace-match " " t t)) + (set-buffer nntp-server-buffer) + (nnheader-fold-continuation-lines) 'headers))) -(defun nnmbox-open-server (host &optional service) - "Open mbox backend." - (setq nnmbox-status-string "") - (nnmbox-open-server-internal host service)) - -(defun nnmbox-close-server (&optional server) - "Close news server." - (nnmbox-close-server-internal)) +(deffoo nnmbox-open-server (server &optional defs) + (nnoo-change-server 'nnmbox server defs) + (nnmbox-create-mbox) + (cond + ((not (file-exists-p nnmbox-mbox-file)) + (nnmbox-close-server) + (nnheader-report 'nnmbox "No such file: %s" nnmbox-mbox-file)) + ((file-directory-p nnmbox-mbox-file) + (nnmbox-close-server) + (nnheader-report 'nnmbox "Not a regular file: %s" nnmbox-mbox-file)) + (t + (nnheader-report 'nnmbox "Opened server %s using mbox %s" server + nnmbox-mbox-file) + t))) + +(deffoo nnmbox-close-server (&optional server) + (when (and nnmbox-mbox-buffer + (buffer-name nnmbox-mbox-buffer)) + (kill-buffer nnmbox-mbox-buffer)) + (nnoo-close-server 'nnmbox server) + t) -(fset 'nnmbox-request-quit (symbol-function 'nnmbox-close-server)) +(deffoo nnmbox-server-opened (&optional server) + (and (nnoo-current-server-p 'nnmbox server) + nnmbox-mbox-buffer + (buffer-name nnmbox-mbox-buffer) + nntp-server-buffer + (buffer-name nntp-server-buffer))) -(defun nnmbox-server-opened (&optional server) - "Return server process status, T or NIL. -If the stream is opened, return T, otherwise return NIL." - (and nntp-server-buffer - (get-buffer nntp-server-buffer))) +(deffoo nnmbox-request-article (article &optional newsgroup server buffer) + (nnmbox-possibly-change-newsgroup newsgroup server) + (save-excursion + (set-buffer nnmbox-mbox-buffer) + (goto-char (point-min)) + (when (search-forward (nnmbox-article-string article) nil t) + (let (start stop) + (re-search-backward (concat "^" message-unix-mail-delimiter) nil t) + (setq start (point)) + (forward-line 1) + (or (and (re-search-forward + (concat "^" message-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 nnmbox-mbox-buffer start stop) + (goto-char (point-min)) + (while (looking-at "From ") + (delete-char 5) + (insert "X-From-Line: ") + (forward-line 1)) + (if (numberp article) + (cons nnmbox-current-group article) + (nnmbox-article-group-number))))))) + +(deffoo nnmbox-request-group (group &optional server dont-check) + (nnmbox-possibly-change-newsgroup nil server) + (let ((active (cadr (assoc group nnmbox-group-alist)))) + (cond + ((or (null active) + (null (nnmbox-possibly-change-newsgroup group server))) + (nnheader-report 'nnmbox "No such group: %s" group)) + (dont-check + (nnheader-report 'nnmbox "Selected group %s" group) + (nnheader-insert "")) + (t + (nnheader-report 'nnmbox "Selected group %s" group) + (nnheader-insert "211 %d %d %d %s\n" + (1+ (- (cdr active) (car active))) + (car active) (cdr active) group))))) + +(deffoo nnmbox-request-scan (&optional group server) + (nnmbox-possibly-change-newsgroup group server) + (nnmbox-read-mbox) + (nnmail-get-new-mail + 'nnmbox + (lambda () + (save-excursion + (set-buffer nnmbox-mbox-buffer) + (save-buffer))) + (file-name-directory nnmbox-mbox-file) + group + (lambda () + (save-excursion + (let ((in-buf (current-buffer))) + (set-buffer nnmbox-mbox-buffer) + (goto-char (point-max)) + (insert-buffer-substring in-buf))) + (nnmail-save-active nnmbox-group-alist nnmbox-active-file)))) -(defun nnmbox-status-message () - "Return server status response as string." - nnmbox-status-string) +(deffoo nnmbox-close-group (group &optional server) + t) -(defun nnmbox-request-article (article &optional newsgroup server buffer) - "Select ARTICLE by number." - (nnmbox-possibly-change-newsgroup newsgroup) - (if (stringp article) - nil - (save-excursion - (set-buffer nnmbox-mbox-buffer) - (goto-char 1) - (if (search-forward (nnmbox-article-string article) nil t) - (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 nnmbox-mbox-buffer start stop) - t)))))) - -(defun nnmbox-request-group (group &optional server dont-check) - "Select news GROUP." - (save-excursion - (if (nnmbox-possibly-change-newsgroup group) - (if dont-check - t - (nnmbox-get-new-mail) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (let ((active (assoc group nnmbox-group-alist))) - (insert (format "211 %d %d %d %s\n" - (1+ (- (cdr (car (cdr active))) - (car (car (cdr active))))) - (car (car (cdr active))) - (cdr (car (cdr active))) - (car active)))) - t))))) - -(defun nnmbox-close-group (group &optional server) +(deffoo nnmbox-request-create-group (group &optional server args) + (nnmail-activate 'nnmbox) + (unless (assoc group nnmbox-group-alist) + (push (list group (cons 1 0)) + nnmbox-group-alist) + (nnmail-save-active nnmbox-group-alist nnmbox-active-file)) t) -(defun nnmbox-request-list (&optional server) - "List active newsgoups." - (if server (nnmbox-get-new-mail)) - (nnmail-find-file nnmbox-active-file)) +(deffoo nnmbox-request-list (&optional server) + (save-excursion + (nnmail-find-file nnmbox-active-file) + (setq nnmbox-group-alist (nnmail-get-active)) + t)) -(defun nnmbox-request-newgroups (date &optional server) - "List groups created after DATE." +(deffoo nnmbox-request-newgroups (date &optional server) (nnmbox-request-list server)) -(defun nnmbox-request-list-newsgroups (&optional server) - "List newsgroups (defined in NNTP2)." - (setq nnmbox-status-string "nnmbox: LIST NEWSGROUPS is not implemented.") - nil) - -(defun nnmbox-request-post (&optional server) - "Post a new news in current buffer." - (mail-send-and-exit nil)) - -(fset 'nnmbox-request-post-buffer 'nnmbox-request-post-buffer) - -(defun nnmbox-request-expire-articles (articles newsgroup &optional server force) - "Expire all articles in the ARTICLES list in group GROUP. -The list of unexpired articles will be returned (ie. all articles that -were too fresh to be expired). -If FORCE is non-nil, the ARTICLES will be deleted without looking at -the date." - (nnmbox-possibly-change-newsgroup newsgroup) - (let* ((days (or (and nnmail-expiry-wait-function - (funcall nnmail-expiry-wait-function newsgroup)) - nnmail-expiry-wait)) - article rest) - (save-excursion +(deffoo nnmbox-request-list-newsgroups (&optional server) + (nnheader-report 'nnmbox "LIST NEWSGROUPS is not implemented.")) + +(deffoo nnmbox-request-expire-articles + (articles newsgroup &optional server force) + (nnmbox-possibly-change-newsgroup newsgroup server) + (let* ((is-old t) + rest) + (nnmail-activate 'nnmbox) + + (save-excursion (set-buffer nnmbox-mbox-buffer) - (while articles - (goto-char 1) - (if (search-forward (nnmbox-article-string (car articles)) nil t) - (if (or force - (> (nnmail-days-between - (current-time-string) - (buffer-substring - (point) (progn (end-of-line) (point)))) - days)) - (progn - (and gnus-verbose-backends - (message "Deleting: %s" (car articles))) - (nnmbox-delete-mail)) - (setq rest (cons (car articles) rest)))) + (while (and articles is-old) + (goto-char (point-min)) + (when (search-forward (nnmbox-article-string (car articles)) nil t) + (if (setq is-old + (nnmail-expired-article-p + newsgroup + (buffer-substring + (point) (progn (end-of-line) (point))) force)) + (progn + (nnheader-message 5 "Deleting article %d in %s..." + (car articles) newsgroup) + (nnmbox-delete-mail)) + (push (car articles) rest))) (setq articles (cdr articles))) (save-buffer) - rest))) - -(defun nnmbox-request-move-article (article group server accept-form) + ;; Find the lowest active article in this group. + (let ((active (nth 1 (assoc newsgroup nnmbox-group-alist)))) + (goto-char (point-min)) + (while (and (not (search-forward + (nnmbox-article-string (car active)) nil t)) + (<= (car active) (cdr active))) + (setcar active (1+ (car active))) + (goto-char (point-min)))) + (nnmail-save-active nnmbox-group-alist nnmbox-active-file) + (nconc rest articles)))) + +(deffoo nnmbox-request-move-article + (article group server accept-form &optional last) (let ((buf (get-buffer-create " *nnmbox move*")) result) - (and + (and (nnmbox-request-article article group server) (save-excursion (set-buffer buf) + (erase-buffer) (insert-buffer-substring nntp-server-buffer) (goto-char (point-min)) - (if (re-search-forward - "^X-Gnus-Newsgroup:" - (save-excursion (search-forward "\n\n" nil t) (point)) t) - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point)))) + (while (re-search-forward + "^X-Gnus-Newsgroup:" + (save-excursion (search-forward "\n\n" nil t) (point)) t) + (delete-region (progn (beginning-of-line) (point)) + (progn (forward-line 1) (point)))) (setq result (eval accept-form)) - (kill-buffer (current-buffer)) + (kill-buffer buf) result) (save-excursion + (nnmbox-possibly-change-newsgroup group server) (set-buffer nnmbox-mbox-buffer) - (goto-char 1) - (if (search-forward (nnmbox-article-string article) nil t) - (nnmbox-delete-mail)) - (save-buffer))) + (goto-char (point-min)) + (when (search-forward (nnmbox-article-string article) nil t) + (nnmbox-delete-mail)) + (and last (save-buffer)))) result)) -(defun nnmbox-request-accept-article (group) +(deffoo nnmbox-request-accept-article (group &optional server last) + (nnmbox-possibly-change-newsgroup group server) + (nnmail-check-syntax) (let ((buf (current-buffer)) - result beg) - (and - (setq nnmbox-group-alist (nnmail-get-active)) + result) + (goto-char (point-min)) + ;; The From line may have been quoted by movemail. + (when (looking-at (concat ">" message-unix-mail-delimiter)) + (delete-char 1)) + (if (looking-at "X-From-Line: ") + (replace-match "From ") + (insert "From nobody " (current-time-string) "\n")) + (and + (nnmail-activate 'nnmbox) + (progn + (set-buffer buf) + (goto-char (point-min)) + (search-forward "\n\n" nil t) + (forward-line -1) + (while (re-search-backward "^X-Gnus-Newsgroup: " nil t) + (delete-region (point) (progn (forward-line 1) (point)))) + (when nnmail-cache-accepted-message-ids + (nnmail-cache-insert (nnmail-fetch-field "message-id"))) + (setq result (if (stringp group) + (list (cons group (nnmbox-active-number group))) + (nnmail-article-group 'nnmbox-active-number))) + (if (and (null result) + (yes-or-no-p "Moved to `junk' group; delete article? ")) + (setq result 'junk) + (setq result (car (nnmbox-save-mail result))))) (save-excursion (set-buffer nnmbox-mbox-buffer) - (setq beg (goto-char (point-max))) + (goto-char (point-max)) (insert-buffer-substring buf) - (goto-char beg) - (if (stringp group) - (progn - (search-forward "\n\n" nil t) - (forward-line -1) - (save-excursion - (while (re-search-backward "^X-Gnus-Newsgroup: " beg t) - (delete-region (point) (progn (forward-line 1) (point))))) - (setq result (nnmbox-insert-newsgroup-line group))) - (setq result (nnmbox-save-mail))) - (save-buffer) - result) - (nnmail-save-active nnmbox-group-alist nnmbox-active-file)) + (when last + (when nnmail-cache-accepted-message-ids + (nnmail-cache-close)) + (nnmail-save-active nnmbox-group-alist nnmbox-active-file) + (save-buffer)))) result)) +(deffoo nnmbox-request-replace-article (article group buffer) + (nnmbox-possibly-change-newsgroup group) + (save-excursion + (set-buffer nnmbox-mbox-buffer) + (goto-char (point-min)) + (if (not (search-forward (nnmbox-article-string article) nil t)) + nil + (nnmbox-delete-mail t t) + (insert-buffer-substring buffer) + (save-buffer) + t))) + +(deffoo nnmbox-request-delete-group (group &optional force server) + (nnmbox-possibly-change-newsgroup group server) + ;; Delete all articles in GROUP. + (if (not force) + () ; Don't delete the articles. + (save-excursion + (set-buffer nnmbox-mbox-buffer) + (goto-char (point-min)) + ;; Delete all articles in this group. + (let ((ident (concat "\nX-Gnus-Newsgroup: " nnmbox-current-group ":")) + found) + (while (search-forward ident nil t) + (setq found t) + (nnmbox-delete-mail)) + (when found + (save-buffer))))) + ;; Remove the group from all structures. + (setq nnmbox-group-alist + (delq (assoc group nnmbox-group-alist) nnmbox-group-alist) + nnmbox-current-group nil) + ;; Save the active file. + (nnmail-save-active nnmbox-group-alist nnmbox-active-file) + t) + +(deffoo nnmbox-request-rename-group (group new-name &optional server) + (nnmbox-possibly-change-newsgroup group server) + (save-excursion + (set-buffer nnmbox-mbox-buffer) + (goto-char (point-min)) + (let ((ident (concat "\nX-Gnus-Newsgroup: " nnmbox-current-group ":")) + (new-ident (concat "\nX-Gnus-Newsgroup: " new-name ":")) + found) + (while (search-forward ident nil t) + (replace-match new-ident t t) + (setq found t)) + (when found + (save-buffer)))) + (let ((entry (assoc group nnmbox-group-alist))) + (when entry + (setcar entry new-name)) + (setq nnmbox-current-group nil) + ;; Save the new group alist. + (nnmail-save-active nnmbox-group-alist nnmbox-active-file) + t)) + -;;; Low-Level Interface +;;; Internal functions. -(defun nnmbox-delete-mail () +;; If FORCE, delete article no matter how many X-Gnus-Newsgroup +;; headers there are. If LEAVE-DELIM, don't delete the Unix mbox +;; delimiter line. +(defun nnmbox-delete-mail (&optional force leave-delim) ;; Delete the current X-Gnus-Newsgroup line. - (delete-region - (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point))) + (or force + (delete-region + (progn (beginning-of-line) (point)) + (progn (forward-line 1) (point)))) ;; Beginning of the article. (save-excursion (save-restriction (narrow-to-region (save-excursion - (re-search-backward (concat "^" rmail-unix-mail-delimiter) nil t) - (match-beginning 0)) + (re-search-backward (concat "^" message-unix-mail-delimiter) nil t) + (if leave-delim (progn (forward-line 1) (point)) + (match-beginning 0))) (progn - (re-search-forward (concat "^" rmail-unix-mail-delimiter) nil t) - (match-beginning 0))) + (forward-line 1) + (or (and (re-search-forward (concat "^" message-unix-mail-delimiter) + nil t) + (if (and (not (bobp)) leave-delim) + (progn (forward-line -2) (point)) + (match-beginning 0))) + (point-max)))) (goto-char (point-min)) ;; Only delete the article if no other groups owns it as well. - (if (not (re-search-forward "^X-Gnus-Newsgroup: " nil t)) - (delete-region (point-min) (point-max)))))) - -(defun nnmbox-open-server-internal (host &optional service) - "Open connection to news server on HOST by SERVICE (default is nntp)." - (save-excursion - (if (not (string-equal host (system-name))) - (error "nnmbox: cannot talk to %s." host)) - ;; Initialize communication buffer. - (setq nntp-server-buffer (get-buffer-create " *nntpd*")) - (set-buffer nntp-server-buffer) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (kill-all-local-variables) - (setq case-fold-search t) ;Should ignore case. - (setq nnmbox-group-alist nil) - t)) - -(defun nnmbox-close-server-internal () - "Close connection to news server." - nil) - -(defun nnmbox-possibly-change-newsgroup (newsgroup) - (if (not (get-buffer nnmbox-mbox-buffer)) - (save-excursion - (set-buffer (setq nnmbox-mbox-buffer - (find-file-noselect nnmbox-mbox-file))) - (buffer-disable-undo (current-buffer)))) - (if (not nnmbox-group-alist) - (setq nnmbox-group-alist (nnmail-get-active))) + (when (or force (not (re-search-forward "^X-Gnus-Newsgroup: " nil t))) + (delete-region (point-min) (point-max)))))) + +(defun nnmbox-possibly-change-newsgroup (newsgroup &optional server) + (when (and server + (not (nnmbox-server-opened server))) + (nnmbox-open-server server)) + (when (or (not nnmbox-mbox-buffer) + (not (buffer-name nnmbox-mbox-buffer))) + (save-excursion + (set-buffer (setq nnmbox-mbox-buffer + (nnheader-find-file-noselect + nnmbox-mbox-file nil t))) + (mm-enable-multibyte) + (buffer-disable-undo))) + (when (not nnmbox-group-alist) + (nnmail-activate 'nnmbox)) (if newsgroup - (if (assoc newsgroup nnmbox-group-alist) - (setq nnmbox-current-group newsgroup)))) + (when (assoc newsgroup nnmbox-group-alist) + (setq nnmbox-current-group newsgroup)) + t)) (defun nnmbox-article-string (article) - (concat "\nX-Gnus-Newsgroup: " nnmbox-current-group ":" - (int-to-string article))) + (if (numberp article) + (concat "\nX-Gnus-Newsgroup: " nnmbox-current-group ":" + (int-to-string article) " ") + (concat "\nMessage-ID: " article))) -(defun nnmbox-save-mail () +(defun nnmbox-article-group-number () + (save-excursion + (goto-char (point-min)) + (when (re-search-forward "^X-Gnus-Newsgroup: +\\([^:]+\\):\\([0-9]+\\) " + nil t) + (cons (buffer-substring (match-beginning 1) (match-end 1)) + (string-to-int + (buffer-substring (match-beginning 2) (match-end 2))))))) + +(defun nnmbox-save-mail (group-art) "Called narrowed to an article." - (let ((group-art (nreverse (nnmail-article-group 'nnmbox-active-number)))) + (let ((delim (concat "^" message-unix-mail-delimiter))) + (goto-char (point-min)) + ;; This might come from somewhere else. + (unless (looking-at delim) + (insert "From nobody " (current-time-string) "\n") + (goto-char (point-min))) + ;; Quote all "From " lines in the article. + (forward-line 1) + (while (re-search-forward delim nil t) + (beginning-of-line) + (insert "> ")) (nnmail-insert-lines) (nnmail-insert-xref group-art) - (nnmbox-insert-newsgroup-line group-art))) + (nnmbox-insert-newsgroup-line group-art) + (run-hooks 'nnmail-prepare-save-mail-hook) + (run-hooks 'nnmbox-prepare-save-mail-hook) + group-art)) (defun nnmbox-insert-newsgroup-line (group-art) (save-excursion (goto-char (point-min)) - (if (search-forward "\n\n" nil t) - (progn - (forward-char -1) - (while group-art - (insert (format "X-Gnus-Newsgroup: %s:%d %s\n" - (car (car group-art)) (cdr (car group-art)) - (current-time-string))) - (setq group-art (cdr group-art))))))) + (when (search-forward "\n\n" nil t) + (forward-char -1) + (while group-art + (insert (format "X-Gnus-Newsgroup: %s:%d %s\n" + (caar group-art) (cdar group-art) + (current-time-string))) + (setq group-art (cdr group-art)))) + t)) (defun nnmbox-active-number (group) - "Find the next article number in GROUP." - (let ((active (car (cdr (assoc group nnmbox-group-alist))))) - (setcdr active (1+ (cdr active))) + ;; Find the next article number in GROUP. + (let ((active (cadr (assoc group nnmbox-group-alist)))) + (if active + (setcdr active (1+ (cdr active))) + ;; This group is new, so we create a new entry for it. + ;; This might be a bit naughty... creating groups on the drop of + ;; a hat, but I don't know... + (push (list group (setq active (cons 1 1))) + nnmbox-group-alist)) (cdr active))) +(defun nnmbox-create-mbox () + (when (not (file-exists-p nnmbox-mbox-file)) + (nnmail-write-region 1 1 nnmbox-mbox-file t 'nomesg))) + (defun nnmbox-read-mbox () - (nnmbox-request-list) - (setq nnmbox-group-alist (nnmail-get-active)) - (if (not (file-exists-p nnmbox-mbox-file)) - (write-region 1 1 nnmbox-mbox-file t 'nomesg)) + (nnmail-activate 'nnmbox) + (nnmbox-create-mbox) (if (and nnmbox-mbox-buffer - (get-buffer nnmbox-mbox-buffer) (buffer-name nnmbox-mbox-buffer) (save-excursion (set-buffer nnmbox-mbox-buffer) - (= (buffer-size) (nth 7 (file-attributes nnmbox-mbox-file))))) + (= (buffer-size) (nnheader-file-size nnmbox-mbox-file)))) () (save-excursion - (let ((delim (concat "^" rmail-unix-mail-delimiter)) - start end) - (set-buffer (setq nnmbox-mbox-buffer - (find-file-noselect nnmbox-mbox-file))) - (buffer-disable-undo (current-buffer)) + (let ((delim (concat "^" message-unix-mail-delimiter)) + (alist nnmbox-group-alist) + start end number) + (set-buffer (setq nnmbox-mbox-buffer + (nnheader-find-file-noselect + nnmbox-mbox-file nil t))) + (mm-enable-multibyte) + (buffer-disable-undo) + + ;; Go through the group alist and compare against + ;; the mbox file. + (while alist + (goto-char (point-max)) + (when (and (re-search-backward + (format "^X-Gnus-Newsgroup: %s:\\([0-9]+\\) " + (caar alist)) nil t) + (>= (setq number + (string-to-number + (buffer-substring + (match-beginning 1) (match-end 1)))) + (cdadar alist))) + (setcdr (cadar alist) (1+ number))) + (setq alist (cdr alist))) + (goto-char (point-min)) (while (re-search-forward delim nil t) (setq start (match-beginning 0)) - (if (not (search-forward "\nX-Gnus-Newsgroup: " - (save-excursion - (setq end - (or - (and - (re-search-forward delim nil t) - (match-beginning 0)) - (point-max)))) - t)) - (save-excursion - (save-restriction - (narrow-to-region start end) - (nnmbox-save-mail)))) + (when (not (search-forward "\nX-Gnus-Newsgroup: " + (save-excursion + (setq end + (or + (and + (re-search-forward delim nil t) + (match-beginning 0)) + (point-max)))) + t)) + (save-excursion + (save-restriction + (narrow-to-region start end) + (nnmbox-save-mail + (nnmail-article-group 'nnmbox-active-number))))) (goto-char end)))))) -(defun nnmbox-get-new-mail () - (let (incoming) - (nnmbox-read-mbox) - (if (and nnmail-spool-file - (file-exists-p nnmail-spool-file) - (> (nth 7 (file-attributes nnmail-spool-file)) 0)) - (progn - (and gnus-verbose-backends - (message "nnmbox: Reading incoming mail...")) - (setq incoming - (nnmail-move-inbox nnmail-spool-file - (concat nnmbox-mbox-file "-Incoming"))) - (save-excursion - (let ((in-buf (nnmail-split-incoming - incoming 'nnmbox-save-mail t))) - (set-buffer nnmbox-mbox-buffer) - (goto-char (point-max)) - (insert-buffer-substring in-buf) - (kill-buffer in-buf))) - (run-hooks 'nnmail-read-incoming-hook) - (and gnus-verbose-backends - (message "nnmbox: Reading incoming mail...done")))) - (and (buffer-modified-p nnmbox-mbox-buffer) - (save-excursion - (nnmail-save-active nnmbox-group-alist nnmbox-active-file) - (set-buffer nnmbox-mbox-buffer) - (save-buffer))) -; (if incoming -; (delete-file incoming)) - )) - (provide 'nnmbox) ;;; nnmbox.el ends here