X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnnmbox.el;h=5f6ecd103da9a77813fee20b1aee7a383472fb21;hb=8ea1f15fd54f5a6b6bc71dd0b6c155ab77f474c1;hp=1b9f9ee23c57fd60adecad9e566e13e970f12137;hpb=4bff22e9e7b591a8c374edcaddbbc042e25e9731;p=gnus diff --git a/lisp/nnmbox.el b/lisp/nnmbox.el index 1b9f9ee23..5f6ecd103 100644 --- a/lisp/nnmbox.el +++ b/lisp/nnmbox.el @@ -1,7 +1,7 @@ ;;; nnmbox.el --- mail mbox access for Gnus -;; Copyright (C) 1995,96,97 Free Software Foundation, Inc. +;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. -;; Author: Lars Magne Ingebrigtsen +;; Author: Lars Magne Ingebrigtsen ;; Masanobu UMEDA ;; Keywords: news, mail @@ -12,11 +12,6 @@ ;; 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, Inc., 59 Temple Place - Suite 330, @@ -25,7 +20,7 @@ ;;; Commentary: ;; For an overview of what the interface functions do, please see the -;; Gnus sources. +;; Gnus sources. ;;; Code: @@ -64,6 +59,11 @@ (defvoo nnmbox-group-alist nil) (defvoo nnmbox-active-timestamp nil) +(defvoo nnmbox-file-coding-system mm-text-coding-system) +(defvoo nnmbox-file-coding-system-for-write nil) +(defvoo nnmbox-active-file-coding-system mm-text-coding-system) +(defvoo nnmbox-active-file-coding-system-for-write nil) + ;;; Interface functions @@ -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) @@ -116,7 +116,7 @@ (deffoo nnmbox-open-server (server &optional defs) (nnoo-change-server 'nnmbox server defs) (nnmbox-create-mbox) - (cond + (cond ((not (file-exists-p nnmbox-mbox-file)) (nnmbox-close-server) (nnheader-report 'nnmbox "No such file: %s" nnmbox-mbox-file)) @@ -152,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,8 +171,9 @@ (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 + (cond ((or (null active) (null (nnmbox-possibly-change-newsgroup group server))) (nnheader-report 'nnmbox "No such group: %s" group)) @@ -181,19 +182,31 @@ (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))))) +(defun nnmbox-save-buffer () + (let ((coding-system-for-write + (or nnmbox-file-coding-system-for-write + nnmbox-file-coding-system))) + (save-buffer))) + +(defun nnmbox-save-active (group-alist active-file) + (let ((nnmail-active-file-coding-system + (or nnmbox-active-file-coding-system-for-write + nnmbox-active-file-coding-system))) + (nnmail-save-active group-alist active-file))) + (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-save-buffer))) (file-name-directory nnmbox-mbox-file) group (lambda () @@ -202,14 +215,24 @@ (set-buffer nnmbox-mbox-buffer) (goto-char (point-max)) (insert-buffer-substring in-buf))) - (nnmail-save-active nnmbox-group-alist nnmbox-active-file)))) + (nnmbox-save-active nnmbox-group-alist nnmbox-active-file)))) (deffoo nnmbox-close-group (group &optional server) t) +(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) + (nnmbox-save-active nnmbox-group-alist nnmbox-active-file)) + t) + (deffoo nnmbox-request-list (&optional server) (save-excursion - (nnmail-find-file nnmbox-active-file) + (let ((nnmail-file-coding-system + nnmbox-active-file-coding-system)) + (nnmail-find-file nnmbox-active-file)) (setq nnmbox-group-alist (nnmail-get-active)) t)) @@ -219,14 +242,14 @@ (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) +(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)) @@ -234,7 +257,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..." @@ -242,7 +265,7 @@ (nnmbox-delete-mail)) (push (car articles) rest))) (setq articles (cdr articles))) - (save-buffer) + (nnmbox-save-buffer) ;; Find the lowest active article in this group. (let ((active (nth 1 (assoc newsgroup nnmbox-group-alist)))) (goto-char (point-min)) @@ -251,23 +274,22 @@ (<= (car active) (cdr active))) (setcar active (1+ (car active))) (goto-char (point-min)))) - (nnmail-save-active nnmbox-group-alist nnmbox-active-file) + (nnmbox-save-active nnmbox-group-alist nnmbox-active-file) (nconc rest articles)))) (deffoo nnmbox-request-move-article - (article group server accept-form &optional last) + (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) - (buffer-disable-undo (current-buffer)) (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)))) @@ -280,7 +302,7 @@ (goto-char (point-min)) (when (search-forward (nnmbox-article-string article) nil t) (nnmbox-delete-mail)) - (and last (save-buffer)))) + (and last (nnmbox-save-buffer)))) result)) (deffoo nnmbox-request-accept-article (group &optional server last) @@ -295,7 +317,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) @@ -304,21 +326,25 @@ (forward-line -1) (while (re-search-backward "^X-Gnus-Newsgroup: " nil t) (delete-region (point) (progn (forward-line 1) (point)))) - (when nnmail-cache-message-id-when-accepting + (when nnmail-cache-accepted-message-ids (nnmail-cache-insert (nnmail-fetch-field "message-id"))) - (setq result (nnmbox-save-mail - (if (stringp group) - (list (cons group (nnmbox-active-number group))) - (nnmail-article-group 'nnmbox-active-number))))) + (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) (goto-char (point-max)) (insert-buffer-substring buf) (when last - (nnmail-cache-close) - (nnmail-save-active nnmbox-group-alist nnmbox-active-file) - (save-buffer)))) - (car result))) + (when nnmail-cache-accepted-message-ids + (nnmail-cache-close)) + (nnmbox-save-active nnmbox-group-alist nnmbox-active-file) + (nnmbox-save-buffer)))) + result)) (deffoo nnmbox-request-replace-article (article group buffer) (nnmbox-possibly-change-newsgroup group) @@ -329,7 +355,7 @@ nil (nnmbox-delete-mail t t) (insert-buffer-substring buffer) - (save-buffer) + (nnmbox-save-buffer) t))) (deffoo nnmbox-request-delete-group (group &optional force server) @@ -347,13 +373,13 @@ (setq found t) (nnmbox-delete-mail)) (when found - (save-buffer))))) + (nnmbox-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. - (nnmail-save-active nnmbox-group-alist nnmbox-active-file) + (nnmbox-save-active nnmbox-group-alist nnmbox-active-file) t) (deffoo nnmbox-request-rename-group (group new-name &optional server) @@ -368,13 +394,13 @@ (replace-match new-ident t t) (setq found t)) (when found - (save-buffer)))) + (nnmbox-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) + (nnmbox-save-active nnmbox-group-alist nnmbox-active-file) t)) @@ -411,16 +437,19 @@ (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 - (nnheader-find-file-noselect - nnmbox-mbox-file nil 'raw))) - (buffer-disable-undo (current-buffer)))) + (set-buffer (setq nnmbox-mbox-buffer + (let ((nnheader-file-coding-system + nnmbox-file-coding-system)) + (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 @@ -430,7 +459,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))) @@ -469,7 +498,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)))) @@ -489,7 +518,10 @@ (defun nnmbox-create-mbox () (when (not (file-exists-p nnmbox-mbox-file)) - (nnmail-write-region 1 1 nnmbox-mbox-file t 'nomesg))) + (let ((nnmail-file-coding-system + (or nnmbox-file-coding-system-for-write + nnmbox-file-coding-system))) + (nnmail-write-region 1 1 nnmbox-mbox-file t 'nomesg)))) (defun nnmbox-read-mbox () (nnmail-activate 'nnmbox) @@ -504,10 +536,13 @@ (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 'raw))) - (buffer-disable-undo (current-buffer)) + (set-buffer (setq nnmbox-mbox-buffer + (let ((nnheader-file-coding-system + nnmbox-file-coding-system)) + (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. @@ -516,30 +551,35 @@ (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 number + (string-to-number + (buffer-substring + (match-beginning 1) (match-end 1)))) + (cdadar alist))) + (setcdr (cadar alist) 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 - (setq end - (or - (and - (re-search-forward delim nil t) - (match-beginning 0)) - (point-max)))) - t)) + (unless (search-forward + "\nX-Gnus-Newsgroup: " + (save-excursion + (setq end + (or + (and + ;; skip to end of headers first, since mail + ;; which has been respooled has additional + ;; "From nobody" lines. + (search-forward "\n\n" nil t) + (re-search-forward delim nil t) + (match-beginning 0)) + (point-max)))) + t) (save-excursion (save-restriction (narrow-to-region start end) - (nnmbox-save-mail + (nnmbox-save-mail (nnmail-article-group 'nnmbox-active-number))))) (goto-char end))))))