X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnnml.el;h=3662db9719bf75311b9142959a219a08918cfd9c;hb=125d88b46ad2efa065f06d5dac37a245b488985a;hp=6ebfb6a1b4bbbd2936bb99d2fb57ece540a0ff8f;hpb=edf56bf98f0cb9c3998f067a53c4f0b72399f3d8;p=gnus diff --git a/lisp/nnml.el b/lisp/nnml.el index 6ebfb6a1b..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. @@ -75,17 +75,14 @@ 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.") -(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.") - (defvoo nnml-prepare-save-mail-hook nil "Hook run narrowed to an article before saving.") (defvoo nnml-inhibit-expiry nil "If non-nil, inhibit expiry.") +(defvoo nnml-use-compressed-files nil + "If non-nil, allow using compressed message files.") @@ -302,7 +299,8 @@ variable should be set if any of the files are compressed.") (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 @@ -371,7 +369,10 @@ variable should be set if any of the files are compressed.") (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) @@ -420,8 +421,7 @@ variable should be set if any of the files are compressed.") (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...) @@ -517,16 +517,19 @@ variable should be set if any of the files are compressed.") (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." @@ -569,7 +572,7 @@ variable should be set if any of the files are compressed.") (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) @@ -618,8 +621,12 @@ variable should be set if any of the files are compressed.") (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) @@ -634,7 +641,8 @@ variable should be set if any of the files are compressed.") (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) @@ -691,7 +699,7 @@ variable should be set if any of the files are compressed.") (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." @@ -700,16 +708,10 @@ variable should be set if any of the files are compressed.") (unless (zerop (buffer-size)) (narrow-to-region (goto-char (point-min)) - (if (re-search-forward "\n\r?\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 ? ) - ;; Remove any ^M's; they are too confusing. - (subst-char-in-region (point-min) (point-max) ?\r ? ) - (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)))) @@ -739,8 +741,8 @@ variable should be set if any of the files are compressed.") (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))))) @@ -829,7 +831,7 @@ variable should be set if any of the files are compressed.") (progn (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))) @@ -841,7 +843,7 @@ variable should be set if any of the files are compressed.") (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) @@ -861,10 +863,11 @@ variable should be set if any of the files are compressed.") 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. @@ -891,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)))) @@ -901,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)) @@ -920,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 @@ -938,16 +941,16 @@ Use the nov database for the current group if available." (nnheader-message 8 "Updating marks for %s..." group) (nnml-open-marks group server) ;; Update info using `nnml-marks'. - (mapcar (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) + (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) (let ((seen (cdr (assq 'read nnml-marks)))) (gnus-info-set-read info (if (and (integerp (car seen)) @@ -981,11 +984,11 @@ Use the nov database for the current group if available." 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) (condition-case err @@ -1010,8 +1013,10 @@ Use the nov database for the current group if available." (push (cons 'read (gnus-info-read info)) nnml-marks) (dolist (el gnus-article-unpropagated-mark-lists) (setq nnml-marks (gnus-remassoc el nnml-marks))) - (nnml-save-marks group server))))) + (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