;;; nnimap.el --- imap backend for Gnus
-;; Copyright (C) 1998,1999 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
;; Author: Simon Josefsson <jas@pdc.kth.se>
;; Jim Radford <radford@robby.caltech.edu>
;; Todo, minor things:
;;
;; o Don't require half of Gnus -- backends should be standalone
-;; o Support escape characters in `message-tokenize-header'
-;; o Support NOV nnmail-extra-headers.
;; o Verify that we don't use IMAP4rev1 specific things (RFC2060 App B)
;; o Dont uid fetch 1,* in nnimap-retrive-groups (slow)
;; o Split up big fetches (1,* header especially) in smaller chunks
;; .newsrc.eld)
;; o What about Gnus's article editing, can we support it? NO!
;; o Use \Draft to support the draft group??
+;; o Duplicate suppression
;;; Code:
(eval-and-compile
+ (require 'cl)
(require 'imap))
(require 'nnoo)
"*Name of mailbox to split mail from.
Mail is read from this mailbox and split according to rules in
-`nnimap-split-rules'.
+`nnimap-split-rule'.
This can be a string or a list of strings.")
second is a regexp that nnimap will try to match on the header to find
a fit.
-The first element can also be a list. In that case, the first element
-is the server the second element is the group on that server in which
-the matching article will be stored.
-
The second element can also be a function. In that case, it will be
called narrowed to the headers with the first element of the rule as
the argument. It should return a non-nil value if it thinks that the
-mail belongs in that group.")
+mail belongs in that group.
+
+This variable can also have a function as its value, the function will
+be called with the headers narrowed and should return a group where it
+thinks the article should be splitted to. See `nnimap-split-fancy'.
+
+To allow for different split rules on different virtual servers, and
+even different split rules in different inboxes on the same server,
+the syntax of this variable have been extended along the lines of:
+
+(setq nnimap-split-rule
+ '((\"my1server\" (\".*\" ((\"ding\" \"ding@gnus.org\")
+ (\"junk\" \"From:.*Simon\")))
+ (\"my2server\" (\"INBOX\" nnimap-split-fancy))
+ (\"my[34]server\" (\".*\" ((\"private\" \"To:.*Simon\")
+ (\"junk\" my-junk-func)))))
+
+The virtual server name is in fact a regexp, so that the same rules
+may apply to several servers. In the example, the servers
+\"my3server\" and \"my4server\" both use the same rules. Similarly,
+the inbox string is also a regexp. The actual splitting rules are as
+before, either a function, or a list with group/regexp or
+group/function elements.")
+
+(defvar nnimap-split-predicate "UNSEEN UNDELETED"
+ "The predicate used to find articles to split.
+If you use another IMAP client to peek on articles but always would
+like nnimap to split them once it's started, you could change this to
+\"UNDELETED\". Other available predicates are available in
+RFC2060 section 6.4.4.")
+
+(defvar nnimap-split-fancy nil
+ "Like `nnmail-split-fancy', which see.")
;; Authorization / Privacy variables
everything in the current hierarchy.")
(defvoo nnimap-news-groups nil
- "IMAP support a news-like mode, also known as bulletin board mode, where replies is sent via IMAP instead of SMTP.
+ "IMAP support a news-like mode, also known as bulletin board mode,
+where replies is sent via IMAP instead of SMTP.
This variable should contain a regexp matching groups where you wish
replies to be stored to the mailbox directly.
similar which you wouldn't want to set up a mailing list for, you can
use this to make replies go directly to the group.")
+(defvoo nnimap-expunge-search-string "UID %s NOT SINCE %s"
+ "*IMAP search command to use for articles that are to be expired.
+The first %s is replaced by a UID set of articles to search on,
+and the second %s is replaced by a date criterium.
+
+One useful (and perhaps the only useful) value to change this to would
+be `UID %s NOT SENTSINCE %s' to make nnimap use the Date: header
+instead of the internal date of messages. See section 6.4.4 of RFC
+2060 for more information on valid strings.")
+
+(defvoo nnimap-importantize-dormant t
+ "*If non-nil, mark \"dormant\" articles as \"ticked\" for other IMAP clients.
+Note that within Gnus, dormant articles will still (only) be
+marked as ticked. This is to make \"dormant\" articles stand out,
+just like \"ticked\" articles, in other IMAP clients.")
+
(defvoo nnimap-server-address nil
"Obsolete. Use `nnimap-address'.")
;; Internal variables:
-(defvar nnimap-debug nil);; "*nnimap-debug*")
+(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)
group (gnus-server-to-method
(format "nnimap:%s" server))))
(new-uidvalidity (imap-mailbox-get 'uidvalidity))
- (old-uidvalidity (gnus-group-get-parameter gnusgroup 'uidvalidity)))
+ (old-uidvalidity (gnus-group-get-parameter gnusgroup 'uidvalidity))
+ (dir (file-name-as-directory (expand-file-name nnimap-directory)))
+ (nameuid (nnheader-translate-file-chars
+ (concat nnimap-nov-file-name
+ (if (equal server "")
+ "unnamed"
+ server) "." group "." old-uidvalidity
+ nnimap-nov-file-name-suffix) t))
+ (file (if (or nnmail-use-long-file-names
+ (file-exists-p (expand-file-name nameuid dir)))
+ (expand-file-name nameuid dir)
+ (expand-file-name
+ (mm-encode-coding-string
+ (nnheader-replace-chars-in-string nameuid ?. ?/)
+ nnmail-pathname-coding-system)
+ dir))))
(if old-uidvalidity
(if (not (equal old-uidvalidity new-uidvalidity))
- nil ;; uidvalidity clash
+ ;; uidvalidity clash
+ (gnus-delete-file file)
(gnus-group-set-parameter gnusgroup 'uidvalidity new-uidvalidity)
t)
(gnus-group-add-parameter gnusgroup (cons 'uidvalidity new-uidvalidity))
t)))
+(defun nnimap-before-find-minmax-bugworkaround ()
+ "Function called before iterating through mailboxes with
+`nnimap-find-minmax-uid'."
+ ;; XXX this is for UoW imapd problem, it doesn't notice new mail in
+ ;; currently selected mailbox without a re-select/examine.
+ (or (null (imap-current-mailbox nnimap-server-buffer))
+ (imap-mailbox-unselect nnimap-server-buffer)))
+
(defun nnimap-find-minmax-uid (group &optional examine)
"Find lowest and highest active article nummber in GROUP.
If EXAMINE is non-nil the group is selected read-only."
(if (or (nnimap-verify-uidvalidity
group (or server nnimap-current-server))
(zerop (imap-mailbox-get 'exists group))
+ t ;; for OGnus to see if ignoring uidvalidity
+ ;; changes has any bad effects.
(yes-or-no-p
(format
"nnimap: Group %s is not uidvalid. Continue? " group)))
imap-current-mailbox
(imap-mailbox-unselect)
- (error "nnimap: Group %s is not uid-valid." group))
+ (error "nnimap: Group %s is not uid-valid" group))
(nnheader-report 'nnimap (imap-error-text)))))))
(defun nnimap-replace-whitespace (string)
nnimap-progress-how-often)
nnimap-progress-chars)))
(with-current-buffer nntp-server-buffer
- (nnheader-insert-nov
- (with-current-buffer nnimap-server-buffer
- (vector imap-current-message
- (nnimap-replace-whitespace
- (imap-message-envelope-subject imap-current-message))
- (nnimap-replace-whitespace
- (imap-envelope-from
- (car-safe (imap-message-envelope-from
- imap-current-message))))
- (nnimap-replace-whitespace
- (imap-message-envelope-date imap-current-message))
- (nnimap-replace-whitespace
- (imap-message-envelope-message-id imap-current-message))
- (nnimap-replace-whitespace
- (let ((str (if (imap-capability 'IMAP4rev1)
- (nth 2 (assoc
- "HEADER.FIELDS REFERENCES"
- (imap-message-get
- imap-current-message 'BODYDETAIL)))
- (imap-message-get imap-current-message
- 'RFC822.HEADER))))
- (if (> (length str) (length "References: "))
- (substring str (length "References: "))
- (if (and (setq str (imap-message-envelope-in-reply-to
- imap-current-message))
- (string-match "<[^>]+>" str))
- (substring str (match-beginning 0) (match-end 0))))))
- (imap-message-get imap-current-message 'RFC822.SIZE)
- (imap-body-lines (imap-message-body imap-current-message))
- nil;; xref
- nil)))));; extra-headers
+ (let (headers lines chars uid mbx)
+ (with-current-buffer nnimap-server-buffer
+ (setq uid imap-current-message
+ mbx imap-current-mailbox
+ headers (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 uid 'BODYDETAIL)))
+ (imap-message-get uid 'RFC822.HEADER)))
+ lines (imap-body-lines (imap-message-body imap-current-message))
+ chars (imap-message-get imap-current-message 'RFC822.SIZE)))
+ (nnheader-insert-nov
+ (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)))
+ (mail-header-set-number head uid)
+ (mail-header-set-chars head chars)
+ (mail-header-set-lines head lines)
+ (mail-header-set-xref
+ head (format "%s %s:%d" (system-name) mbx uid))
+ head))))))
(defun nnimap-retrieve-which-headers (articles fetch-old)
"Get a range of articles to fetch based on ARTICLES and FETCH-OLD."
(if (numberp (car-safe articles))
(imap-search
(concat "UID "
- (nnimap-range-to-string
+ (imap-range-to-message-set
(gnus-compress-sequence
(append (gnus-uncompress-sequence
(and fetch-old
articles)))))
(mapcar (lambda (msgid)
(imap-search
- (format "HEADER Message-Id %s" msgid)))
+ (format "HEADER Message-Id \"%s\"" msgid)))
articles))))
(defun nnimap-group-overview-filename (group server)
"Make pathname for GROUP on SERVER."
- (let ((dir (file-name-as-directory (expand-file-name nnimap-directory)))
- (file (nnheader-translate-file-chars
- (concat nnimap-nov-file-name
- (if (equal server "")
- "unnamed"
- server) "." group nnimap-nov-file-name-suffix) t)))
- (if (or nnmail-use-long-file-names
- (file-exists-p (concat dir file)))
- (concat dir file)
- (concat dir (mm-encode-coding-string
- (nnheader-replace-chars-in-string file ?. ?/)
- nnmail-pathname-coding-system)))))
+ (let* ((dir (file-name-as-directory (expand-file-name nnimap-directory)))
+ (uidvalidity (gnus-group-get-parameter
+ (gnus-group-prefixed-name
+ group (gnus-server-to-method
+ (format "nnimap:%s" server)))
+ 'uidvalidity))
+ (name (nnheader-translate-file-chars
+ (concat nnimap-nov-file-name
+ (if (equal server "")
+ "unnamed"
+ server) "." group nnimap-nov-file-name-suffix) t))
+ (nameuid (nnheader-translate-file-chars
+ (concat nnimap-nov-file-name
+ (if (equal server "")
+ "unnamed"
+ server) "." group "." uidvalidity
+ nnimap-nov-file-name-suffix) t))
+ (oldfile (if (or nnmail-use-long-file-names
+ (file-exists-p (expand-file-name name dir)))
+ (expand-file-name name dir)
+ (expand-file-name
+ (mm-encode-coding-string
+ (nnheader-replace-chars-in-string name ?. ?/)
+ nnmail-pathname-coding-system)
+ dir)))
+ (newfile (if (or nnmail-use-long-file-names
+ (file-exists-p (expand-file-name nameuid dir)))
+ (expand-file-name nameuid dir)
+ (expand-file-name
+ (mm-encode-coding-string
+ (nnheader-replace-chars-in-string nameuid ?. ?/)
+ nnmail-pathname-coding-system)
+ dir))))
+ (when (and (file-exists-p oldfile) (not (file-exists-p newfile)))
+ (message "nnimap: Upgrading novcache filename...")
+ (sit-for 1)
+ (gnus-make-directory (file-name-directory newfile))
+ (unless (ignore-errors (rename-file oldfile newfile) t)
+ (if (ignore-errors (copy-file oldfile newfile) t)
+ (delete-file oldfile)
+ (error "Can't rename `%s' to `%s'" oldfile newfile))))
+ newfile))
(defun nnimap-retrieve-headers-from-file (group server)
(with-current-buffer nntp-server-buffer
(when (file-exists-p nov)
(mm-insert-file-contents nov)
(set-buffer-modified-p nil)
- (let ((min (progn (goto-char (point-min))
- (when (not (eobp))
- (read (current-buffer)))))
- (max (progn (goto-char (point-max))
- (forward-line -1)
- (when (not (bobp))
- (read (current-buffer))))))
+ (let ((min (ignore-errors (goto-char (point-min))
+ (read (current-buffer))))
+ (max (ignore-errors (goto-char (point-max))
+ (forward-line -1)
+ (read (current-buffer)))))
(if (and (numberp min) (numberp max))
(cons min max)
;; junk, remove it, it's saved later
(let ((imap-fetch-data-hook '(nnimap-retrieve-headers-progress))
(nnimap-length (gnus-range-length articles))
(nnimap-counter 0))
- (imap-fetch (nnimap-range-to-string articles)
- (concat "(UID RFC822.SIZE ENVELOPE BODY "
- (if (imap-capability 'IMAP4rev1)
- "BODY.PEEK[HEADER.FIELDS (References)])"
- "RFC822.HEADER.LINES (References))")))
+ (imap-fetch (imap-range-to-message-set articles)
+ (concat "(UID RFC822.SIZE BODY "
+ (let ((headers
+ (append '(Subject From Date Message-Id
+ References In-Reply-To Xref)
+ (copy-sequence
+ nnmail-extra-headers))))
+ (if (imap-capability 'IMAP4rev1)
+ (format "BODY.PEEK[HEADER.FIELDS %s])" headers)
+ (format "RFC822.HEADER.LINES %s)" headers)))))
(and (numberp nnmail-large-newsgroup)
(> nnimap-length nnmail-large-newsgroup)
(nnheader-message 6 "nnimap: Retrieving headers...done")))))
-(defun nnimap-use-nov-p (group server)
+(defun nnimap-dont-use-nov-p (group server)
(or gnus-nov-is-evil nnimap-nov-is-evil
(unless (and (gnus-make-directory
(file-name-directory
(when (nnimap-possibly-change-group group server)
(with-current-buffer nntp-server-buffer
(erase-buffer)
- (if (nnimap-use-nov-p group server)
+ (if (nnimap-dont-use-nov-p group server)
(nnimap-retrieve-headers-from-server
(gnus-compress-sequence articles) group server)
(let (uids cached low high)
;; remove nov's for articles which has expired on server
(goto-char (point-min))
(dolist (uid (gnus-set-difference articles uids))
- (when (re-search-forward (format "^%d\t" uid) nil t)
- (gnus-delete-line)))))
+ (when (re-search-forward (format "^%d\t" uid) nil t)
+ (gnus-delete-line)))))
;; nothing cached, fetch whole range from server
(nnimap-retrieve-headers-from-server
(cons low high) group server))
(imap-capability 'IMAP4rev1 nnimap-server-buffer))
(imap-close nnimap-server-buffer)
(nnheader-report 'nnimap "Server %s is not IMAP4 compliant" server))
- (let (list alist user passwd)
- (and (fboundp 'gnus-parse-netrc)
- (setq list (gnus-parse-netrc nnimap-authinfo-file)
- alist (or (and (gnus-netrc-get
- (gnus-netrc-machine list server) "machine")
- (gnus-netrc-machine list server))
- (gnus-netrc-machine list nnimap-address))
- user (gnus-netrc-get alist "login")
- passwd (gnus-netrc-get alist "password")))
+ (let* ((list (gnus-parse-netrc nnimap-authinfo-file))
+ (port (if nnimap-server-port
+ (int-to-string nnimap-server-port)
+ "imap"))
+ (alist (gnus-netrc-machine list (or nnimap-server-address
+ nnimap-address server)
+ port "imap"))
+ (user (gnus-netrc-get alist "login"))
+ (passwd (gnus-netrc-get alist "password")))
(if (imap-authenticate user passwd nnimap-server-buffer)
(prog1
(push (list server nnimap-server-buffer)
(cadr (assq 'nnimap-server-address defs))) defs)
(push (list 'nnimap-address server) defs)))
(nnoo-change-server 'nnimap server defs)
+ (with-current-buffer (get-buffer-create nnimap-server-buffer)
+ (nnoo-change-server 'nnimap server defs))
(or (and nnimap-server-buffer
(imap-opened nnimap-server-buffer))
(nnimap-open-connection server))))
(with-current-buffer nnimap-callback-buffer
(insert
(with-current-buffer nnimap-server-buffer
- (nnimap-demule (imap-message-get (imap-current-message) 'RFC822)))) ;xxx
+ (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-request-article-part (article part prop
- &optional group server to-buffer)
+(defun nnimap-request-article-part (article part prop &optional
+ group server to-buffer detail)
(when (nnimap-possibly-change-group group server)
(let ((article (if (stringp article)
(car-safe (imap-search
- (format "HEADER Message-Id %s" article)
+ (format "HEADER Message-Id \"%s\"" article)
nnimap-server-buffer))
article)))
(when article
- (gnus-message 9 "nnimap: Fetching (part of) article %d..." article)
+ (gnus-message 10 "nnimap: Fetching (part of) article %d..." article)
(if (not nnheader-callback-function)
(with-current-buffer (or to-buffer nntp-server-buffer)
(erase-buffer)
- (insert (nnimap-demule (imap-fetch article part prop nil
- nnimap-server-buffer)))
- (nnheader-ms-strip-cr)
- (gnus-message 9 "nnimap: Fetching (part of) article %d...done"
+ (let ((data (imap-fetch article part prop nil
+ nnimap-server-buffer)))
+ (insert (nnimap-demule (if detail
+ (nth 2 (car data))
+ data))))
+ (nnheader-ms-strip-cr)
+ (gnus-message 10 "nnimap: Fetching (part of) article %d...done"
article)
(if (bobp)
(nnheader-report 'nnimap "No such article: %s"
t)
(deffoo nnimap-request-article (article &optional group server to-buffer)
- (nnimap-request-article-part
- article "RFC822.PEEK" 'RFC822 group server to-buffer))
+ (if (imap-capability 'IMAP4rev1 nnimap-server-buffer)
+ (nnimap-request-article-part
+ article "BODY.PEEK[]" 'BODYDETAIL group server to-buffer 'detail)
+ (nnimap-request-article-part
+ article "RFC822.PEEK" 'RFC822 group server to-buffer)))
(deffoo nnimap-request-head (article &optional group server to-buffer)
- (nnimap-request-article-part
- article "RFC822.HEADER" 'RFC822.HEADER group server to-buffer))
+ (if (imap-capability 'IMAP4rev1 nnimap-server-buffer)
+ (nnimap-request-article-part
+ article "BODY.PEEK[HEADER]" 'BODYDETAIL group server to-buffer 'detail)
+ (nnimap-request-article-part
+ article "RFC822.HEADER" 'RFC822.HEADER group server to-buffer)))
(deffoo nnimap-request-body (article &optional group server to-buffer)
- (nnimap-request-article-part
- article "RFC822.TEXT.PEEK" 'RFC822.TEXT group server to-buffer))
+ (if (imap-capability 'IMAP4rev1 nnimap-server-buffer)
+ (nnimap-request-article-part
+ article "BODY.PEEK[TEXT]" 'BODYDETAIL group server to-buffer 'detail)
+ (nnimap-request-article-part
+ article "RFC822.TEXT.PEEK" 'RFC822.TEXT group server to-buffer)))
(deffoo nnimap-request-group (group &optional server fast)
(nnimap-request-update-info-internal
group (gnus-server-to-method (format "nnimap:%s" server))))
server)
(when (nnimap-possibly-change-group group server)
+ (nnimap-before-find-minmax-bugworkaround)
(let (info)
(cond (fast group)
((null (setq info (nnimap-find-minmax-uid group t)))
(erase-buffer))
(gnus-message 5 "nnimap: Generating active list%s..."
(if (> (length server) 0) (concat " for " server) ""))
+ (nnimap-before-find-minmax-bugworkaround)
(with-current-buffer nnimap-server-buffer
(dolist (pattern (nnimap-pattern-to-list-arguments nnimap-list-pattern))
(dolist (mbx (funcall nnimap-request-list-method
(deffoo nnimap-request-post (&optional server)
(let ((success t))
- (dolist (mbx (message-tokenize-header
- (message-fetch-field "Newsgroups")) success)
+ (dolist (mbx (message-unquote-tokens
+ (message-tokenize-header
+ (message-fetch-field "Newsgroups") ", ")) success)
(let ((to-newsgroup (gnus-group-prefixed-name mbx gnus-command-method)))
(or (gnus-active to-newsgroup)
(gnus-activate-group to-newsgroup)
(gnus-message 5 "nnimap: Checking mailboxes...")
(with-current-buffer nntp-server-buffer
(erase-buffer)
+ (nnimap-before-find-minmax-bugworkaround)
(dolist (group groups)
(gnus-message 7 "nnimap: Checking mailbox %s" group)
(or (member "\\NoSelect"
seen))
(gnus-info-set-read info seen)))
- (mapc (lambda (pred)
- (when (and (nnimap-mark-permanent-p (cdr pred))
- (member (nnimap-mark-to-flag (cdr pred))
- (imap-mailbox-get 'flags)))
- (gnus-info-set-marks
- info
- (nnimap-update-alist-soft
- (cdr pred)
- (gnus-compress-sequence
- (imap-search (nnimap-mark-to-predicate (cdr pred))))
- (gnus-info-marks info))
- t)))
- gnus-article-mark-lists)
+ (mapcar (lambda (pred)
+ (when (and (nnimap-mark-permanent-p (cdr pred))
+ (member (nnimap-mark-to-flag (cdr pred))
+ (imap-mailbox-get 'flags)))
+ (gnus-info-set-marks
+ info
+ (nnimap-update-alist-soft
+ (cdr pred)
+ (gnus-compress-sequence
+ (imap-search (nnimap-mark-to-predicate (cdr pred))))
+ (gnus-info-marks info))
+ t)))
+ gnus-article-mark-lists)
+
+ (when nnimap-importantize-dormant
+ ;; nnimap mark dormant article as ticked too (for other clients)
+ ;; so we remove that mark for gnus since we support dormant
+ (gnus-info-set-marks
+ info
+ (nnimap-update-alist-soft
+ 'tick
+ (gnus-remove-from-range
+ (cdr-safe (assoc 'tick (gnus-info-marks info)))
+ (cdr-safe (assoc 'dormant (gnus-info-marks info))))
+ (gnus-info-marks info))
+ t))
(gnus-message 5 "nnimap: Updating info for %s...done"
(gnus-info-group info))
marks)
;; cache flags are pointless on the server
(setq cmdmarks (delq 'cache cmdmarks))
- ;; flag dormant articles as ticked
- (if (memq 'dormant cmdmarks)
- (setq cmdmarks (cons 'tick cmdmarks)))
+ (when nnimap-importantize-dormant
+ ;; flag dormant articles as ticked
+ (if (memq 'dormant cmdmarks)
+ (setq cmdmarks (cons 'tick cmdmarks))))
;; remove stuff we are forbidden to store
(mapcar (lambda (mark)
(if (imap-message-flag-permanent-p
(when (and range marks)
(cond ((eq what 'del)
(imap-message-flags-del
- (nnimap-range-to-string range)
+ (imap-range-to-message-set range)
(nnimap-mark-to-flag marks nil t)))
((eq what 'add)
(imap-message-flags-add
- (nnimap-range-to-string range)
+ (imap-range-to-message-set range)
(nnimap-mark-to-flag marks nil t)))
((eq what 'set)
(imap-message-flags-set
- (nnimap-range-to-string range)
+ (imap-range-to-message-set range)
(nnimap-mark-to-flag marks nil t)))))))
(gnus-message 7 "nnimap: Setting marks in %s...done" group))))
nil)
+(defun nnimap-split-fancy ()
+ "Like nnmail-split-fancy, but uses nnimap-split-fancy."
+ (let ((nnmail-split-fancy nnimap-split-fancy))
+ (nnmail-split-fancy)))
+
(defun nnimap-split-to-groups (rules)
;; tries to match all rules in nnimap-split-rule against content of
;; nntp-server-buffer, returns a list of groups that matched.
(or nnimap-split-crosspost
(throw 'split-done to-groups))))))))))
+(defun nnimap-assoc-match (key alist)
+ (let (element)
+ (while (and alist (not element))
+ (if (string-match (car (car alist)) key)
+ (setq element (car alist)))
+ (setq alist (cdr alist)))
+ element))
+
(defun nnimap-split-find-rule (server inbox)
- nnimap-split-rule)
+ (if (and (listp nnimap-split-rule) (listp (car nnimap-split-rule))
+ (list (cdar nnimap-split-rule)) (listp (cadar nnimap-split-rule)))
+ ;; extended format
+ (cadr (nnimap-assoc-match inbox (cdr (nnimap-assoc-match
+ server nnimap-split-rule))))
+ nnimap-split-rule))
(defun nnimap-split-find-inbox (server)
(if (listp nnimap-split-inbox)
;; find split rule for this server / inbox
(when (setq rule (nnimap-split-find-rule server inbox))
;; iterate over articles
- (dolist (article (imap-search "UNSEEN UNDELETED"))
+ (dolist (article (imap-search nnimap-split-predicate))
(when (nnimap-request-head article)
;; copy article to right group(s)
(setq removeorig nil)
(dolist (to-group (nnimap-split-to-groups rule))
- (if (imap-message-copy (number-to-string article)
- to-group nil 'nocopyuid)
- (progn
- (message "IMAP split moved %s:%s:%d to %s" server inbox
- article to-group)
- (setq removeorig t)
- ;; Add the group-art list to the history list.
- (push (list (cons to-group 0)) nnmail-split-history))
- (message "IMAP split failed to move %s:%s:%d to %s" server
- inbox article to-group)))
+ (cond ((eq to-group 'junk)
+ (message "IMAP split removed %s:%s:%d" server inbox
+ article)
+ (setq removeorig t))
+ ((imap-message-copy (number-to-string article)
+ to-group nil 'nocopyuid)
+ (message "IMAP split moved %s:%s:%d to %s" server
+ inbox article to-group)
+ (setq removeorig t)
+ ;; Add the group-art list to the history list.
+ (push (list (cons to-group 0)) nnmail-split-history))
+ (t
+ (message "IMAP split failed to move %s:%s:%d to %s"
+ server inbox article to-group))))
;; remove article if it was successfully copied somewhere
(and removeorig
(imap-message-flags-add (format "%d" article)
(gnus-message 5 "nnimap: Listing subscribed mailboxes%s%s..."
(if (> (length server) 0) " on " "") server)
(erase-buffer)
+ (nnimap-before-find-minmax-bugworkaround)
(dolist (pattern (nnimap-pattern-to-list-arguments
nnimap-list-pattern))
(dolist (mbx (imap-mailbox-lsub "*" (car pattern) nil
nnimap-server-buffer))
- (or (member-if (lambda (mailbox)
- (string= (downcase mailbox) "\\noselect"))
- (imap-mailbox-get 'list-flags mbx
- nnimap-server-buffer))
+ (or (catch 'found
+ (dolist (mailbox (imap-mailbox-get 'list-flags mbx
+ nnimap-server-buffer))
+ (if (string= (downcase mailbox) "\\noselect")
+ (throw 'found t)))
+ nil)
(let ((info (nnimap-find-minmax-uid mbx 'examine)))
(when info
(insert (format "\"%s\" %d %d y\n"
(defun nnimap-date-days-ago (daysago)
"Return date, in format \"3-Aug-1998\", for DAYSAGO days ago."
- (let ((date (format-time-string "%d-%b-%Y"
- (nnimap-time-substract
- (current-time)
- (days-to-time daysago)))))
+ (let* ((time (nnimap-time-substract (current-time) (days-to-time daysago)))
+ (date (format-time-string
+ (format "%%d-%s-%%Y"
+ (capitalize (car (rassoc (nth 4 (decode-time time))
+ parse-time-months))))
+ time)))
(if (eq ?0 (string-to-char date))
(substring date 1)
date)))
(gnus-message 5 "nnimap: Marking article %d for deletion..."
imap-current-message))
+
+(defun nnimap-expiry-target (arts group server)
+ (unless (eq nnmail-expiry-target 'delete)
+ (with-current-buffer nntp-server-buffer
+ (dolist (art (gnus-uncompress-sequence arts))
+ (nnimap-request-article art group server)
+ ;; hints for optimization in `nnimap-request-accept-article'
+ (let ((nnimap-current-move-article art)
+ (nnimap-current-move-group group)
+ (nnimap-current-move-server server))
+ (nnmail-expiry-target-group nnmail-expiry-target group))))))
+
;; Notice that we don't actually delete anything, we just mark them deleted.
(deffoo nnimap-request-expire-articles (articles group &optional server force)
(let ((artseq (gnus-compress-sequence articles)))
(when (and artseq (nnimap-possibly-change-group group server))
(with-current-buffer nnimap-server-buffer
(if force
- (and (imap-message-flags-add
- (nnimap-range-to-string artseq) "\\Deleted")
- (setq articles nil))
+ (progn
+ (nnimap-expiry-target artseq group server)
+ (when (imap-message-flags-add (imap-range-to-message-set artseq)
+ "\\Deleted")
+ (setq articles nil)))
(let ((days (or (and nnmail-expiry-wait-function
(funcall nnmail-expiry-wait-function group))
nnmail-expiry-wait)))
(cond ((eq days 'immediate)
- (and (imap-message-flags-add
- (nnimap-range-to-string artseq) "\\Deleted")
- (setq articles nil)))
+ (nnimap-expiry-target artseq group server)
+ (when (imap-message-flags-add
+ (imap-range-to-message-set artseq) "\\Deleted")
+ (setq articles nil)))
((numberp days)
(let ((oldarts (imap-search
- (format "UID %s NOT SINCE %s"
- (nnimap-range-to-string artseq)
+ (format nnimap-expunge-search-string
+ (imap-range-to-message-set artseq)
(nnimap-date-days-ago days))))
(imap-fetch-data-hook
'(nnimap-request-expire-articles-progress)))
+ (nnimap-expiry-target oldarts group server)
(and oldarts
(imap-message-flags-add
- (nnimap-range-to-string
+ (imap-range-to-message-set
(gnus-compress-sequence oldarts))
"\\Deleted")
(setq articles (gnus-set-difference
nnimap-current-move-article)
group 'dontcreate nil
nnimap-server-buffer))
- ;; turn into rfc822 format (\r\n eol's)
(with-current-buffer (current-buffer)
(goto-char (point-min))
+ ;; remove any 'From blabla' lines, some IMAP servers
+ ;; reject the entire message otherwise.
+ (when (looking-at "^From[^:]")
+ (kill-region (point) (progn (forward-line) (point))))
+ ;; turn into rfc822 format (\r\n eol's)
(while (search-forward "\n" nil t)
(replace-match "\r\n")))
- ;; next line for Cyrus server bug
- (imap-mailbox-unselect nnimap-server-buffer)
+ ;; this 'or' is for Cyrus server bug
+ (or (null (imap-current-mailbox nnimap-server-buffer))
+ (imap-mailbox-unselect nnimap-server-buffer))
(imap-message-append group (current-buffer) nil nil
nnimap-server-buffer)))
(cons group (nth 1 uid))
(defun nnimap-acl-get (mailbox server)
(when (nnimap-possibly-change-server server)
- (imap-mailbox-acl-get mailbox nnimap-server-buffer)))
+ (and (imap-capability 'ACL nnimap-server-buffer)
+ (imap-mailbox-acl-get mailbox nnimap-server-buffer))))
(defun nnimap-acl-edit (mailbox method old-acls new-acls)
(when (nnimap-possibly-change-server (cadr method))
(cons (cons key value) (nnimap-remassoc key alist))
(nnimap-remassoc key alist)))
-(defun nnimap-range-to-string (range)
- (mapconcat
- (lambda (item)
- (if (consp item)
- (format "%d:%d"
- (car item) (cdr item))
- (format "%d" item)))
- (if (and (listp range) (not (listp (cdr range))))
- (list range);; make (1 . 2) into ((1 . 2))
- range)
- ","))
-
(when nnimap-debug
(require 'trace)
(buffer-disable-undo (get-buffer-create nnimap-debug))
- (mapc (lambda (f) (trace-function-background f nnimap-debug))
+ (mapcar (lambda (f) (trace-function-background f nnimap-debug))
'(
nnimap-possibly-change-server
nnimap-verify-uidvalidity
nnimap-find-minmax-uid
+ nnimap-before-find-minmax-bugworkaround
nnimap-possibly-change-group
;;nnimap-replace-whitespace
nnimap-retrieve-headers-progress
nnimap-mark-permanent-p
nnimap-remassoc
nnimap-update-alist-soft
- nnimap-range-to-string
)))
(provide 'nnimap)
projects / gnus / blobdiff