X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnnmbox.el;h=6c8dd2823849f972dac341aa5644bb87cc911b82;hb=b28454eed83f245c4160228b076134ce930b320a;hp=bb28d0e81cef196f66d0a8085ad8a39f17349fc3;hpb=aa88205ebb3cd4ade3696b2faf1d72a687cffa49;p=gnus diff --git a/lisp/nnmbox.el b/lisp/nnmbox.el index bb28d0e81..6c8dd2823 100644 --- a/lisp/nnmbox.el +++ b/lisp/nnmbox.el @@ -1,5 +1,5 @@ ;;; nnmbox.el --- mail mbox access for Gnus -;; Copyright (C) 1995,96 Free Software Foundation, Inc. +;; Copyright (C) 1995,96,97 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Masanobu UMEDA @@ -25,7 +25,7 @@ ;;; Commentary: ;; For an overview of what the interface functions do, please see the -;; Gnus sources. +;; Gnus sources. ;;; Code: @@ -85,9 +85,9 @@ (when (or (search-forward art-string nil t) (progn (goto-char (point-min)) (search-forward art-string nil t))) - (setq start + (setq start (save-excursion - (re-search-backward + (re-search-backward (concat "^" message-unix-mail-delimiter) nil t) (point))) (search-forward "\n\n" nil t) @@ -115,7 +115,8 @@ (deffoo nnmbox-open-server (server &optional defs) (nnoo-change-server 'nnmbox server defs) - (cond + (nnmbox-create-mbox) + (cond ((not (file-exists-p nnmbox-mbox-file)) (nnmbox-close-server) (nnheader-report 'nnmbox "No such file: %s" nnmbox-mbox-file)) @@ -151,7 +152,7 @@ (re-search-backward (concat "^" message-unix-mail-delimiter) nil t) (setq start (point)) (forward-line 1) - (or (and (re-search-forward + (or (and (re-search-forward (concat "^" message-unix-mail-delimiter) nil t) (forward-line -1)) (goto-char (point-max))) @@ -171,7 +172,7 @@ (deffoo nnmbox-request-group (group &optional server dont-check) (let ((active (cadr (assoc group nnmbox-group-alist)))) - (cond + (cond ((or (null active) (null (nnmbox-possibly-change-newsgroup group server))) (nnheader-report 'nnmbox "No such group: %s" group)) @@ -180,20 +181,21 @@ (nnheader-insert "")) (t (nnheader-report 'nnmbox "Selected group %s" group) - (nnheader-insert "211 %d %d %d %s\n" + (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 + (nnmail-get-new-mail + 'nnmbox (lambda () (save-excursion (set-buffer nnmbox-mbox-buffer) (save-buffer))) - nnmbox-mbox-file group + (file-name-directory nnmbox-mbox-file) + group (lambda () (save-excursion (let ((in-buf (current-buffer))) @@ -208,7 +210,8 @@ (deffoo nnmbox-request-list (&optional server) (save-excursion (nnmail-find-file nnmbox-active-file) - (setq nnmbox-group-alist (nnmail-get-active)))) + (setq nnmbox-group-alist (nnmail-get-active)) + t)) (deffoo nnmbox-request-newgroups (date &optional server) (nnmbox-request-list server)) @@ -216,14 +219,14 @@ (deffoo nnmbox-request-list-newsgroups (&optional server) (nnheader-report 'nnmbox "LIST NEWSGROUPS is not implemented.")) -(deffoo nnmbox-request-expire-articles +(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 + (save-excursion (set-buffer nnmbox-mbox-buffer) (while (and articles is-old) (goto-char (point-min)) @@ -231,7 +234,7 @@ (if (setq is-old (nnmail-expired-article-p newsgroup - (buffer-substring + (buffer-substring (point) (progn (end-of-line) (point))) force)) (progn (nnheader-message 5 "Deleting article %d in %s..." @@ -255,7 +258,7 @@ (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) @@ -263,8 +266,8 @@ (erase-buffer) (insert-buffer-substring nntp-server-buffer) (goto-char (point-min)) - (while (re-search-forward - "^X-Gnus-Newsgroup:" + (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)))) @@ -292,7 +295,7 @@ (if (looking-at "X-From-Line: ") (replace-match "From ") (insert "From nobody " (current-time-string) "\n")) - (and + (and (nnmail-activate 'nnmbox) (progn (set-buffer buf) @@ -301,6 +304,7 @@ (forward-line -1) (while (re-search-backward "^X-Gnus-Newsgroup: " nil t) (delete-region (point) (progn (forward-line 1) (point)))) + (nnmail-cache-insert (nnmail-fetch-field "message-id")) (setq result (nnmbox-save-mail (if (stringp group) (list (cons group (nnmbox-active-number group))) @@ -309,9 +313,10 @@ (set-buffer nnmbox-mbox-buffer) (goto-char (point-max)) (insert-buffer-substring buf) - (and last (save-buffer)) - result) - (nnmail-save-active nnmbox-group-alist nnmbox-active-file)) + (when last + (nnmail-cache-close) + (nnmail-save-active nnmbox-group-alist nnmbox-active-file) + (save-buffer)))) (car result))) (deffoo nnmbox-request-replace-article (article group buffer) @@ -343,7 +348,7 @@ (when found (save-buffer))))) ;; Remove the group from all structures. - (setq nnmbox-group-alist + (setq nnmbox-group-alist (delq (assoc group nnmbox-group-alist) nnmbox-group-alist) nnmbox-current-group nil) ;; Save the active file. @@ -405,13 +410,13 @@ (delete-region (point-min) (point-max)))))) (defun nnmbox-possibly-change-newsgroup (newsgroup &optional server) - (when (and 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 + (set-buffer (setq nnmbox-mbox-buffer (nnheader-find-file-noselect nnmbox-mbox-file nil 'raw))) (buffer-disable-undo (current-buffer)))) @@ -424,7 +429,7 @@ (defun nnmbox-article-string (article) (if (numberp article) - (concat "\nX-Gnus-Newsgroup: " nnmbox-current-group ":" + (concat "\nX-Gnus-Newsgroup: " nnmbox-current-group ":" (int-to-string article) " ") (concat "\nMessage-ID: " article))) @@ -463,7 +468,7 @@ (when (search-forward "\n\n" nil t) (forward-char -1) (while group-art - (insert (format "X-Gnus-Newsgroup: %s:%d %s\n" + (insert (format "X-Gnus-Newsgroup: %s:%d %s\n" (caar group-art) (cdar group-art) (current-time-string))) (setq group-art (cdr group-art)))) @@ -481,10 +486,13 @@ 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 () (nnmail-activate 'nnmbox) - (when (not (file-exists-p nnmbox-mbox-file)) - (nnmail-write-region 1 1 nnmbox-mbox-file t 'nomesg)) + (nnmbox-create-mbox) (if (and nnmbox-mbox-buffer (buffer-name nnmbox-mbox-buffer) (save-excursion @@ -495,7 +503,7 @@ (let ((delim (concat "^" message-unix-mail-delimiter)) (alist nnmbox-group-alist) start end number) - (set-buffer (setq nnmbox-mbox-buffer + (set-buffer (setq nnmbox-mbox-buffer (nnheader-find-file-noselect nnmbox-mbox-file nil 'raw))) (buffer-disable-undo (current-buffer)) @@ -508,18 +516,18 @@ (format "^X-Gnus-Newsgroup: %s:\\([0-9]+\\) " (caar alist)) nil t) (>= (setq number - (string-to-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)) - (when (not (search-forward "\nX-Gnus-Newsgroup: " - (save-excursion + (when (not (search-forward "\nX-Gnus-Newsgroup: " + (save-excursion (setq end (or (and @@ -530,7 +538,7 @@ (save-excursion (save-restriction (narrow-to-region start end) - (nnmbox-save-mail + (nnmbox-save-mail (nnmail-article-group 'nnmbox-active-number))))) (goto-char end))))))