emacs: lisp/gnus/nnml.el comparison

comparison lisp/gnus/nnml.el @ 31716:9968f55ad26e

Update to emacs-21-branch of the Gnus CVS repository.

author	Gerd Moellmann <gerd@gnu.org>
date	Tue, 19 Sep 2000 13:37:09 +0000
parents	15fc6acbae7a
children	c47be4412cfd

comparison

equal deleted inserted replaced

-:7c896543d225
+:9968f55ad26e
 ;;; nnml.el --- mail spool access for Gnus
-;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000
+;;        Free Software Foundation, Inc.
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; 	Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
 ;; Keywords: news, mail
 (defvoo nnml-directory message-directory
 "Spool directory for the nnml mail backend.")
 (defvoo nnml-active-file
-(concat (file-name-as-directory nnml-directory) "active")
+(expand-file-name "active" nnml-directory)
 "Mail active file.")
 (defvoo nnml-newsgroups-file
-(concat (file-name-as-directory nnml-directory) "newsgroups")
+(expand-file-name "newsgroups" nnml-directory)
 "Mail newsgroups description file.")
 (defvoo nnml-get-new-mail t
 "If non-nil, nnml will check the incoming mail file and split the mail.")
 (defvoo nnml-generate-active-function 'nnml-generate-active-info)
 (defvar nnml-nov-buffer-file-name nil)
+(defvoo nnml-file-coding-system nnmail-file-coding-system)
 ;;; Interface functions.
 (nnoo-define-basics nnml)
 (set-buffer nntp-server-buffer)
 (erase-buffer)
 (let ((file nil)
 	    (number (length sequence))
 	    (count 0)
-	    (file-name-coding-system 'binary)
+	    (file-name-coding-system nnmail-pathname-coding-system)
-	    (pathname-coding-system 'binary)
 	    beg article)
 	(if (stringp (car sequence))
 	    'headers
 	  (if (nnml-retrieve-headers-with-nov sequence fetch-old)
 	      'nov
 	    'headers))))))
 (deffoo nnml-open-server (server &optional defs)
 (nnoo-change-server 'nnml server defs)
 (when (not (file-exists-p nnml-directory))
-(condition-case ()
+(ignore-errors (make-directory nnml-directory t)))
-	(make-directory nnml-directory t)
-(error)))
 (cond
 ((not (file-exists-p nnml-directory))
 (nnml-close-server)
 (nnheader-report 'nnml "Couldn't create directory: %s" nnml-directory))
 ((not (file-directory-p (file-truename nnml-directory)))
 t)
 (deffoo nnml-request-article (id &optional group server buffer)
 (nnml-possibly-change-directory group server)
 (let* ((nntp-server-buffer (or buffer nntp-server-buffer))
-	 (file-name-coding-system 'binary)
+	 (file-name-coding-system nnmail-pathname-coding-system)
-	 (pathname-coding-system 'binary)
 	 path gpath group-num)
 (if (stringp id)
 	(when (and (setq group-num (nnml-find-group-number id))
 		   (cdr
 		    (assq (cdr group-num)
 (nnheader-report 'nnml "No such article: %s" id))
 ((not (file-exists-p path))
 (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)
 ;; We return the article number.
 (cons (if group-num (car group-num) group)
 	    (string-to-int (file-name-nondirectory path)))))))
 (deffoo nnml-request-group (group &optional server dont-check)
-(let ((pathname-coding-system 'binary)
+(let ((file-name-coding-system nnmail-pathname-coding-system))
-	(file-name-coding-system 'binary))
 (cond
 ((not (nnml-possibly-change-directory group server))
 (nnheader-report 'nnml "Invalid group (no such directory)"))
 ((not (file-exists-p nnml-current-directory))
 (nnheader-report 'nnml "Directory %s does not exist"
 (deffoo nnml-close-group (group &optional server)
 (setq nnml-article-file-alist nil)
 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)
 t)
 ((and (file-exists-p (nnmail-group-pathname group nnml-directory))
 t))))
 (deffoo nnml-request-list (&optional server)
 (save-excursion
 (let ((nnmail-file-coding-system nnmail-active-file-coding-system)
-	  (file-name-coding-system 'binary)
+	  (file-name-coding-system nnmail-pathname-coding-system))
-	  (pathname-coding-system 'binary))
+(nnmail-find-file nnml-active-file))
-(nnmail-find-file nnml-active-file)
-)
 (setq nnml-group-alist (nnmail-get-active))
 t))
 (deffoo nnml-request-newgroups (date &optional server)
 (nnml-request-list server))
 (deffoo nnml-request-list-newsgroups (&optional server)
 (save-excursion
 (nnmail-find-file nnml-newsgroups-file)))
-(deffoo nnml-request-expire-articles (articles group
+(deffoo nnml-request-expire-articles (articles group &optional server force)
-					       &optional server force)
 (nnml-possibly-change-directory group server)
 (let ((active-articles
 	 (nnheader-directory-articles nnml-current-directory))
 	(is-old t)
 	article rest mod-time number)
 	  (if (and (nnml-deletable-article-p group number)
 		   (setq is-old
 			 (nnmail-expired-article-p group mod-time force
 						   nnml-inhibit-expiry)))
 	      (progn
+		;; Allow a special target group.
+		(unless (eq nnmail-expiry-target 'delete)
+		  (with-temp-buffer
+		    (nnml-request-article number group server
+					  (current-buffer))
+		    (let ((nnml-current-directory nil))
+		      (nnmail-expiry-target-group
+		       nnmail-expiry-target group))))
 		(nnheader-message 5 "Deleting article %s in %s"
-				  article group)
+				  number group)
 		(condition-case ()
 		    (funcall nnmail-delete-file-function article)
 		  (file-error
 		   (push number rest)))
 		(setq active-articles (delq number active-articles))
 (nnmail-save-active nnml-group-alist nnml-active-file))
 (nnml-save-nov)
 (nconc rest articles)))
 (deffoo nnml-request-move-article
 (article group server accept-form &optional last)
 (let ((buf (get-buffer-create " *nnml move*"))
 	result)
 (nnml-possibly-change-directory group server)
 (nnml-update-file-alist)
 (and
 (nnml-deletable-article-p group article)
 (nnml-request-article article group server)
-(save-excursion
+(let (nnml-current-directory
-(set-buffer buf)
+	   nnml-current-group
-(insert-buffer-substring nntp-server-buffer)
+	   nnml-article-file-alist)
-(setq result (eval accept-form))
+(save-excursion
-(kill-buffer (current-buffer))
+	 (set-buffer buf)
-result)
+	 (insert-buffer-substring nntp-server-buffer)
+	 (setq result (eval accept-form))
+	 (kill-buffer (current-buffer))
+	 result))
 (progn
 (nnml-possibly-change-directory group server)
 (condition-case ()
 	   (funcall nnmail-delete-file-function
 		    (nnml-article-to-file  article))
 (set-buffer buffer)
 (nnml-possibly-create-directory group)
 (let ((chars (nnmail-insert-lines))
 	  (art (concat (int-to-string article) "\t"))
 	  headers)
-(when (condition-case ()
+(when (ignore-errors
-		(progn
+	      (nnmail-write-region
-		  (nnmail-write-region
+	       (point-min) (point-max)
-		   (point-min) (point-max)
+	       (or (nnml-article-to-file article)
-		   (or (nnml-article-to-file article)
+		   (expand-file-name (int-to-string article)
-		       (concat nnml-current-directory
+				     nnml-current-directory))
-			       (int-to-string article)))
+	       nil (if (nnheader-be-verbose 5) nil 'nomesg))
-		   nil (if (nnheader-be-verbose 5) nil 'nomesg))
+	      t)
-		  t)
-	      (error nil))
 	(setq headers (nnml-parse-head chars article))
 	;; Replace the NOV line in the NOV file.
 	(save-excursion
 	  (set-buffer (nnml-open-nov group))
 	  (goto-char (point-min))
 	(setq article (pop articles))
 	(when (file-writable-p article)
 	  (nnheader-message 5 "Deleting article %s in %s..." article group)
 	  (funcall nnmail-delete-file-function article))))
 ;; Try to delete the directory itself.
-(condition-case ()
+(ignore-errors (delete-directory nnml-current-directory)))
-	(delete-directory nnml-current-directory)
-(error nil)))
 ;; Remove the group from all structures.
 (setq nnml-group-alist
 	(delq (assoc group nnml-group-alist) nnml-group-alist)
 	nnml-current-group nil
 	nnml-current-directory nil)
 (deffoo nnml-request-rename-group (group new-name &optional server)
 (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 ()
+(when (ignore-errors
-	      (progn
+	    (make-directory new-dir t)
-		(make-directory new-dir t)
+	    t)
-		t)
-	    (error nil))
 ;; 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
 ;; Move .overview file.
 (let ((overview (concat old-dir nnml-nov-file-name)))
 	(when (file-exists-p overview)
 	  (rename-file overview (concat new-dir nnml-nov-file-name))))
 (when (<= (length (directory-files old-dir)) 2)
-	(condition-case ()
+	(ignore-errors (delete-directory old-dir)))
-	    (delete-directory old-dir)
-	  (error nil)))
 ;; That went ok, so we change the internal structures.
 (let ((entry (assoc group nnml-group-alist)))
 	(when entry
 	  (setcar entry new-name))
 	(setq nnml-current-directory nil
 (let ((file (nnml-article-to-file article)))
 (cond
 ((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-article-to-file (article)
 (nnml-update-file-alist)
 (let (file)
 (if (setq file (cdr (assq article nnml-article-file-alist)))
-	(concat nnml-current-directory file)
+	(expand-file-name file nnml-current-directory)
 ;; 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)))
 ;; Find an article number in the current group given the Message-ID.
 (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
 ;; start with the one in the current directory.  It seems most
 ;; likely that the article we are looking for is in that group.
 	(and number
 	     (cons (caar alist) number))))))
 (defun nnml-find-id (group id)
 (erase-buffer)
-(let ((nov (concat (nnmail-group-pathname group nnml-directory)
+(let ((nov (expand-file-name nnml-nov-file-name
-		     nnml-nov-file-name))
+			       (nnmail-group-pathname group nnml-directory)))
 	number found)
 (when (file-exists-p nov)
 (nnheader-insert-file-contents nov)
 (while (and (not found)
 		  (search-forward id nil t)) ; We find the ID.
 	    (forward-line 1)
 	  (beginning-of-line)
 	  (setq found t)
 	  ;; We return the article number.
 	  (setq number
-		(condition-case ()
+		(ignore-errors (read (current-buffer))))))
-		    (read (current-buffer))
-		  (error nil)))))
 number)))
 (defun nnml-retrieve-headers-with-nov (articles &optional fetch-old)
 (if (or gnus-nov-is-evil nnml-nov-is-evil)
 nil
-(let ((nov (concat nnml-current-directory nnml-nov-file-name)))
+(let ((nov (expand-file-name nnml-nov-file-name nnml-current-directory)))
 (when (file-exists-p nov)
 	(save-excursion
 	  (set-buffer nntp-server-buffer)
 	  (erase-buffer)
 	  (nnheader-insert-file-contents nov)
 	     (not (nnml-server-opened server)))
 (nnml-open-server server))
 (if (not group)
 t
 (let ((pathname (nnmail-group-pathname group nnml-directory))
-	  (file-name-coding-system 'binary)
+	  (file-name-coding-system nnmail-pathname-coding-system))
-	  (pathname-coding-system 'binary))
 (when (not (equal pathname nnml-current-directory))
 	(setq nnml-current-directory pathname
 	      nnml-current-group group
 	      nnml-article-file-alist nil))
 (file-exists-p nnml-current-directory))))
 (defun nnml-possibly-create-directory (group)
-(let (dir dirs)
+(let ((dir (nnmail-group-pathname group nnml-directory)))
-(setq dir (nnmail-group-pathname group nnml-directory))
+(unless (file-exists-p dir)
-(while (not (file-directory-p dir))
+(make-directory (directory-file-name dir) t)
-(push dir dirs)
+(nnheader-message 5 "Creating mail directory %s" dir))))
-(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)))))
 (defun nnml-save-mail (group-art)
 "Called narrowed to an article."
 (let (chars headers)
 (setq chars (nnmail-insert-lines))
 		      (caar (last nnml-article-file-alist)))
 	      (cons 1 0)))
 (push (list group active) nnml-group-alist))
 (setcdr active (1+ (cdr active)))
 (while (file-exists-p
-	    (concat (nnmail-group-pathname group nnml-directory)
+	    (expand-file-name (int-to-string (cdr active))
-		    (int-to-string (cdr active))))
+			      (nnmail-group-pathname group nnml-directory)))
 (setcdr active (1+ (cdr active))))
 (cdr active)))
 (defun nnml-add-nov (group article headers)
 "Add a nov line for the GROUP base."
 (or (cdr (assoc group nnml-nov-buffer-alist))
 (let ((buffer (get-buffer-create (format " *nnml overview %s*" group))))
 	(save-excursion
 	  (set-buffer buffer)
 	  (set (make-local-variable 'nnml-nov-buffer-file-name)
-	       (concat (nnmail-group-pathname group nnml-directory)
+	       (expand-file-name
-		       nnml-nov-file-name))
+		nnml-nov-file-name
+		(nnmail-group-pathname group nnml-directory)))
 	  (erase-buffer)
 	  (when (file-exists-p nnml-nov-buffer-file-name)
 	    (nnheader-insert-file-contents nnml-nov-buffer-file-name)))
 	(push (cons group buffer) nnml-nov-buffer-alist)
 	buffer)))
 (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 (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.
 (let ((files (sort (nnheader-article-to-file-alist dir)
 		       'car-less-than-car)))
 	 (nov-buffer (get-buffer-create " *nov*"))
 	 chars file headers)
 (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.
 (when (file-exists-p nov)
 	(funcall nnmail-delete-file-function nov))

Mercurial > emacs

comparison lisp/gnus/nnml.el @ 31716:9968f55ad26e