\f
-(defconst nnmh-version "nnmh 0.1"
+(defconst nnmh-version "nnmh 1.0"
"nnmh version.")
(defvar nnmh-current-directory nil
;;; 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)
(and (stringp file)
(file-exists-p file)
(not (file-directory-p file))
- (save-excursion (nnmail-find-file file)))))
+ (save-excursion (nnmail-find-file file))
+ (string-to-int (file-name-nondirectory file)))))
(defun nnmh-request-group (group &optional server dont-check)
- (and nnmh-get-new-mail (or dont-check (nnmh-get-new-mail group)))
- (let ((pathname (nnmh-article-pathname group nnmh-directory))
+ (let ((pathname (nnmail-group-pathname group nnmh-directory))
dir)
(if (file-directory-p pathname)
(progn
(car dir))
group))
(insert (format "211 0 1 0 %s\n" group))))))
- t))))
+ t)
+ (setq nnmh-status-string "No such group")
+ nil)))
+
+(defun nnmh-request-scan (&optional group server)
+ (nnmail-get-new-mail 'nnmh nil nnmh-directory group))
(defun nnmh-request-list (&optional server dir)
(or dir
(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)
(apply (function min) files)))))))
(setq nnmh-group-alist (nnmail-get-active))
- (and server nnmh-get-new-mail (nnmh-get-new-mail))
t)
(defun nnmh-request-newgroups (date &optional server)
(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)
(string-to-int name)))
(directory-files nnmh-current-directory nil "^[0-9]+$" t)))
(max-article (and active-articles (apply 'max active-articles)))
+ (is-old t)
article rest mod-time)
- (while articles
+ (nnmail-activate 'nnmh)
+
+ (while (and articles is-old)
(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)))
- (or force
- (> (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 %s..." article))
+ (and gnus-verbose-backends
+ (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))))
(setq articles (cdr articles)))
(message "")
- rest))
+ (nconc rest articles)))
(defun nnmh-close-group (group &optional server)
t)
(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))
+ result))
(defun nnmh-request-accept-article (group &optional last)
(if (stringp group)
(and
- (nnmh-request-list)
- (setq nnmh-group-alist (nnmail-get-active))
+ (nnmail-activate 'nnmh)
;; We trick the choosing function into believing that only one
;; group is availiable.
(let ((nnmail-split-methods (list (list group ""))))
(car (nnmh-save-mail))))
(and
- (nnmh-request-list)
- (setq nnmh-group-alist (nnmail-get-active))
+ (nnmail-activate 'nnmh)
(car (nnmh-save-mail)))))
(defun nnmh-request-replace-article (article group buffer)
t)
(error nil))))
+(defun nnmh-request-create-group (group &optional server)
+ (nnmail-activate 'nnmh)
+ (or (assoc group nnmh-group-alist)
+ (let (active)
+ (setq nnmh-group-alist (cons (list group (setq active (cons 1 0)))
+ nnmh-group-alist))
+ (nnmh-possibly-create-directory group)
+ (nnmh-possibly-change-directory group)
+ (let ((articles (mapcar
+ (lambda (file)
+ (string-to-int file))
+ (directory-files
+ nnmh-current-directory nil "^[0-9]+$"))))
+ (and articles
+ (progn
+ (setcar active (apply 'min articles))
+ (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 (nnmail-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))))
(defun nnmh-save-mail ()
"Called narrowed to an article."
- (let ((group-art (nreverse (nnmail-article-group 'nnmh-active-number)))
- chars nov-line lines hbeg hend)
- (setq chars (nnmail-insert-lines))
+ (let ((group-art (nreverse (nnmail-article-group 'nnmh-active-number))))
+ (nnmail-insert-lines)
(nnmail-insert-xref group-art)
(run-hooks 'nnmh-prepare-save-mail-hook)
(goto-char (point-min))
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
(defun nnmh-active-number (group)
"Compute the next article number in GROUP."
(let ((active (car (cdr (assoc group nnmh-group-alist)))))
+ ;; The group wasn't known to nnmh, so we just create an active
+ ;; entry for it.
+ (or active
+ (progn
+ (setq active (cons 1 0))
+ (setq nnmh-group-alist (cons (list group active) nnmh-group-alist))))
(setcdr active (1+ (cdr active)))
- (let (file)
- (while (file-exists-p
- (setq file (concat (nnmh-article-pathname
- group nnmh-directory)
- (int-to-string (cdr active)))))
- (setcdr active (1+ (cdr active)))))
+ (while (file-exists-p
+ (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-get-new-mail (&optional group)
- "Read new incoming mail."
- (let* ((spools (nnmail-get-spool-files group))
- (all-spools spools)
- (group-in group)
- incoming incomings)
- (if (or (not nnmh-get-new-mail) (not nnmail-spool-file))
- ()
- ;; We first activate all the groups.
- (or nnmh-group-alist
- (nnmh-request-list))
- ;; The we go through all the existing spool files and split the
- ;; mail from each.
- (while spools
- (and
- (file-exists-p (car spools))
- (> (nth 7 (file-attributes (car spools))) 0)
- (progn
- (and gnus-verbose-backends
- (message "nnmh: Reading incoming mail..."))
- (setq incoming
- (nnmail-move-inbox
- (car spools) (concat nnmh-directory "Incoming")))
- (setq incomings (cons incoming incomings))
- (setq group (nnmail-get-split-group (car spools) group-in))
- (nnmail-split-incoming incoming 'nnmh-save-mail nil group)))
- (setq spools (cdr spools)))
- ;; If we did indeed read any incoming spools, we save all info.
- (if incoming
- (message "nnmh: Reading incoming mail...done"))
- (while incomings
- (and nnmail-delete-incoming
- (file-writable-p incoming)
- (delete-file incoming))
- (setq incomings (cdr incomings))))))
-
-
(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