(defvar nnfolder-directory (expand-file-name "~/Mail/")
"The name of the mail box file in the users home directory.")
-(defvar nnfolder-active-file (concat nnfolder-directory "active")
+(defvar nnfolder-active-file (concat nnfolder-directory "active")
"The name of the active file.")
;; I renamed this variable to somehting more in keeping with the general GNU
(defvar nnfolder-get-new-mail t
"If non-nil, nnml will check the incoming mail file and split the mail.")
+(defvar nnfolder-prepare-save-mail-hook nil
+ "Hook run narrowed to an article before saving.")
+
\f
(defconst nnfolder-version "nnfolder 0.2"
(nnfolder-possibly-change-group newsgroup)
(set-buffer nnfolder-current-buffer)
(goto-char (point-min))
- (while sequence
- (setq article (car sequence))
- (setq art-string (nnfolder-article-string article))
- (set-buffer nnfolder-current-buffer)
- (if (or (search-forward art-string nil t)
- ;; Don't search the whole file twice! Also, articles
- ;; probably have some locality by number, so searching
- ;; backwards will be faster. Especially if we're at the
- ;; beginning of the buffer :-). -SLB
- (search-backward art-string nil t))
- (progn
- (setq start (or (re-search-backward delim-string nil t)
- (point)))
- (search-forward "\n\n" nil t)
- (setq stop (1- (point)))
- (set-buffer nntp-server-buffer)
- (insert (format "221 %d Article retrieved.\n" article))
- (setq beg (point))
- (insert-buffer-substring nnfolder-current-buffer start stop)
- (goto-char (point-max))
- (insert ".\n")))
- (setq sequence (cdr sequence)))
-
- ;; Fold continuation lines.
- (set-buffer nntp-server-buffer)
- (goto-char 1)
- (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
- (replace-match " " t t))
- 'headers)))
+ (if (stringp (car sequence))
+ 'headers
+ (while sequence
+ (setq article (car sequence))
+ (setq art-string (nnfolder-article-string article))
+ (set-buffer nnfolder-current-buffer)
+ (if (or (search-forward art-string nil t)
+ ;; Don't search the whole file twice! Also, articles
+ ;; probably have some locality by number, so searching
+ ;; backwards will be faster. Especially if we're at the
+ ;; beginning of the buffer :-). -SLB
+ (search-backward art-string nil t))
+ (progn
+ (setq start (or (re-search-backward delim-string nil t)
+ (point)))
+ (search-forward "\n\n" nil t)
+ (setq stop (1- (point)))
+ (set-buffer nntp-server-buffer)
+ (insert (format "221 %d Article retrieved.\n" article))
+ (setq beg (point))
+ (insert-buffer-substring nnfolder-current-buffer start stop)
+ (goto-char (point-max))
+ (insert ".\n")))
+ (setq sequence (cdr sequence)))
+
+ ;; Fold continuation lines.
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-min))
+ (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
+ (replace-match " " t t))
+ 'headers))))
(defun nnfolder-open-server (server &optional defs)
(nnheader-init-server-buffer)
(progn
(if dont-check
t
- (nnfolder-get-new-mail))
+ (nnfolder-get-new-mail group))
(let* ((active (assoc group nnfolder-group-alist))
(group (car active))
(range (car (cdr active)))
;; way.
(defun nnfolder-close-group (group &optional server force)
- (nnfolder-possibly-change-group group)
- (save-excursion
- (set-buffer nnfolder-current-buffer)
- ;; If the buffer was modified, write the file out now.
- (and (buffer-modified-p) (save-buffer))
- (if (or force
- nnfolder-always-close)
- ;; If we're shutting the server down, we need to kill the buffer and
- ;; remove it from the open buffer list. Or, of course, if we're
- ;; trying to minimize our space impact.
- (progn
- (kill-buffer (current-buffer))
- (setq nnfolder-buffer-alist (delq (assoc group nnfolder-buffer-alist)
- nnfolder-buffer-alist))))
- (setq nnfolder-current-group nil
- nnfolder-current-buffer nil))
+ ;; Make sure we _had_ the group open.
+ (if (or (assoc group nnfolder-buffer-alist)
+ (equal group nnfolder-current-group))
+ (progn
+ (nnfolder-possibly-change-group group)
+ (save-excursion
+ (set-buffer nnfolder-current-buffer)
+ ;; If the buffer was modified, write the file out now.
+ (and (buffer-modified-p) (save-buffer))
+ (if (or force
+ nnfolder-always-close)
+ ;; If we're shutting the server down, we need to kill the
+ ;; buffer and remove it from the open buffer list. Or, of
+ ;; course, if we're trying to minimize our space impact.
+ (progn
+ (kill-buffer (current-buffer))
+ (setq nnfolder-buffer-alist (delq (assoc group
+ nnfolder-buffer-alist)
+ nnfolder-buffer-alist)))))))
+ (setq nnfolder-current-group nil
+ nnfolder-current-buffer nil)
t)
(defun nnfolder-request-list (&optional server)
(defun nnfolder-request-post (&optional server)
(mail-send-and-exit nil))
-(fset 'nnfolder-request-post-buffer 'nnmail-request-post-buffer)
+(defalias 'nnfolder-request-post-buffer 'nnmail-request-post-buffer)
(defun nnfolder-request-expire-articles (articles newsgroup &optional server force)
(nnfolder-possibly-change-group newsgroup)
(save-excursion
(set-buffer nnfolder-current-buffer)
(while articles
- (goto-char 1)
+ (goto-char (point-min))
(if (search-forward (nnfolder-article-string (car articles)) nil t)
(if (or force
(> (nnmail-days-between
(save-excursion
(nnfolder-possibly-change-group group)
(set-buffer nnfolder-current-buffer)
- (goto-char 1)
+ (goto-char (point-min))
(if (search-forward (nnfolder-article-string article) nil t)
(nnfolder-delete-mail))
(and last
(nnfolder-possibly-change-group group)
(save-excursion
(set-buffer nnfolder-current-buffer)
- (goto-char 1)
+ (goto-char (point-min))
(if (not (search-forward (nnfolder-article-string article) nil t))
nil
(nnfolder-delete-mail t t)
(defun nnfolder-possibly-change-group (group)
(or (file-exists-p nnfolder-directory)
(make-directory (directory-file-name nnfolder-directory)))
- (if (not nnfolder-group-alist)
- (progn
- (nnfolder-request-list)
- (setq nnfolder-group-alist (nnmail-get-active))))
+ (nnfolder-possibly-activate-groups nil)
(or (assoc group nnfolder-group-alist)
(not (file-exists-p (concat nnfolder-directory group)))
(progn
;; time.
(if (or (not (buffer-name nnfolder-current-buffer))
(not (and (bufferp nnfolder-current-buffer)
- (verify-visited-file-modtime nnfolder-current-buffer))))
+ (verify-visited-file-modtime
+ nnfolder-current-buffer))))
(progn
(if (and (buffer-name nnfolder-current-buffer)
(bufferp nnfolder-current-buffer))
()
(save-excursion
(setq file (concat nnfolder-directory group))
- (if (not (file-exists-p file))
- (write-region 1 1 file t 'nomesg))
- (set-buffer (nnfolder-read-folder file))
- (setq nnfolder-buffer-alist (cons (list group (current-buffer))
- nnfolder-buffer-alist))))))
+ (if (or (file-directory-p file)
+ (file-symlink-p file))
+ ()
+ (if (not (file-exists-p file))
+ (write-region 1 1 file t 'nomesg))
+ (set-buffer (nnfolder-read-folder file))
+ (setq nnfolder-buffer-alist (cons (list group (current-buffer))
+ nnfolder-buffer-alist)))))))
(setq nnfolder-current-group group))
(defun nnfolder-save-mail (&optional group)
(setq save-list group-art-list)
(nnmail-insert-lines)
(nnmail-insert-xref group-art-list)
+ (run-hooks 'nnfolder-prepare-save-mail-hook)
;; Insert the mail into each of the destination groups.
(while group-art-list
(insert (format (concat nnfolder-article-marker "%d %s\n")
(cdr group-art) (current-time-string)))))))
-(defun nnfolder-active-number (group)
- (if (not nnfolder-group-alist)
- (save-excursion
- (nnfolder-request-list)
- (setq nnfolder-group-alist (nnmail-get-active))))
- (let ((active (car (cdr (assoc group nnfolder-group-alist)))))
- (setcdr active (1+ (cdr active)))
- (cdr active)))
+(defun nnfolder-possibly-activate-groups (&optional group)
+ (save-excursion
+ ;; If we're looking for the activation of a specific group, find out
+ ;; it's real name and switch to it.
+ (if group (nnfolder-possibly-change-group group))
+ ;; If the group alist isn't active, activate it now.
+ (if (not nnfolder-group-alist)
+ (progn
+ (nnfolder-request-list)
+ (setq nnfolder-group-alist (nnmail-get-active))))))
+(defun nnfolder-active-number (group)
+ (save-excursion
+ (nnfolder-possibly-activate-groups group)
+ (let ((active (car (cdr (assoc group nnfolder-group-alist)))))
+ (setcdr active (1+ (cdr active)))
+ (cdr active))))
;; This method has a problem if you've accidentally let the active list get
;; out of sync with the files. This could happen, say, if you've
(defun nnfolder-read-folder (file)
(save-excursion
- (if (not nnfolder-group-alist)
- (progn
- (nnfolder-request-list)
- (setq nnfolder-group-alist (nnmail-get-active))))
+ (nnfolder-possibly-activate-groups nil)
;; We should be paranoid here and make sure the group is in the alist,
;; and add it if it isn't.
;;(if (not (assoc nnfoler-current-group nnfolder-group-alist)
(nnmail-save-active nnfolder-group-alist nnfolder-active-file)
(current-buffer))))
-(defun nnfolder-get-new-mail ()
- (let (incoming)
- (if (and nnmail-spool-file
- nnfolder-get-new-mail
- (file-exists-p nnmail-spool-file)
- (> (nth 7 (file-attributes nnmail-spool-file)) 0))
- (progn
- (and gnus-verbose-backends
- (message "nnfolder: Reading incoming mail..."))
- (setq incoming
- (nnmail-move-inbox nnmail-spool-file
- (concat nnfolder-directory "Incoming")))
- (nnmail-split-incoming incoming 'nnfolder-save-mail)
- (run-hooks 'nnmail-read-incoming-hook)
- (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
- (and gnus-verbose-backends
- (message "nnfolder: Reading incoming mail...done"))))
- (let ((bufs nnfolder-buffer-alist))
- (save-excursion
- (while bufs
- (if (not (buffer-name (nth 1 (car bufs))))
- (setq nnfolder-buffer-alist
- (delq (car bufs) nnfolder-buffer-alist))
- (set-buffer (nth 1 (car bufs)))
- (and (buffer-modified-p) (save-buffer)))
- (setq bufs (cdr bufs)))))
- ;; (if incoming (delete-file incoming))
- ))
+(defun nnfolder-get-new-mail (&optional group)
+ "Read new incoming mail."
+ (let* ((spools (nnmail-get-spool-files group))
+ (all-spools spools)
+ incomings incoming)
+ (if (or (not nnfolder-get-new-mail) (not nnmail-spool-file))
+ ()
+ ;; We first activate all the groups.
+ (nnfolder-possibly-activate-groups nil)
+ ;; 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 "nnfolder: Reading incoming mail..."))
+ (setq incoming
+ (nnmail-move-inbox
+ (car spools) (concat nnfolder-directory "Incoming")))
+ (setq incomings (cons incoming incomings))
+ (setq group (nnmail-get-split-group (car spools) group))
+ (nnmail-split-incoming incoming 'nnfolder-save-mail nil group)))
+ (setq spools (cdr spools)))
+ ;; If we did indeed read any incoming spools, we save all info.
+ (if incoming
+ (progn
+ (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
+ (run-hooks 'nnmail-read-incoming-hook)
+ (and gnus-verbose-backends
+ (message "nnfolder: Reading incoming mail...done"))))
+ (let ((bufs nnfolder-buffer-alist))
+ (save-excursion
+ (while bufs
+ (if (not (buffer-name (nth 1 (car bufs))))
+ (setq nnfolder-buffer-alist
+ (delq (car bufs) nnfolder-buffer-alist))
+ (set-buffer (nth 1 (car bufs)))
+ (and (buffer-modified-p) (save-buffer)))
+ (setq bufs (cdr bufs)))))
+ (while incomings
+ (and
+ nnmail-delete-incoming
+ (file-writable-p incoming)
+ (delete-file incoming))
+ (setq incomings (cdr incomings))))))
(provide 'nnfolder)
projects / gnus / blobdiff