;;; nnml.el --- mail spool access for Gnus
-;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc.
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Keywords: news, mail
(defvar nnml-nov-buffer-file-name nil)
+(defvoo nnml-file-coding-system nnmail-file-coding-system)
+
\f
;;; Interface functions.
(deffoo nnml-open-server (server &optional defs)
(nnoo-change-server 'nnml server defs)
(when (not (file-exists-p nnml-directory))
- (condition-case ()
- (make-directory nnml-directory t)
- (error)))
+ (ignore-errors (make-directory nnml-directory t)))
(cond
((not (file-exists-p nnml-directory))
(nnml-close-server)
(nnheader-report 'nnml "No such file: %s" path))
((file-directory-p path)
(nnheader-report 'nnml "File is a directory: %s" path))
- ((not (save-excursion (nnmail-find-file path)))
+ ((not (save-excursion (let ((nnmail-file-coding-system
+ nnml-file-coding-system))
+ (nnmail-find-file path))))
(nnheader-report 'nnml "Couldn't read file: %s" path))
(t
(nnheader-report 'nnml "Article %s retrieved" id)
t)
(deffoo nnml-request-create-group (group &optional server args)
+ (nnml-possibly-change-directory nil server)
(nnmail-activate 'nnml)
(cond
((assoc group nnml-group-alist)
(deffoo nnml-request-list (&optional server)
(save-excursion
(let ((nnmail-file-coding-system nnmail-active-file-coding-system)
- (pathname-coding-system 'binary)) ; for XEmacs/mule
- (nnmail-find-file nnml-active-file)
- )
+ (pathname-coding-system 'binary))
+ (nnmail-find-file nnml-active-file))
(setq nnml-group-alist (nnmail-get-active))
t))
(save-excursion
(nnmail-find-file nnml-newsgroups-file)))
-(deffoo nnml-request-expire-articles (articles group
- &optional server force)
+(deffoo nnml-request-expire-articles (articles group &optional server force)
(nnml-possibly-change-directory group server)
(let ((active-articles
(nnheader-directory-articles nnml-current-directory))
article rest mod-time number)
(nnmail-activate 'nnml)
+ (setq active-articles (sort active-articles '<))
+ ;; Articles not listed in active-articles are already gone,
+ ;; so don't try to expire them.
+ (setq articles (gnus-sorted-intersection articles active-articles))
+
(while (and articles is-old)
(when (setq article (nnml-article-to-file (setq number (pop articles))))
(when (setq mod-time (nth 5 (file-attributes article)))
(let ((chars (nnmail-insert-lines))
(art (concat (int-to-string article) "\t"))
headers)
- (when (condition-case ()
- (progn
- (nnmail-write-region
- (point-min) (point-max)
- (or (nnml-article-to-file article)
- (concat nnml-current-directory
- (int-to-string article)))
- nil (if (nnheader-be-verbose 5) nil 'nomesg))
- t)
- (error nil))
+ (when (ignore-errors
+ (nnmail-write-region
+ (point-min) (point-max)
+ (or (nnml-article-to-file article)
+ (concat nnml-current-directory
+ (int-to-string article)))
+ nil (if (nnheader-be-verbose 5) nil 'nomesg))
+ t)
(setq headers (nnml-parse-head chars article))
;; Replace the NOV line in the NOV file.
(save-excursion
(nnheader-message 5 "Deleting article %s in %s..." article group)
(funcall nnmail-delete-file-function article))))
;; Try to delete the directory itself.
- (condition-case ()
- (delete-directory nnml-current-directory)
- (error nil)))
+ (ignore-errors (delete-directory nnml-current-directory)))
;; Remove the group from all structures.
(setq nnml-group-alist
(delq (assoc group nnml-group-alist) nnml-group-alist)
(nnml-possibly-change-directory group server)
(let ((new-dir (nnmail-group-pathname new-name nnml-directory))
(old-dir (nnmail-group-pathname group nnml-directory)))
- (when (condition-case ()
- (progn
- (make-directory new-dir t)
- t)
- (error nil))
+ (when (ignore-errors
+ (make-directory new-dir t)
+ t)
;; 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.
(when (file-exists-p overview)
(rename-file overview (concat new-dir nnml-nov-file-name))))
(when (<= (length (directory-files old-dir)) 2)
- (condition-case ()
- (delete-directory old-dir)
- (error nil)))
+ (ignore-errors (delete-directory old-dir)))
;; That went ok, so we change the internal structures.
(let ((entry (assoc group nnml-group-alist)))
(when entry
((not (file-exists-p file))
(nnheader-report 'nnml "File %s does not exist" file))
(t
- (nnheader-temp-write file
+ (with-temp-file file
(nnheader-insert-file-contents file)
(nnmail-replace-status name value))
t))))
(defun nnml-find-group-number (id)
(save-excursion
(set-buffer (get-buffer-create " *nnml id*"))
- (buffer-disable-undo (current-buffer))
(let ((alist nnml-group-alist)
number)
;; We want to look through all .overview files, but we want to
(setq found t)
;; We return the article number.
(setq number
- (condition-case ()
- (read (current-buffer))
- (error nil)))))
+ (ignore-errors (read (current-buffer))))))
number)))
(defun nnml-retrieve-headers-with-nov (articles &optional fetch-old)
(file-exists-p nnml-current-directory))))
(defun nnml-possibly-create-directory (group)
- (let (dir dirs)
- (setq dir (nnmail-group-pathname group nnml-directory))
- (while (not (file-directory-p dir))
- (push dir dirs)
- (setq dir (file-name-directory (directory-file-name dir))))
- (while dirs
- (make-directory (directory-file-name (car dirs)))
- (nnheader-message 5 "Creating mail directory %s" (car dirs))
- (setq dirs (cdr dirs)))))
+ (let ((dir (nnmail-group-pathname group nnml-directory)))
+ (unless (file-exists-p dir)
+ (make-directory (directory-file-name dir) t)
+ (nnheader-message 5 "Creating mail directory %s" dir))))
(defun nnml-save-mail (group-art)
"Called narrowed to an article."
(let ((dirs (directory-files dir t nil t))
dir)
(while (setq dir (pop dirs))
- (when (and (not (member (file-name-nondirectory dir) '("." "..")))
+ (when (and (not (string-match "^\\." (file-name-nondirectory dir)))
(file-directory-p dir))
(nnml-generate-nov-databases-1 dir seen))))
;; Do this directory.
(save-excursion
;; Init the nov buffer.
(set-buffer nov-buffer)
- (buffer-disable-undo (current-buffer))
+ (buffer-disable-undo)
(erase-buffer)
(set-buffer nntp-server-buffer)
;; Delete the old NOV file.
projects / elisp / gnus.git- / blobdiff