;;; nnimap.el --- imap backend for Gnus
-;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.
;; Author: Simon Josefsson <jas@pdc.kth.se>
;; Jim Radford <radford@robby.caltech.edu>
;; o Split up big fetches (1,* header especially) in smaller chunks
;; o What do I do with gnus-newsgroup-*?
;; o Tell Gnus about new groups (how can we tell?)
-;; o Respooling (fix Gnus?) (unnecessery?)
+;; o Respooling (fix Gnus?) (unnecessary?)
;; o Add support for the following: (if applicable)
;; request-list-newsgroups, request-regenerate
;; list-active-group,
(functionp value))
(defcustom nnimap-split-rule nil
- "Mail will be split according to theese rules.
+ "Mail will be split according to these rules.
Mail is read from mailbox(es) specified in `nnimap-split-inbox'.
:group 'nnimap
:type 'sexp)
+(defcustom nnimap-split-download-body nil
+ "Whether to download entire articles during splitting.
+This is generally not required, and will slow things down considerably.
+You may need it if you want to use an advanced splitting function that
+analyses the body before splitting the article."
+ :group 'nnimap
+ :type 'boolean)
+
;; Performance / bug workaround variables
(defcustom nnimap-close-asynchronous t
If this is 'imap-mailbox-lsub, then use a server-side subscription list to
restrict visible folders.")
+(defcustom nnimap-debug nil
+ "If non-nil, random debug spews are placed in *nnimap-debug* buffer."
+ :group 'nnimap
+ :type 'boolean)
+
;; Internal variables:
+(defvar nnimap-debug-buffer "*nnimap-debug*")
(defvar nnimap-mailbox-info (gnus-make-hashtable 997))
-(defvar nnimap-debug nil
- "Name of buffer to record debugging info.
-For example: (setq nnimap-debug \"*nnimap-debug*\")")
(defvar nnimap-current-move-server nil)
(defvar nnimap-current-move-group nil)
(defvar nnimap-current-move-article nil)
(defvar nnimap-progress-chars '(?| ?/ ?- ?\\))
(defvar nnimap-progress-how-often 20)
(defvar nnimap-counter)
-(defvar nnimap-callback-callback-function nil
- "Gnus callback the nnimap asynchronous callback should call.")
-(defvar nnimap-callback-buffer nil
- "Which buffer the asynchronous article prefetch callback should work in.")
(defvar nnimap-server-buffer-alist nil) ;; Map server name to buffers.
(defvar nnimap-current-server nil) ;; Current server
(defvar nnimap-server-buffer nil) ;; Current servers' buffer
(imap-mailbox-unselect nnimap-server-buffer))))
(defun nnimap-find-minmax-uid (group &optional examine)
- "Find lowest and highest active article nummber in GROUP.
+ "Find lowest and highest active article number in GROUP.
If EXAMINE is non-nil the group is selected read-only."
(with-current-buffer nnimap-server-buffer
(when (or (string= group (imap-current-mailbox))
(with-temp-buffer
(buffer-disable-undo)
(insert headers)
- (nnheader-ms-strip-cr)
- (nnheader-fold-continuation-lines)
- (subst-char-in-region (point-min) (point-max) ?\t ? )
- (let ((head (nnheader-parse-head 'naked)))
+ (let ((head (nnheader-parse-naked-head)))
(mail-header-set-number head uid)
(mail-header-set-chars head chars)
(mail-header-set-lines head lines)
articles))))
(defun nnimap-group-overview-filename (group server)
- "Make pathname for GROUP on SERVER."
+ "Make file name for GROUP on SERVER."
(let* ((dir (file-name-as-directory (expand-file-name nnimap-directory)))
(uidvalidity (gnus-group-get-parameter
(gnus-group-prefixed-name
(nnoo-change-server 'nnimap server defs))
(or (and nnimap-server-buffer
(imap-opened nnimap-server-buffer)
- (if (memq imap-state '(auth select examine))
+ (if (with-current-buffer nnimap-server-buffer
+ (memq imap-state '(auth select examine)))
t
(imap-close nnimap-server-buffer)
(nnimap-open-connection server)))
'identity)
(or string "")))
-(defun nnimap-callback ()
- (remove-hook 'imap-fetch-data-hook 'nnimap-callback)
- (with-current-buffer nnimap-callback-buffer
- (insert
- (with-current-buffer nnimap-server-buffer
- (nnimap-demule
- (if (imap-capability 'IMAP4rev1)
- ;; xxx don't just use car? alist doesn't contain
- ;; anything else now, but it might...
- (nth 2 (car (imap-message-get (imap-current-message) 'BODYDETAIL)))
- (imap-message-get (imap-current-message) 'RFC822)))))
- (nnheader-ms-strip-cr)
- (funcall nnimap-callback-callback-function t)))
+(defun nnimap-make-callback (article gnus-callback buffer)
+ "Return a callback function."
+ `(lambda ()
+ (nnimap-callback ,article ,gnus-callback ,buffer)))
+
+(defun nnimap-callback (article gnus-callback buffer)
+ (when (eq article (imap-current-message))
+ (remove-hook 'imap-fetch-data-hook
+ (nnimap-make-callback article gnus-callback buffer))
+ (with-current-buffer buffer
+ (insert
+ (with-current-buffer nnimap-server-buffer
+ (nnimap-demule
+ (if (imap-capability 'IMAP4rev1)
+ ;; xxx don't just use car? alist doesn't contain
+ ;; anything else now, but it might...
+ (nth 2 (car (imap-message-get article 'BODYDETAIL)))
+ (imap-message-get article 'RFC822)))))
+ (nnheader-ms-strip-cr)
+ (funcall gnus-callback t))))
(defun nnimap-request-article-part (article part prop &optional
group server to-buffer detail)
nnimap-server-buffer))
article)))
(when article
- (gnus-message 10 "nnimap: Fetching (part of) article %d..." article)
+ (gnus-message 10 "nnimap: Fetching (part of) article %d from %s..."
+ article (or group imap-current-mailbox
+ gnus-newsgroup-name))
(if (not nnheader-callback-function)
(with-current-buffer (or to-buffer nntp-server-buffer)
(erase-buffer)
(nth 2 (car data))
data))))
(nnheader-ms-strip-cr)
- (gnus-message 10 "nnimap: Fetching (part of) article %d...done"
- article)
+ (gnus-message
+ 10 "nnimap: Fetching (part of) article %d from %s...done"
+ article (or group imap-current-mailbox gnus-newsgroup-name))
(if (bobp)
- (nnheader-report 'nnimap "No such article: %s"
+ (nnheader-report 'nnimap "No such article %d in %s: %s"
+ article (or group imap-current-mailbox
+ gnus-newsgroup-name)
(imap-error-text nnimap-server-buffer))
(cons group article)))
- (add-hook 'imap-fetch-data-hook 'nnimap-callback)
- (setq nnimap-callback-callback-function nnheader-callback-function
- nnimap-callback-buffer nntp-server-buffer)
+ (add-hook 'imap-fetch-data-hook
+ (nnimap-make-callback article
+ nnheader-callback-function
+ nntp-server-buffer))
(imap-fetch-asynch article part nil nnimap-server-buffer)
(cons group article))))))
(when (setq rule (nnimap-split-find-rule server inbox))
;; iterate over articles
(dolist (article (imap-search nnimap-split-predicate))
- (when (nnimap-request-head article)
+ (when (if nnimap-split-download-body
+ (and (nnimap-request-article article)
+ (mail-narrow-to-head))
+ (nnimap-request-head article))
;; copy article to right group(s)
(setq removeorig nil)
(dolist (to-group (nnimap-split-to-groups rule))
(t
(message "IMAP split failed to move %s:%s:%d to %s"
server inbox article to-group))))
+ (if nnimap-split-download-body
+ (widen))
;; remove article if it was successfully copied somewhere
(and removeorig
(imap-message-flags-add (format "%d" article)
(when oldarts
(nnimap-expiry-target oldarts group server)
(when (imap-message-flags-add
- (imap-range-to-message-set oldarts) "\\Deleted")
+ (imap-range-to-message-set
+ (gnus-compress-sequence oldarts)) "\\Deleted")
(setq articles (gnus-set-difference
articles oldarts))))))
((numberp days)
(when oldarts
(nnimap-expiry-target oldarts group server)
(when (imap-message-flags-add
- (imap-range-to-message-set oldarts) "\\Deleted")
+ (imap-range-to-message-set
+ (gnus-compress-sequence oldarts)) "\\Deleted")
(setq articles (gnus-set-difference
articles oldarts)))))))))))
;; return articles not deleted
(when nnimap-debug
(require 'trace)
- (buffer-disable-undo (get-buffer-create nnimap-debug))
- (mapcar (lambda (f) (trace-function-background f nnimap-debug))
+ (buffer-disable-undo (get-buffer-create nnimap-debug-buffer))
+ (mapcar (lambda (f) (trace-function-background f nnimap-debug-buffer))
'(
nnimap-possibly-change-server
nnimap-verify-uidvalidity
projects / gnus / blobdiff