;;; nnml.el --- mail spool access for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001
-;; Free Software Foundation, Inc.
+
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
+;; 2004, 2005 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org> (adding MARKS)
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
;; 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,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
(defvoo nnml-use-compressed-files nil
"If non-nil, allow using compressed message files.")
+(defvoo nnml-compressed-files-size-threshold 1000
+ "Default size threshold for compressed message files.
+Message files with bodies larger than that many characters will
+be automatically compressed if `nnml-use-compressed-files' is
+non-nil.")
+
\f
(defconst nnml-version "nnml 1.0"
(nnheader-report 'nnml "Article %s retrieved" id)
;; We return the article number.
(cons (if group-num (car group-num) group)
- (string-to-int (file-name-nondirectory path)))))))
+ (string-to-number (file-name-nondirectory path)))))))
(deffoo nnml-request-group (group &optional server dont-check)
(let ((file-name-coding-system nnmail-pathname-coding-system))
(nconc rest articles)))
(deffoo nnml-request-move-article
- (article group server accept-form &optional last)
+ (article group server accept-form &optional last move-is-internal)
(let ((buf (get-buffer-create " *nnml move*"))
result)
(nnml-possibly-change-directory group server)
(nnmail-check-syntax)
(let (result)
(when nnmail-cache-accepted-message-ids
- (nnmail-cache-insert (nnmail-fetch-field "message-id") group))
+ (nnmail-cache-insert (nnmail-fetch-field "message-id")
+ group
+ (nnmail-fetch-field "subject")
+ (nnmail-fetch-field "from")))
(if (stringp group)
(and
(nnmail-activate 'nnml)
(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...)
(while (and (looking-at "[0-9]+\t")
- (< (string-to-int
+ (< (string-to-number
(buffer-substring
(match-beginning 0) (match-end 0)))
article)
nnml-current-directory t
(concat nnheader-numerical-short-files
"\\|" (regexp-quote nnml-nov-file-name) "$"
- "\\|" (regexp-quote nnml-marks-file-name) "$")))
- article)
- (while articles
- (setq article (pop articles))
+ "\\|" (regexp-quote nnml-marks-file-name) "$"))))
+ (dolist (article articles)
(when (file-writable-p article)
(nnheader-message 5 "Deleting article %s in %s..." article group)
(funcall nnmail-delete-file-function article))))
;; We move the articles file by file instead of renaming
;; the directory -- there may be subgroups in this group.
;; One might be more clever, I guess.
- (let ((files (nnheader-article-to-file-alist old-dir)))
- (while files
- (rename-file
- (concat old-dir (cdar files))
- (concat new-dir (cdar files)))
- (pop files)))
+ (dolist (file (nnheader-article-to-file-alist old-dir))
+ (rename-file
+ (concat old-dir (cdr file))
+ (concat new-dir (cdr file))))
;; Move .overview file.
(let ((overview (concat old-dir nnml-nov-file-name)))
(when (file-exists-p overview)
(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)
(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 nnml-compressed-files-size-threshold)
+ ".gz"))
(nnmail-insert-xref group-art)
(run-hooks 'nnmail-prepare-save-mail-hook)
(run-hooks 'nnml-prepare-save-mail-hook)
(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)
(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."
(unless (member (file-truename dir) seen)
(push (file-truename dir) seen)
;; We descend recursively
- (let ((dirs (directory-files dir t nil t))
- dir)
- (while (setq dir (pop dirs))
- (when (and (not (string-match "^\\." (file-name-nondirectory dir)))
- (file-directory-p dir))
- (nnml-generate-nov-databases-1 dir seen))))
+ (dolist (dir (directory-files dir t nil t))
+ (when (and (not (string-match "^\\." (file-name-nondirectory dir)))
+ (file-directory-p dir))
+ (nnml-generate-nov-databases-1 dir seen)))
;; Do this directory.
(let ((files (sort (nnheader-article-to-file-alist dir)
'car-less-than-car)))
(push (list group
(cons (or (caar files) (1+ last))
(max last
- (or (let ((f files))
- (while (cdr f) (setq f (cdr f)))
- (caar f))
+ (or (caar (last files))
0))))
nnml-group-alist)))
(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
(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
(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))
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
(provide 'nnml)
+;;; arch-tag: 52c97dc3-9735-45de-b439-9e4d23b52004
;;; nnml.el ends here
projects / gnus / blobdiff