X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnnml.el;h=3662db9719bf75311b9142959a219a08918cfd9c;hb=125d88b46ad2efa065f06d5dac37a245b488985a;hp=b19bbf574aeec05146b7df94c78a061fd30198c5;hpb=ee4a7be24fb6982b5baa5eafb65178ccaca6df50;p=gnus diff --git a/lisp/nnml.el b/lisp/nnml.el index b19bbf574..3662db971 100644 --- a/lisp/nnml.el +++ b/lisp/nnml.el @@ -1,5 +1,5 @@ ;;; 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) @@ -369,7 +369,10 @@ marks file will be regenerated properly by Gnus.") (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) @@ -418,8 +421,7 @@ marks file will be regenerated properly by Gnus.") (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...) @@ -570,7 +572,7 @@ marks file will be regenerated properly by Gnus.") (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) @@ -619,8 +621,12 @@ marks file will be regenerated properly by Gnus.") (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) @@ -635,7 +641,8 @@ marks file will be regenerated properly by Gnus.") (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) @@ -692,7 +699,7 @@ marks file will be regenerated properly by Gnus.") (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." @@ -701,16 +708,10 @@ marks file will be regenerated properly by Gnus.") (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)))) @@ -740,8 +741,8 @@ marks file will be regenerated properly by Gnus.") (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))))) @@ -830,7 +831,7 @@ marks file will be regenerated properly by Gnus.") (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))) @@ -842,7 +843,7 @@ marks file will be regenerated properly by Gnus.") (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) @@ -893,7 +894,8 @@ 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 (not (file-exists-p (expand-file-name nnml-nov-file-name @@ -921,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 @@ -939,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)) @@ -982,7 +984,7 @@ 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 @@ -1016,4 +1018,5 @@ Use the nov database for the current group if available." (provide 'nnml) +;;; arch-tag: 52c97dc3-9735-45de-b439-9e4d23b52004 ;;; nnml.el ends here