X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fnnml.el;h=3662db9719bf75311b9142959a219a08918cfd9c;hp=ffc38ebec1111a5ec18c64244d44a1aba0a5d739;hb=4724093b5726d891e49e07191b52a14db1b93ecd;hpb=e280352de533701d890643bcc083667f2ad0331b diff --git a/lisp/nnml.el b/lisp/nnml.el index ffc38ebec..3662db971 100644 --- a/lisp/nnml.el +++ b/lisp/nnml.el @@ -1,10 +1,10 @@ ;;; nnml.el --- mail spool access for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003 ;; Free Software Foundation, Inc. ;; Author: Simon Josefsson (adding MARKS) ;; Lars Magne Ingebrigtsen -;; Masanobu UMEDA +;; Masanobu UMEDA ;; Keywords: news, mail ;; This file is part of GNU Emacs. @@ -38,29 +38,24 @@ (require 'nnoo) (eval-when-compile (require 'cl)) +(eval-and-compile + (autoload 'gnus-article-unpropagatable-p "gnus-sum")) + (nnoo-declare nnml) (defvoo nnml-directory message-directory - "Spool directory for the nnml mail backend. - -This variable is a virtual server slot. See the Gnus manual for details.") + "Spool directory for the nnml mail backend.") (defvoo nnml-active-file (expand-file-name "active" nnml-directory) - "Mail active file. - -This variable is a virtual server slot. See the Gnus manual for details.") + "Mail active file.") (defvoo nnml-newsgroups-file (expand-file-name "newsgroups" nnml-directory) - "Mail newsgroups description file. - -This variable is a virtual server slot. See the Gnus manual for details.") + "Mail newsgroups description file.") (defvoo nnml-get-new-mail t - "If non-nil, nnml will check the incoming mail file and split the mail. - -This variable is a virtual server slot. See the Gnus manual for details.") + "If non-nil, nnml will check the incoming mail file and split the mail.") (defvoo nnml-nov-is-evil nil "If non-nil, Gnus will never generate and use nov databases for mail spools. @@ -69,9 +64,7 @@ This variable shouldn't be flipped much. If you have, for some reason, set this to t, and want to set it to nil again, you should always run the `nnml-generate-nov-databases' command. The function will go through all nnml directories and generate nov databases for them -all. This may very well take some time. - -This variable is a virtual server slot. See the Gnus manual for details.") +all. This may very well take some time.") (defvoo nnml-marks-is-evil nil "If non-nil, Gnus will never generate and use marks file for mail spools. @@ -80,27 +73,16 @@ separately from `.newsrc.eld'. If you have, for some reason, set this to t, and want to set it to nil again, you should always remove the corresponding marks file (usually named `.marks' in the nnml group directory, but see `nnml-marks-file-name') for the group. Then the -marks file will be regenerated properly by Gnus. - -This variable is a virtual server slot. See the Gnus manual for details.") - -(defvoo nnml-filenames-are-evil t - "If non-nil, Gnus will not assume that the articles file name -is the same as the article number listed in the nov database. This -variable should be set if any of the files are compressed. - -This variable is a virtual server slot. See the Gnus manual for details.") +marks file will be regenerated properly by Gnus.") (defvoo nnml-prepare-save-mail-hook nil - "Hook run narrowed to an article before saving. - -This variable is a virtual server slot. See the Gnus manual for details.") + "Hook run narrowed to an article before saving.") (defvoo nnml-inhibit-expiry nil - "If non-nil, inhibit expiry. - -This variable is a virtual server slot. See the Gnus manual for details.") + "If non-nil, inhibit expiry.") +(defvoo nnml-use-compressed-files nil + "If non-nil, allow using compressed message files.") @@ -126,8 +108,9 @@ This variable is a virtual server slot. See the Gnus manual for details.") (defvoo nnml-marks nil) - +(defvar nnml-marks-modtime (gnus-make-hashtable)) + ;;; Interface functions. (nnoo-define-basics nnml) @@ -156,7 +139,7 @@ This variable is a virtual server slot. See the Gnus manual for details.") (setq beg (point)) (nnheader-insert-head file) (goto-char beg) - (if (search-forward "\n\n" nil t) + (if (re-search-forward "\n\r?\n" nil t) (forward-char -1) (goto-char (point-max)) (insert "\n\n")) @@ -316,7 +299,8 @@ This variable is a virtual server slot. See the Gnus manual for details.") (setq articles (gnus-sorted-intersection articles active-articles)) (while (and articles is-old) - (if (and (setq article (nnml-article-to-file (setq number (pop articles)))) + (if (and (setq article (nnml-article-to-file + (setq number (pop articles)))) (setq mod-time (nth 5 (file-attributes article))) (nnml-deletable-article-p group number) (setq is-old (nnmail-expired-article-p group mod-time force @@ -329,7 +313,9 @@ This variable is a virtual server slot. See the Gnus manual for details.") (let (nnml-current-directory nnml-current-group nnml-article-file-alist) - (nnmail-expiry-target-group nnmail-expiry-target group)))) + (nnmail-expiry-target-group nnmail-expiry-target group))) + ;; Maybe directory is changed during nnmail-expiry-target-group. + (nnml-possibly-change-directory group server)) (nnheader-message 5 "Deleting article %s in %s" number group) (condition-case () @@ -383,7 +369,10 @@ This variable is a virtual server slot. See the Gnus manual for details.") (nnmail-check-syntax) (let (result) (when nnmail-cache-accepted-message-ids - (nnmail-cache-insert (nnmail-fetch-field "message-id"))) + (nnmail-cache-insert (nnmail-fetch-field "message-id") + group + (nnmail-fetch-field "subject") + (nnmail-fetch-field "from"))) (if (stringp group) (and (nnmail-activate 'nnml) @@ -432,8 +421,7 @@ This variable is a virtual server slot. See the Gnus manual for details.") (if (or (looking-at art) (search-forward (concat "\n" art) nil t)) ;; Delete the old NOV line. - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point))) + (gnus-delete-line) ;; The line isn't here, so we have to find out where ;; we should insert it. (This situation should never ;; occur, but one likes to make sure...) @@ -529,16 +517,19 @@ This variable is a virtual server slot. See the Gnus manual for details.") (defun nnml-article-to-file (article) (nnml-update-file-alist) (let (file) - (if (setq file (cdr (assq article nnml-article-file-alist))) + (if (setq file + (if nnml-use-compressed-files + (cdr (assq article nnml-article-file-alist)) + (number-to-string article))) (expand-file-name file nnml-current-directory) - (if (not nnheader-directory-files-is-safe) - ;; Just to make sure nothing went wrong when reading over NFS -- - ;; check once more. - (when (file-exists-p - (setq file (expand-file-name (number-to-string article) - nnml-current-directory))) - (nnml-update-file-alist t) - file))))) + (when (not nnheader-directory-files-is-safe) + ;; Just to make sure nothing went wrong when reading over NFS -- + ;; check once more. + (when (file-exists-p + (setq file (expand-file-name (number-to-string article) + nnml-current-directory))) + (nnml-update-file-alist t) + file))))) (defun nnml-deletable-article-p (group article) "Say whether ARTICLE in GROUP can be deleted." @@ -581,7 +572,7 @@ This variable is a virtual server slot. See the Gnus manual for details.") (search-forward id nil t)) ; We find the ID. ;; And the id is in the fourth field. (if (not (and (search-backward "\t" nil t 4) - (not (search-backward"\t" (gnus-point-at-bol) t)))) + (not (search-backward "\t" (point-at-bol) t)))) (forward-line 1) (beginning-of-line) (setq found t) @@ -630,8 +621,12 @@ This variable is a virtual server slot. See the Gnus manual for details.") (defun nnml-save-mail (group-art) "Called narrowed to an article." - (let (chars headers) + (let (chars headers extension) (setq chars (nnmail-insert-lines)) + (setq extension + (and nnml-use-compressed-files + (> chars 1000) + ".gz")) (nnmail-insert-xref group-art) (run-hooks 'nnmail-prepare-save-mail-hook) (run-hooks 'nnml-prepare-save-mail-hook) @@ -646,7 +641,8 @@ This variable is a virtual server slot. See the Gnus manual for details.") (nnml-possibly-create-directory (caar ga)) (let ((file (concat (nnmail-group-pathname (caar ga) nnml-directory) - (int-to-string (cdar ga))))) + (int-to-string (cdar ga)) + extension))) (if first ;; It was already saved, so we just make a hard link. (funcall nnmail-crosspost-link-function first file t) @@ -703,7 +699,7 @@ This variable is a virtual server slot. See the Gnus manual for details.") (nnheader-insert-nov headers))) (defsubst nnml-header-value () - (buffer-substring (match-end 0) (progn (end-of-line) (point)))) + (buffer-substring (match-end 0) (point-at-eol))) (defun nnml-parse-head (chars &optional number) "Parse the head of the current buffer." @@ -712,14 +708,10 @@ This variable is a virtual server slot. See the Gnus manual for details.") (unless (zerop (buffer-size)) (narrow-to-region (goto-char (point-min)) - (if (search-forward "\n\n" nil t) (1- (point)) (point-max)))) - ;; Fold continuation lines. - (goto-char (point-min)) - (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) - (replace-match " " t t)) - ;; Remove any tabs; they are too confusing. - (subst-char-in-region (point-min) (point-max) ?\t ? ) - (let ((headers (nnheader-parse-head t))) + (if (re-search-forward "\n\r?\n" nil t) + (1- (point)) + (point-max)))) + (let ((headers (nnheader-parse-naked-head))) (mail-header-set-chars headers chars) (mail-header-set-number headers number) headers)))) @@ -749,8 +741,8 @@ This variable is a virtual server slot. See the Gnus manual for details.") (when (buffer-name (cdar nnml-nov-buffer-alist)) (set-buffer (cdar nnml-nov-buffer-alist)) (when (buffer-modified-p) - (nnmail-write-region 1 (point-max) nnml-nov-buffer-file-name - nil 'nomesg)) + (nnmail-write-region (point-min) (point-max) + nnml-nov-buffer-file-name nil 'nomesg)) (set-buffer-modified-p nil) (kill-buffer (current-buffer))) (setq nnml-nov-buffer-alist (cdr nnml-nov-buffer-alist))))) @@ -837,9 +829,9 @@ This variable is a virtual server slot. See the Gnus manual for details.") (narrow-to-region (goto-char (point-min)) (progn - (search-forward "\n\n" nil t) + (re-search-forward "\n\r?\n" nil t) (setq chars (- (point-max) (point))) - (max 1 (1- (point))))) + (max (point-min) (1- (point))))) (unless (zerop (buffer-size)) (goto-char (point-min)) (setq headers (nnml-parse-head chars (caar files))) @@ -851,7 +843,7 @@ This variable is a virtual server slot. See the Gnus manual for details.") (setq files (cdr files))) (save-excursion (set-buffer nov-buffer) - (nnmail-write-region 1 (point-max) nov nil 'nomesg) + (nnmail-write-region (point-min) (point-max) nov nil 'nomesg) (kill-buffer (current-buffer)))))) (defun nnml-nov-delete-article (group article) @@ -871,10 +863,11 @@ This variable is a virtual server slot. See the Gnus manual for details.") t)) (defun nnml-update-file-alist (&optional force) - (when (or (not nnml-article-file-alist) - force) - (setq nnml-article-file-alist - (nnml-current-group-article-to-file-alist)))) + (when nnml-use-compressed-files + (when (or (not nnml-article-file-alist) + force) + (setq nnml-article-file-alist + (nnml-current-group-article-to-file-alist))))) (defun nnml-directory-articles (dir) "Return a list of all article files in a directory. @@ -901,9 +894,9 @@ Use the nov database for that directory if available." (defun nnml-current-group-article-to-file-alist () "Return an alist of article/file pairs in the current group. Use the nov database for the current group if available." - (if (or gnus-nov-is-evil + (if (or nnml-use-compressed-files + gnus-nov-is-evil nnml-nov-is-evil - nnml-filenames-are-evil (not (file-exists-p (expand-file-name nnml-nov-file-name nnml-current-directory)))) @@ -911,8 +904,8 @@ Use the nov database for the current group if available." ;; build list from .overview if available (save-excursion (let ((alist nil) - art - (buffer (nnml-get-nov-buffer nnml-current-group))) + (buffer (nnml-get-nov-buffer nnml-current-group)) + art) (set-buffer buffer) (goto-char (point-min)) (while (not (eobp)) @@ -930,7 +923,7 @@ Use the nov database for the current group if available." (let ((range (nth 0 action)) (what (nth 1 action)) (marks (nth 2 action))) - (assert (or (eq what 'add) (eq what 'del)) t + (assert (or (eq what 'add) (eq what 'del)) nil "Unknown request-set-mark action: %s" what) (dolist (mark marks) (setq nnml-marks (gnus-update-alist-soft @@ -944,19 +937,20 @@ Use the nov database for the current group if available." (deffoo nnml-request-update-info (group info &optional server) (nnml-possibly-change-directory group server) - (unless nnml-marks-is-evil + (when (and (not nnml-marks-is-evil) (nnml-marks-changed-p group)) (nnheader-message 8 "Updating marks for %s..." group) (nnml-open-marks group server) ;; Update info using `nnml-marks'. - (mapcar (lambda (pred) + (mapc (lambda (pred) + (unless (memq (cdr pred) gnus-article-unpropagated-mark-lists) (gnus-info-set-marks info (gnus-update-alist-soft (cdr pred) (cdr (assq (cdr pred) nnml-marks)) (gnus-info-marks info)) - t)) - gnus-article-mark-lists) + t))) + gnus-article-mark-lists) (let ((seen (cdr (assq 'read nnml-marks)))) (gnus-info-set-read info (if (and (integerp (car seen)) @@ -966,6 +960,14 @@ Use the nov database for the current group if available." (nnheader-message 8 "Updating marks for %s...done" group)) info) +(defun nnml-marks-changed-p (group) + (let ((file (expand-file-name nnml-marks-file-name + (nnmail-group-pathname group nnml-directory)))) + (if (null (gnus-gethash file nnml-marks-modtime)) + t ;; never looked at marks file, assume it has changed + (not (equal (gnus-gethash file nnml-marks-modtime) + (nth 5 (file-attributes file))))))) + (defun nnml-save-marks (group server) (let ((file-name-coding-system nnmail-pathname-coding-system) (file (expand-file-name nnml-marks-file-name @@ -975,24 +977,31 @@ Use the nov database for the current group if available." (nnml-possibly-create-directory group) (with-temp-file file (erase-buffer) - (princ nnml-marks (current-buffer)) - (insert "\n"))) + (gnus-prin1 nnml-marks) + (insert "\n")) + (gnus-sethash file + (nth 5 (file-attributes file)) + nnml-marks-modtime)) (error (or (gnus-yes-or-no-p (format "Could not write to %s (%s). Continue? " file err)) - (error "Cannot write to %s (%s)" err)))))) + (error "Cannot write to %s (%s)" file err)))))) (defun nnml-open-marks (group server) - (let ((file (expand-file-name - nnml-marks-file-name + (let ((file (expand-file-name + nnml-marks-file-name (nnmail-group-pathname group nnml-directory)))) (if (file-exists-p file) - (setq nnml-marks (condition-case err - (with-temp-buffer - (nnheader-insert-file-contents file) - (read (current-buffer))) - (error (or (gnus-yes-or-no-p - (format "Error reading nnml marks file %s (%s). Continuing will use marks from .newsrc.eld. Continue? " file err)) - (error "Cannot read nnml marks file %s (%s)" file err))))) + (condition-case err + (with-temp-buffer + (gnus-sethash file (nth 5 (file-attributes file)) + nnml-marks-modtime) + (nnheader-insert-file-contents file) + (setq nnml-marks (read (current-buffer))) + (dolist (el gnus-article-unpropagated-mark-lists) + (setq nnml-marks (gnus-remassoc el nnml-marks)))) + (error (or (gnus-yes-or-no-p + (format "Error reading nnml marks file %s (%s). Continuing will use marks from .newsrc.eld. Continue? " file err)) + (error "Cannot read nnml marks file %s (%s)" file err)))) ;; User didn't have a .marks file. Probably first time ;; user of the .marks stuff. Bootstrap it from .newsrc.eld. (let ((info (gnus-get-info @@ -1002,8 +1011,12 @@ Use the nov database for the current group if available." (nnheader-message 7 "Bootstrapping marks for %s..." group) (setq nnml-marks (gnus-info-marks info)) (push (cons 'read (gnus-info-read info)) nnml-marks) - (nnml-save-marks group server))))) + (dolist (el gnus-article-unpropagated-mark-lists) + (setq nnml-marks (gnus-remassoc el nnml-marks))) + (nnml-save-marks group server) + (nnheader-message 7 "Bootstrapping marks for %s...done" group))))) (provide 'nnml) +;;; arch-tag: 52c97dc3-9735-45de-b439-9e4d23b52004 ;;; nnml.el ends here