(require 'nnmail)
(defvar nnmbox-mbox-file (expand-file-name "~/mbox")
- "The name of the mail box file in the users home directory.")
+ "The name of the mail box file in the user's home directory.")
(defvar nnmbox-active-file (expand-file-name "~/.mbox-active")
"The name of the active file for the mail box.")
(defvar nnmbox-get-new-mail t
- "If non-nil, nnml will check the incoming mail file and split the mail.")
+ "If non-nil, nnmbox will check the incoming mail file and split the mail.")
+
+(defvar nnmbox-prepare-save-mail-hook nil
+ "Hook run narrowed to an article before saving.")
\f
(defvar nnmbox-current-group nil
"Current nnmbox news group directory.")
-(defconst nnmbox-mbox-buffer " *nnmbox mbox buffer*")
+(defconst nnmbox-mbox-buffer nil)
(defvar nnmbox-status-string "")
(defvar nnmbox-group-alist nil)
+\f
+
+(defvar nnmbox-current-server nil)
+(defvar nnmbox-server-alist nil)
+(defvar nnmbox-server-variables
+ (list
+ (list 'nnmbox-mbox-file nnmbox-mbox-file)
+ (list 'nnmbox-active-file nnmbox-active-file)
+ (list 'nnmbox-get-new-mail nnmbox-get-new-mail)
+ '(nnmbox-current-group nil)
+ '(nnmbox-status-string "")
+ '(nnmbox-group-alist nil)))
+
+\f
+
;;; Interface functions
(defun nnmbox-retrieve-headers (sequence &optional newsgroup server)
(save-excursion
(set-buffer nntp-server-buffer)
(erase-buffer)
- (let ((file nil)
- (number (length sequence))
+ (let ((number (length sequence))
(count 0)
- beg article art-string start stop)
+ article art-string start stop)
(nnmbox-possibly-change-newsgroup newsgroup)
- (while sequence
- (setq article (car sequence))
- (setq art-string (nnmbox-article-string article))
- (set-buffer nnmbox-mbox-buffer)
- (if (or (search-forward art-string nil t)
- (progn (goto-char 1)
- (search-forward art-string nil t)))
- (progn
- (setq start
- (save-excursion
- (re-search-backward
- (concat "^" rmail-unix-mail-delimiter) 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 nnmbox-mbox-buffer start stop)
- (goto-char (point-max))
- (insert ".\n")))
- (setq sequence (cdr sequence))
- (setq count (1+ count))
+ (if (stringp (car sequence))
+ 'headers
+ (while sequence
+ (setq article (car sequence))
+ (setq art-string (nnmbox-article-string article))
+ (set-buffer nnmbox-mbox-buffer)
+ (if (or (search-forward art-string nil t)
+ (progn (goto-char (point-min))
+ (search-forward art-string nil t)))
+ (progn
+ (setq start
+ (save-excursion
+ (re-search-backward
+ (concat "^" rmail-unix-mail-delimiter) 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))
+ (insert-buffer-substring nnmbox-mbox-buffer start stop)
+ (goto-char (point-max))
+ (insert ".\n")))
+ (setq sequence (cdr sequence))
+ (setq count (1+ count))
+ (and (numberp nnmail-large-newsgroup)
+ (> number nnmail-large-newsgroup)
+ (zerop (% count 20))
+ gnus-verbose-backends
+ (message "nnmbox: Receiving headers... %d%%"
+ (/ (* count 100) number))))
+
(and (numberp nnmail-large-newsgroup)
(> number nnmail-large-newsgroup)
- (zerop (% count 20))
gnus-verbose-backends
- (message "nnmbox: Receiving headers... %d%%"
- (/ (* count 100) number))))
-
- (and (numberp nnmail-large-newsgroup)
- (> number nnmail-large-newsgroup)
- gnus-verbose-backends
- (message "nnmbox: Receiving headers... done"))
+ (message "nnmbox: Receiving headers...done"))
- ;; Fold continuation lines.
- (goto-char 1)
- (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
- (replace-match " " t t))
- 'headers)))
-
-(defun nnmbox-open-server (host &optional service)
- (setq nnmbox-status-string "")
- (setq nnmbox-group-alist nil)
- (nnheader-init-server-buffer))
+ ;; 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 nnmbox-open-server (server &optional defs)
+ (nnheader-init-server-buffer)
+ (if (equal server nnmbox-current-server)
+ t
+ (if nnmbox-current-server
+ (setq nnmbox-server-alist
+ (cons (list nnmbox-current-server
+ (nnheader-save-variables nnmbox-server-variables))
+ nnmbox-server-alist)))
+ (let ((state (assoc server nnmbox-server-alist)))
+ (if state
+ (progn
+ (nnheader-restore-variables (nth 1 state))
+ (setq nnmbox-server-alist (delq state nnmbox-server-alist)))
+ (nnheader-set-init-variables nnmbox-server-variables defs)))
+ (setq nnmbox-current-server server)))
(defun nnmbox-close-server (&optional server)
t)
(defun nnmbox-server-opened (&optional server)
- (and nntp-server-buffer
- (get-buffer nntp-server-buffer)))
+ (and (equal server nnmbox-current-server)
+ nnmbox-mbox-buffer
+ (buffer-name nnmbox-mbox-buffer)
+ nntp-server-buffer
+ (buffer-name nntp-server-buffer)))
(defun nnmbox-status-message (&optional server)
nnmbox-status-string)
nil
(save-excursion
(set-buffer nnmbox-mbox-buffer)
- (goto-char 1)
+ (goto-char (point-min))
(if (search-forward (nnmbox-article-string article) nil t)
(let (start stop)
(re-search-backward (concat "^" rmail-unix-mail-delimiter) nil t)
(if (nnmbox-possibly-change-newsgroup group)
(if dont-check
t
- (nnmbox-get-new-mail)
+ (nnmbox-get-new-mail group)
(save-excursion
(set-buffer nntp-server-buffer)
(erase-buffer)
(defun nnmbox-request-list (&optional server)
(if server (nnmbox-get-new-mail))
- (or (nnmail-find-file nnmbox-active-file)
- (progn
- (setq nnmbox-group-alist (nnmail-get-active))
- (nnmail-save-active nnmbox-group-alist nnmbox-active-file)
- (nnmail-find-file nnmbox-active-file))))
+ (save-excursion
+ (or (nnmail-find-file nnmbox-active-file)
+ (progn
+ (setq nnmbox-group-alist (nnmail-get-active))
+ (nnmail-save-active nnmbox-group-alist nnmbox-active-file)
+ (nnmail-find-file nnmbox-active-file)))))
(defun nnmbox-request-newgroups (date &optional server)
(nnmbox-request-list server))
(defun nnmbox-request-post (&optional server)
(mail-send-and-exit nil))
-(fset 'nnmbox-request-post-buffer 'nnmail-request-post-buffer)
+(defalias 'nnmbox-request-post-buffer 'nnmail-request-post-buffer)
(defun nnmbox-request-expire-articles
(articles newsgroup &optional server force)
(let* ((days (or (and nnmail-expiry-wait-function
(funcall nnmail-expiry-wait-function newsgroup))
nnmail-expiry-wait))
- article rest)
+ (is-old t)
+ rest)
+ (nnmail-activate 'nnmbox)
+
(save-excursion
(set-buffer nnmbox-mbox-buffer)
- (while articles
- (goto-char 1)
+ (while (and articles is-old)
+ (goto-char (point-min))
(if (search-forward (nnmbox-article-string (car articles)) nil t)
(if (or force
- (> (nnmail-days-between
- (current-time-string)
- (buffer-substring
- (point) (progn (end-of-line) (point))))
- days))
+ (setq is-old
+ (> (nnmail-days-between
+ (current-time-string)
+ (buffer-substring
+ (point) (progn (end-of-line) (point))))
+ days)))
(progn
(and gnus-verbose-backends
- (message "Deleting: %s" (car articles)))
+ (message "Deleting article %s..." (car articles)))
(nnmbox-delete-mail))
(setq rest (cons (car articles) rest))))
(setq articles (cdr articles)))
;; Find the lowest active article in this group.
(let ((active (nth 1 (assoc newsgroup nnmbox-group-alist))))
(goto-char (point-min))
- (while (not (search-forward
- (nnmbox-article-string (car active)) nil t))
- (setcar (car active) (1+ (car active)))
+ (while (and (not (search-forward
+ (nnmbox-article-string (car active)) nil t))
+ (<= (car active) (cdr active)))
+ (setcar active (1+ (car active)))
(goto-char (point-min))))
(nnmail-save-active nnmbox-group-alist nnmbox-active-file)
- rest)))
+ (nconc rest articles))))
(defun nnmbox-request-move-article
(article group server accept-form &optional last)
result)
(save-excursion
(set-buffer nnmbox-mbox-buffer)
- (goto-char 1)
+ (goto-char (point-min))
(if (search-forward (nnmbox-article-string article) nil t)
(nnmbox-delete-mail))
(and last (save-buffer))))
(defun nnmbox-request-accept-article (group &optional last)
(let ((buf (current-buffer))
- result beg)
+ result)
(goto-char (point-min))
(if (looking-at "X-From-Line: ")
(replace-match "From ")
(insert "From nobody " (current-time-string) "\n"))
(and
- (nnmbox-request-list)
- (setq nnmbox-group-alist (nnmail-get-active))
+ (nnmail-activate 'nnmbox)
(progn
(set-buffer buf)
(goto-char (point-min))
(nnmbox-possibly-change-newsgroup group)
(save-excursion
(set-buffer nnmbox-mbox-buffer)
- (goto-char 1)
+ (goto-char (point-min))
(if (not (search-forward (nnmbox-article-string article) nil t))
nil
(nnmbox-delete-mail t t)
(delete-region (point-min) (point-max))))))
(defun nnmbox-possibly-change-newsgroup (newsgroup)
- (if (not (get-buffer nnmbox-mbox-buffer))
+ (if (or (not nnmbox-mbox-buffer)
+ (not (buffer-name nnmbox-mbox-buffer)))
(save-excursion
(set-buffer (setq nnmbox-mbox-buffer
(find-file-noselect nnmbox-mbox-file)))
(buffer-disable-undo (current-buffer))))
(if (not nnmbox-group-alist)
- (progn
- (nnmbox-request-list)
- (setq nnmbox-group-alist (nnmail-get-active))))
+ (nnmail-activate 'nnmbox))
(if newsgroup
(if (assoc newsgroup nnmbox-group-alist)
(setq nnmbox-current-group newsgroup))))
(nnmail-insert-lines)
(nnmail-insert-xref group-art)
(nnmbox-insert-newsgroup-line group-art)
+ (run-hooks 'nnml-prepare-save-mail-hook)
group-art))
(defun nnmbox-insert-newsgroup-line (group-art)
t))
(defun nnmbox-active-number (group)
- "Find the next article number in GROUP."
+ ;; Find the next article number in GROUP.
(let ((active (car (cdr (assoc group nnmbox-group-alist)))))
- (setcdr active (1+ (cdr active)))
+ (if active
+ (setcdr active (1+ (cdr active)))
+ ;; This group is new, so we create a new entry for it.
+ ;; This might be a bit naughty... creating groups on the drop of
+ ;; a hat, but I don't know...
+ (setq nnmbox-group-alist (cons (list group (setq active (cons 1 1)))
+ nnmbox-group-alist)))
(cdr active)))
(defun nnmbox-read-mbox ()
- (nnmbox-request-list)
- (setq nnmbox-group-alist (nnmail-get-active))
+ (nnmail-activate 'nnmbox)
(if (not (file-exists-p nnmbox-mbox-file))
(write-region 1 1 nnmbox-mbox-file t 'nomesg))
(if (and nnmbox-mbox-buffer
- (get-buffer nnmbox-mbox-buffer)
(buffer-name nnmbox-mbox-buffer)
(save-excursion
(set-buffer nnmbox-mbox-buffer)
(nnmbox-save-mail))))
(goto-char end))))))
-(defun nnmbox-get-new-mail ()
- (let (incoming)
+(defun nnmbox-get-new-mail (&optional group)
+ "Read new incoming mail."
+ (let* ((spools (nnmail-get-spool-files group))
+ (group-in group)
+ incoming incomings)
(nnmbox-read-mbox)
- (if (and nnmail-spool-file nnmbox-get-new-mail
- (file-exists-p nnmail-spool-file)
- (> (nth 7 (file-attributes nnmail-spool-file)) 0))
- (progn
- (and gnus-verbose-backends
- (message "nnmbox: Reading incoming mail..."))
- (setq incoming
- (nnmail-move-inbox nnmail-spool-file
- (concat nnmbox-mbox-file "-Incoming")))
- (save-excursion
- (let ((in-buf (nnmail-split-incoming
- incoming 'nnmbox-save-mail t)))
- (set-buffer nnmbox-mbox-buffer)
- (goto-char (point-max))
- (insert-buffer-substring in-buf)
- (kill-buffer in-buf)))
- (run-hooks 'nnmail-read-incoming-hook)
- (and gnus-verbose-backends
- (message "nnmbox: Reading incoming mail...done"))))
- (and (buffer-modified-p nnmbox-mbox-buffer)
- (save-excursion
- (nnmail-save-active nnmbox-group-alist nnmbox-active-file)
- (set-buffer nnmbox-mbox-buffer)
- (save-buffer)))
-; (if incoming
-; (delete-file incoming))
- ))
+ (if (or (not nnmbox-get-new-mail) (not nnmail-spool-file))
+ ()
+ ;; 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 "nnmbox: Reading incoming mail..."))
+ (setq incoming
+ (nnmail-move-inbox
+ (car spools) (concat nnmbox-mbox-file "-Incoming")))
+ (save-excursion
+ (setq group (nnmail-get-split-group (car spools) group-in))
+ (let ((in-buf (nnmail-split-incoming
+ incoming 'nnmbox-save-mail t group)))
+ (set-buffer nnmbox-mbox-buffer)
+ (goto-char (point-max))
+ (insert-buffer-substring in-buf)
+ (kill-buffer in-buf)))))
+ (setq spools (cdr spools)))
+ ;; If we did indeed read any incoming spools, we save all info.
+ (and (buffer-modified-p nnmbox-mbox-buffer)
+ (save-excursion
+ (nnmail-save-active nnmbox-group-alist nnmbox-active-file)
+ (set-buffer nnmbox-mbox-buffer)
+ (save-buffer)))
+ (if incomings (run-hooks 'nnmail-read-incoming-hook))
+ (while incomings
+ (and nnmail-delete-incoming
+ (file-writable-p incoming)
+ (delete-file incoming))
+ (setq incomings (cdr incomings))))))
+
(provide 'nnmbox)
projects / gnus / blobdiff