;;; Interface functions.
-(defun nnmh-retrieve-headers (sequence &optional newsgroup server)
+(defun nnmh-retrieve-headers (sequence &optional newsgroup server fetch-old)
(save-excursion
(set-buffer nntp-server-buffer)
(erase-buffer)
(setq nnmh-current-server server)))
(defun nnmh-close-server (&optional server)
+ (setq nnmh-current-server nil)
t)
(defun nnmh-server-opened (&optional server)
(string-to-int (file-name-nondirectory file)))))
(defun nnmh-request-group (group &optional server dont-check)
- (let ((pathname (nnmh-article-pathname group nnmh-directory))
+ (let ((pathname (nnmail-group-pathname group nnmh-directory))
dir)
(if (file-directory-p pathname)
(progn
(save-excursion
(set-buffer nntp-server-buffer)
(erase-buffer)
- (setq dir (file-name-as-directory nnmh-directory))))
+ (setq dir (file-truename (file-name-as-directory nnmh-directory)))))
(setq dir (expand-file-name dir))
;; Recurse down all directories.
(let ((dirs (and (file-readable-p dir)
(format
"%s %d %d y\n"
(progn
- (string-match (file-name-as-directory
- (expand-file-name nnmh-directory)) dir)
+ (string-match
+ (file-truename (file-name-as-directory
+ (expand-file-name nnmh-directory))) dir)
(nnmail-replace-chars-in-string
(substring dir (match-end 0)) ?/ ?.))
(apply (function max) files)
(defun nnmh-request-post (&optional server)
(mail-send-and-exit nil))
-(defalias 'nnmh-request-post-buffer 'nnmail-request-post-buffer)
-
(defun nnmh-request-expire-articles (articles newsgroup &optional server force)
(nnmh-possibly-change-directory newsgroup)
- (let* ((days (or (and nnmail-expiry-wait-function
- (funcall nnmail-expiry-wait-function newsgroup))
- nnmail-expiry-wait))
- (active-articles
+ (let* ((active-articles
(mapcar
(function
(lambda (name)
(setq article (concat nnmh-current-directory
(int-to-string (car articles))))
(if (setq mod-time (nth 5 (file-attributes article)))
- (if (and (or (not nnmail-keep-last-article)
- (not max-article)
- (not (= (car articles) max-article)))
- (not (equal mod-time '(0 0)))
- (or force
- (setq is-old
- (> (nnmail-days-between
- (current-time-string)
- (current-time-string mod-time))
- days))))
+ (if (and (nnmh-deletable-article-p newsgroup (car articles))
+ (setq is-old
+ (nnmail-expired-article-p newsgroup mod-time force)))
(progn
(and gnus-verbose-backends
- (message "Deleting article %d..."
+ (message "Deleting article %s in %s..."
article newsgroup))
(condition-case ()
- (delete-file article)
+ (funcall nnmail-delete-file-function article)
(file-error
(setq rest (cons (car articles) rest)))))
(setq rest (cons (car articles) rest))))
(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)
(kill-buffer (current-buffer))
result)
(condition-case ()
- (delete-file (concat nnmh-current-directory
- (int-to-string article)))
+ (funcall nnmail-delete-file-function
+ (concat nnmh-current-directory (int-to-string article)))
(file-error nil)))
result))
(setcdr active (apply 'max articles)))))))
t)
+(defun nnmh-request-delete-group (group &optional force server)
+ (nnmh-possibly-change-directory group)
+ ;; 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
+ (and (file-writable-p (car articles))
+ (progn
+ (and gnus-verbose-backends
+ (message (message "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.
+ (condition-case ()
+ (delete-directory nnmh-current-directory)
+ (error nil)))
+ ;; Remove the group from all structures.
+ (setq nnmh-group-alist
+ (delq (assoc group nnmh-group-alist) nnmh-group-alist)
+ nnmh-current-directory nil)
+ t)
+
+(defun nnmh-request-rename-group (group new-name &optional server)
+ (nnmh-possibly-change-directory group)
+ ;; Rename directory.
+ (and (file-writable-p nnmh-current-directory)
+ (condition-case ()
+ (progn
+ (rename-file
+ (directory-file-name nnmh-current-directory)
+ (directory-file-name
+ (nnmail-group-pathname new-name nnmh-directory)))
+ t)
+ (error nil))
+ ;; That went ok, so we change the internal structures.
+ (let ((entry (assoc group nnmh-group-alist)))
+ (and entry (setcar entry new-name))
+ (setq nnmh-current-directory nil)
+ t)))
+
\f
;;; Internal functions.
(defun nnmh-possibly-change-directory (newsgroup)
(if newsgroup
- (let ((pathname (nnmh-article-pathname newsgroup nnmh-directory)))
+ (let ((pathname (nnmail-group-pathname newsgroup nnmh-directory)))
(if (file-directory-p pathname)
(setq nnmh-current-directory pathname)
(error "No such newsgroup: %s" newsgroup)))))
(defun nnmh-possibly-create-directory (group)
(let (dir dirs)
- (setq dir (nnmh-article-pathname group nnmh-directory))
+ (setq dir (nnmail-group-pathname group nnmh-directory))
(while (not (file-directory-p dir))
(setq dirs (cons dir dirs))
(setq dir (file-name-directory (directory-file-name dir))))
first)
(while ga
(nnmh-possibly-create-directory (car (car ga)))
- (let ((file (concat (nnmh-article-pathname
+ (let ((file (concat (nnmail-group-pathname
(car (car ga)) nnmh-directory)
(int-to-string (cdr (car ga))))))
(if first
(setq nnmh-group-alist (cons (list group active) nnmh-group-alist))))
(setcdr active (1+ (cdr active)))
(while (file-exists-p
- (concat (nnmh-article-pathname group nnmh-directory)
+ (concat (nnmail-group-pathname group nnmh-directory)
(int-to-string (cdr active))))
(setcdr active (1+ (cdr active))))
(cdr active)))
-(defun nnmh-article-pathname (group mail-dir)
- "Make pathname for GROUP."
- (let ((mail-dir (file-name-as-directory (expand-file-name mail-dir))))
- (if (file-directory-p (concat mail-dir group))
- (concat mail-dir group "/")
- (concat mail-dir (nnmail-replace-chars-in-string group ?. ?/) "/"))))
-
(defun nnmh-update-gnus-unreads (group)
;; Go through the .nnmh-articles file and compare with the actual
;; articles in this folder. The articles that are "new" will be
(write-region (point-min) (point-max) nnmh-file nil 'nomesg)
(kill-buffer (current-buffer)))))
+(defun nnmh-deletable-article-p (group article)
+ "Say whether ARTICLE in GROUP can be deleted."
+ (or (not nnmail-keep-last-article)
+ (not (eq (cdr (nth 1 (assoc group nnmh-group-alist))) article))))
+
(provide 'nnmh)
;;; nnmh.el ends here
projects / gnus / blobdiff