xemacs-beta: lisp/gnus/nnmh.el comparison

comparison lisp/gnus/nnmh.el @ 108:360340f9fd5f r20-1b6

Import from CVS: tag r20-1b6

author	cvs
date	Mon, 13 Aug 2007 09:18:39 +0200
parents	cf808b4c4290
children	fe104dbd9147

comparison

equal deleted inserted replaced

-:523141596bda
+:360340f9fd5f
 ;;; Commentary:
 ;; Based on nnspool.el by Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>.
 ;; For an overview of what the interface functions do, please see the
 ;; Gnus sources.
 ;;; Code:
 (require 'nnheader)
 (require 'nnmail)
 (nnmh-possibly-change-directory newsgroup server)
 ;; We don't support fetching by Message-ID.
 (if (stringp (car articles))
 	  'headers
 	(while articles
 	  (when (and (file-exists-p
 		      (setq file (concat (file-name-as-directory
 					  nnmh-current-directory)
 					 (int-to-string
 					  (setq article (pop articles))))))
 		     (not (file-directory-p file)))
 	    (insert (format "221 %d Article retrieved.\n" article))
 (nnoo-change-server 'nnmh server defs)
 (when (not (file-exists-p nnmh-directory))
 (condition-case ()
 	(make-directory nnmh-directory t)
 (error t)))
 (cond
 ((not (file-exists-p nnmh-directory))
 (nnmh-close-server)
 (nnheader-report 'nnmh "Couldn't create directory: %s" nnmh-directory))
 ((not (file-directory-p (file-truename nnmh-directory)))
 (nnmh-close-server)
 	 (string-to-int (file-name-nondirectory file)))))
 (deffoo nnmh-request-group (group &optional server dont-check)
 (let ((pathname (nnmail-group-pathname group nnmh-directory))
 	dir)
 (cond
 ((not (file-directory-p pathname))
 (nnheader-report
 'nnmh "Can't select group (no such directory): %s" group))
 (t
 (setq nnmh-current-directory pathname)
 (and nnmh-get-new-mail
 	   nnmh-be-safe
 	   (nnmh-update-gnus-unreads group))
 (cond
 (dont-check
 	(nnheader-report 'nnmh "Selected group %s" group)
 	t)
 (t
 	;; Re-scan the directory if it's on a foreign system.
 	(nnheader-re-read-dir pathname)
 	(setq dir
 	      (sort
 	       (mapcar (lambda (name) (string-to-int name))
 		       (directory-files pathname nil "^[0-9]+$" t))
 	       '<))
 	  (cond
 	   (dir
 	    (nnheader-report 'nnmh "Selected group %s" group)
 	    (nnheader-insert
 	     "211 %d %d %d %s\n" (length dir) (car dir)
 	     (progn (while (cdr dir) (setq dir (cdr dir))) (car dir))
 		  (directory-files dir nil "^[0-9]+$" t))))
 (when files
 	(save-excursion
 	  (set-buffer nntp-server-buffer)
 	  (goto-char (point-max))
 	  (insert
 	   (format
 	    "%s %d %d y\n"
 	    (progn
 	      (string-match
 	       (regexp-quote
 		(file-truename (file-name-as-directory
 				(expand-file-name nnmh-toplev))))
 	       dir)
 	      (nnheader-replace-chars-in-string
 	       (substring dir (match-end 0)) ?/ ?.))
 	    (apply 'max files)
 (nnmh-request-list server))
 (deffoo nnmh-request-expire-articles (articles newsgroup
 					       &optional server force)
 (nnmh-possibly-change-directory newsgroup server)
 (let* ((active-articles
 	  (mapcar
 	   (function
 	    (lambda (name)
 	      (string-to-int name)))
 	   (directory-files nnmh-current-directory nil "^[0-9]+$" t)))
 	 (is-old t)
 	 article rest mod-time)
 (nnmail-activate 'nnmh)
 (while (and articles is-old)
 (setq article (concat nnmh-current-directory
 			    (int-to-string (car articles))))
 (when (setq mod-time (nth 5 (file-attributes article)))
 	(if (and (nnmh-deletable-article-p newsgroup (car articles))
 		 (setq is-old
 		       (nnmail-expired-article-p newsgroup mod-time force)))
 	    (progn
 	      (nnheader-message 5 "Deleting article %s in %s..."
 				article newsgroup)
 	      (condition-case ()
 		  (funcall nnmail-delete-file-function article)
 		(file-error
 		 (nnheader-message 1 "Couldn't delete article %s in %s"
 (nconc rest articles)))
 (deffoo nnmh-close-group (group &optional server)
 t)
 (deffoo nnmh-request-move-article
 (article group server accept-form &optional last)
 (let ((buf (get-buffer-create " *nnmh move*"))
 	result)
 (and
 (nnmh-deletable-article-p group article)
 (nnmh-request-article article group server)
 (save-excursion
 (set-buffer buf)
 (erase-buffer)
 result))
 (deffoo nnmh-request-accept-article (group &optional server last noinsert)
 (nnmh-possibly-change-directory group server)
 (nnmail-check-syntax)
+(nnmail-cache-insert (nnmail-fetch-field "message-id"))
 (if (stringp group)
 (and
 (nnmail-activate 'nnmh)
 (car (nnmh-save-mail
 	     (list (cons group (nnmh-active-number group)))
 	     noinsert)))
 (and
 (nnmail-activate 'nnmh)
 (car (nnmh-save-mail (nnmail-article-group 'nnmh-active-number)
-			  noinsert)))))
+			  noinsert))))
+(when last
+(nnmail-cache-close)))
 (deffoo nnmh-request-replace-article (article group buffer)
 (nnmh-possibly-change-directory group)
 (save-excursion
 (set-buffer buffer)
 (nnmh-possibly-create-directory group)
 (ignore-errors
 (nnmail-write-region
 (point-min) (point-max)
 (concat nnmh-current-directory (int-to-string article))
 nil (if (nnheader-be-verbose 5) nil 'nomesg))
 t)))
 (nnmh-possibly-create-directory group)
 (nnmh-possibly-change-directory group server)
 (let ((articles (mapcar
 		       (lambda (file)
 			 (string-to-int file))
 		       (directory-files
 			nnmh-current-directory nil "^[0-9]+$"))))
 	(when articles
 	  (setcar active (apply 'min articles))
 	  (setcdr active (apply 'max articles))))))
 t)
 (nnmh-possibly-change-directory group server)
 ;; Delete all articles in GROUP.
 (if (not force)
 ()				; Don't delete the articles.
 (let ((articles (directory-files nnmh-current-directory t "^[0-9]+$")))
 (while articles
 	(when (file-writable-p (car articles))
 	  (nnheader-message 5 "Deleting article %s in %s..."
 			    (car articles) group)
 	  (funcall nnmail-delete-file-function (car articles)))
 	(setq articles (cdr articles))))
 ;; Try to delete the directory itself.
 (ignore-errors
 (delete-directory nnmh-current-directory)))
 ;; Remove the group from all structures.
 (setq nnmh-group-alist
 	(delq (assoc group nnmh-group-alist) nnmh-group-alist)
 	nnmh-current-directory nil)
 t)
 (deffoo nnmh-request-rename-group (group new-name &optional server)
 ;; 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)))
 (when (<= (length (directory-files old-dir)) 2)
 	(ignore-errors
 ;;; Internal functions.
 (defun nnmh-possibly-change-directory (newsgroup &optional server)
 (when (and server
 	     (not (nnmh-server-opened server)))
 (nnmh-open-server server))
 (when newsgroup
 (let ((pathname (nnmail-group-pathname newsgroup nnmh-directory)))
 (if (file-directory-p pathname)
 (while dirs
 (when (make-directory (directory-file-name (car dirs)))
 	(error "Could not create directory %s" (car dirs)))
 (nnheader-message 5 "Creating mail directory %s" (car dirs))
 (setq dirs (cdr dirs)))))
 (defun nnmh-save-mail (group-art &optional noinsert)
 "Called narrowed to an article."
 (unless noinsert
 (nnmail-insert-lines)
 (nnmail-insert-xref group-art))
 ;; We save the article in all the newsgroups it belongs in.
 (let ((ga group-art)
 	first)
 (while ga
 (nnmh-possibly-create-directory (caar ga))
 (let ((file (concat (nnmail-group-pathname
 			   (caar ga) nnmh-directory)
 			  (int-to-string (cdar ga)))))
 	(if first
 	    ;; It was already saved, so we just make a hard link.
 	    (funcall nnmail-crosspost-link-function first file t)
 (defun nnmh-active-number (group)
 "Compute the next article number in GROUP."
 (let ((active (cadr (assoc group nnmh-group-alist))))
 (unless active
 ;; The group wasn't known to nnmh, so we just create an active
 ;; entry for it.
 (setq active (cons 1 0))
 (push (list group active) nnmh-group-alist)
 ;; Find the highest number in the group.
 (let ((files (sort
 		    (mapcar
 ;; Go through the .nnmh-articles file and compare with the actual
 ;; articles in this folder.  The articles that are "new" will be
 ;; marked as unread by Gnus.
 (let* ((dir nnmh-current-directory)
 	 (files (sort (mapcar (function (lambda (name) (string-to-int name)))
 			      (directory-files nnmh-current-directory
 					       nil "^[0-9]+$" t))
 		      '<))
 	 (nnmh-file (concat dir ".nnmh-articles"))
 	 new articles)
 ;; Load the .nnmh-articles file.
 (when (file-exists-p nnmh-file)
 (setq articles
 	    (let (nnmh-newsgroup-articles)
 	      (ignore-errors (load nnmh-file nil t t))
 	      nnmh-newsgroup-articles)))
 ;; Add all new articles to the `new' list.
 (let ((art files))
 ;; they are by looking at the time-stamps.
 (let ((arts articles)
 	  art)
 (while (setq art (pop arts))
 	(when (not (equal
 		    (nth 5 (file-attributes
 			    (concat dir (int-to-string (car art)))))
 		    (cdr art)))
 	  (setq articles (delq art articles))
 	  (push (car art) new))))
 ;; Go through all the new articles and add them, and their
 			  (nth 5 (file-attributes
 				  (concat dir (int-to-string art))))))
 		  new)))
 ;; Make Gnus mark all new articles as unread.
 (when new
 (gnus-make-articles-unread
 (gnus-group-prefixed-name group (list 'nnmh ""))
 (setq new (sort new '<))))
 ;; Sort the article list with highest numbers first.
 (setq articles (sort articles (lambda (art1 art2)
 				    (> (car art1) (car art2)))))
 (defun nnmh-deletable-article-p (group article)
 "Say whether ARTICLE in GROUP can be deleted."
 (let ((path (concat nnmh-current-directory (int-to-string article))))
 ;; Writable.
 (and (file-writable-p path)
 	 ;; We can never delete the last article in the group.
 	 (not (eq (cdr (nth 1 (assoc group nnmh-group-alist)))
 		  article)))))
 (provide 'nnmh)

Mercurial > hg > xemacs-beta

comparison lisp/gnus/nnmh.el @ 108:360340f9fd5f r20-1b6