[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
nnimap 0.126 -> 0.127 patches
- To: nnimap@extundo.com
- Subject: nnimap 0.126 -> 0.127 patches
- From: Simon Josefsson <jas@pdc.kth.se>
- Date: 09 Aug 1999 03:37:14 +0200
- User-Agent: Gnus/5.070095 (Pterodactyl Gnus v0.95) Emacs/20.4
Index: nnimap/ChangeLog
diff -u nnimap/ChangeLog:1.264 nnimap/ChangeLog:1.268
--- nnimap/ChangeLog:1.264 Mon Jul 19 07:55:36 1999
+++ nnimap/ChangeLog Sun Aug 8 18:26:59 1999
@@ -1,4 +1,50 @@
+1999-08-09 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap 0.127 released.
+
+1999-08-09 Michael Poole <poole@graviton.subatomic.org>
+
+ * nnimap.el (nnimap-request-list-method): New variable.
+ (nnimap-request-list): Use it.
+
+1999-08-09 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap.el (nnimap-prune-cache): New variable.
+ (nnimap-retrieve-which-headers): Search for active UIDs.
+ (nnimap-use-nov-p): New function.
+ (nnimap-retrieve-headers): Use it. Remove NOVs for dead articles.
+ (nnimap-request-newgroups): Update to new imap API.
+
+ * imap.el (imap-parse-fetch): Ignore errors when `read':ing UID
+ (integer overflows).
+
+1999-08-09 Michael Poole <poole@graviton.subatomic.org>
+
+ * imap.el (imap-mailbox-lsub): New parameters root and
+ have-delimiter, as `imap-mailbox-list'.
+
+1999-07-25 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap.el (nnimap-possibly-change-group): Don't verify
+ uidvalidity when mailbox already selected. Don't expunge mailbox.
+ (nnimap-retrieve-headers-from-server): Work in buffer.
+ (nnimap-request-group): No need to work in buffer.
+ (nnimap-expunge-close-group): Removed.
+ (nnimap-close-group): Do expunging. Change group.
+ (nnimap-request-list): Work in buffer.
+ (nnimap-split-articles): Manual expunging.
+ (*): Checkdoc fixes.
+ (nnimap-request-delete-group): Succeed when there is no such
+ group.
+
+ * imap.el (imap-open): Set imap-mailbox-data.
+ (imap-mailbox-select): Don't set imap-mailbox-data.
+ (imap-mailbox-prime): Default to 997.
+ (imap-message-prime): Ditto.
+
1999-07-19 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap.el (nnimap-request-set-mark): Fix message.
* nnimap 0.126 released.
Index: nnimap/imap.el
diff -u nnimap/imap.el:1.160 nnimap/imap.el:1.162
--- nnimap/imap.el:1.160 Sat Jul 17 14:17:19 1999
+++ nnimap/imap.el Sun Aug 8 18:17:22 1999
@@ -239,7 +239,6 @@
imap-current-mailbox
imap-current-target-mailbox
imap-message-data
- imap-mailbox-data
imap-capability
imap-namespace
imap-state
@@ -276,7 +275,7 @@
(defvar imap-mailbox-data nil
"Obarray with mailbox data.")
-(defvar imap-mailbox-prime 127
+(defvar imap-mailbox-prime 997
"Length of imap-mailbox-data.")
(defvar imap-current-message nil
@@ -285,7 +284,7 @@
(defvar imap-message-data nil
"Obarray with message data.")
-(defvar imap-message-prime 67
+(defvar imap-message-prime 997
"Length of imap-message-data.")
(defvar imap-capability nil
@@ -647,9 +646,10 @@
(setq imap-auth auth
auths nil)))
(unless imap-auth
- (error "Couldn't figure out authenticator for server")))))))
- (if (imap-opened buffer)
- buffer))
+ (error "Couldn't figure out authenticator for server"))))))
+ (when (imap-opened buffer)
+ (setq imap-mailbox-data (make-vector imap-mailbox-prime 0))
+ buffer)))
(defun imap-opened (&optional buffer)
"Return non-nil if connection to imap server in BUFFER is open. If
@@ -762,8 +762,6 @@
(with-current-buffer (or buffer (current-buffer))
(if (imap-current-mailbox-p mailbox examine)
imap-current-mailbox
- (unless imap-mailbox-data
- (setq imap-mailbox-data (make-vector imap-mailbox-prime 0)))
(setq imap-current-mailbox mailbox)
(if (imap-ok-p (imap-send-command-wait
(concat (if examine "EXAMINE" "SELECT") " \""
@@ -837,15 +835,24 @@
(imap-send-command-wait (list "RENAME \"" (imap-utf7-encode oldname)
"\" \"" (imap-utf7-encode newname) "\"")))))
-(defun imap-mailbox-lsub (&optional buffer reference)
- "Clear the mailbox data and fill it with subscribed mailboxes on
-server in BUFFER. REFERENCE is the implementation-specific string that
-has to be passed to LSUB."
+(defun imap-mailbox-lsub (&optional buffer root have-delimiter reference)
+ "Return a list of subscribed mailboxes on server in BUFFER.
+Mailboxes have to match ROOT. A hierarchy delimiter is added unless
+HAVE-DELIMITER is non-nil. REFERENCE is a implementation-specific
+string that has to be passed to LSUB."
(with-current-buffer (or buffer (current-buffer))
(imap-mailbox-map (lambda (mailbox)
(imap-mailbox-put 'lsub nil mailbox)))
- (when (imap-ok-p (imap-send-command-wait
- (concat "LSUB \"" reference "\" \"*\"")))
+ (when root
+ (unless have-delimiter
+ (imap-send-command-wait (concat "LSUB \"" reference "\" \""
+ (imap-utf7-encode root) "\""))))
+ (when (imap-ok-p
+ (imap-send-command-wait
+ (concat "LSUB \"" reference "\" \"" (imap-utf7-encode root)
+ (when (and root (not have-delimiter))
+ (imap-mailbox-get 'delimiter root))
+ "%\"")))
(let (out)
(imap-mailbox-map (lambda (mailbox)
(when (imap-mailbox-get 'lsub mailbox)
@@ -853,10 +860,10 @@
(nreverse out)))))
(defun imap-mailbox-list (&optional buffer root have-delimiter reference)
- "List all mailboxes that starts with ROOT in BUFFER. If
-HAVE-DELIMITER is non-nil, a hierarchy delimiter is not added to
-ROOT. REFERENCE is the implementation-specific string that has to be
-passed to LIST."
+ "Return a list of subscribed mailboxes on server in BUFFER.
+Mailboxes have to match ROOT. A hierarchy delimiter is added unless
+HAVE-DELIMITER is non-nil. REFERENCE is a implementation-specific
+string that has to be passed to LIST."
(with-current-buffer (or buffer (current-buffer))
(imap-mailbox-map (lambda (mailbox)
(imap-mailbox-put 'list nil mailbox)))
@@ -1747,7 +1754,7 @@
(let ((token (read (current-buffer))))
(imap-forward)
(cond ((eq token 'UID)
- (setq uid (read (current-buffer))))
+ (setq uid (ignore-errors (read (current-buffer)))))
((eq token 'FLAGS)
(setq flags (imap-parse-flag-list)))
((eq token 'ENVELOPE)
Index: nnimap/nnimap.el
diff -u nnimap/nnimap.el:1.213 nnimap/nnimap.el:1.216
--- nnimap/nnimap.el:1.213 Mon Jul 19 03:17:02 1999
+++ nnimap/nnimap.el Sun Aug 8 18:28:40 1999
@@ -37,6 +37,8 @@
;;
;; Todo, minor things:
;;
+;; o Support escape characters in `message-tokenize-header'
+;; o Split-fancy.
;; 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)
@@ -52,11 +54,13 @@
;; o Do The Right Thing when UIDVALIDITY changes (fixed?)
;; o Support RFC2221 (Login referrals)
;; o IMAP2BIS compatibility? (RFC2061)
-;; o ACAP stuff (perhaps a different project, would be nice to ACAPify
+;; o ACAP stuff (perhaps a different project, would be nice to ACAPify
;; .newsrc.eld)
;; o What about Gnus's article editing, can we support it?
;; o Use \Draft to support the draft group??
+;;; Code:
+
(eval-and-compile
(require 'imap))
@@ -74,7 +78,7 @@
(gnus-declare-backend "nnimap" 'post-mail 'address 'prompt-address
'physical-address)
-(defconst nnimap-version "nnimap 0.126")
+(defconst nnimap-version "nnimap 0.127")
(defvoo nnimap-address nil
"Address of physical IMAP server. If nil, use the virtual server's name.")
@@ -90,14 +94,17 @@
If nil, the first match found will be used.")
(defvar nnimap-split-inbox nil
- "*Name of mailbox to split mail from. Mail is read from this mailbox and
-split according to rules in nnimap-split-rules.
+ "*Name of mailbox to split mail from.
+
+Mail is read from this mailbox and split according to rules in
+`nnimap-split-rules'.
This can be a string or a list of strings.")
(defvar nnimap-split-rule nil
- "*Mail will be split according to theese rules. Mail is read from mailbox(es)
-specified in nnimap-split-inbox.
+ "*Mail will be split according to theese rules.
+
+Mail is read from mailbox(es) specified in `nnimap-split-inbox'.
If you'd like, for instance, one mail group for mail from the
\"gnus-imap\" mailing list, one group for junk mail and leave
@@ -107,7 +114,7 @@
(setq nnimap-split-rule '((\"INBOX.gnus-imap\" \"From:.*gnus-imap\")
(\"INBOX.junk\" \"Subject:.*buy\")))
-As you can see, nnimap-split-rule is a list of lists, where the first
+As you can see, `nnimap-split-rule' is a list of lists, where the first
element in each \"rule\" is the name of the IMAP mailbox, and the
second is a regexp that nnimap will try to match on the header to find
a fit.
@@ -189,7 +196,7 @@
When setting this variable to `never', you can only expunge articles
by using `G x' (gnus-group-nnimap-expunge) from the Group buffer.")
-(defvoo nnimap-list-pattern "*"
+(defvoo nnimap-list-pattern "*"
"A string LIMIT or list of strings with mailbox wildcards used to
limit available groups. Se below for available wildcards.
@@ -225,7 +232,7 @@
"Obsolete. Use `nnimap-address'.")
(defcustom nnimap-authinfo-file "~/.authinfo"
- "Authorization information for IMAP servers. In .netrc format."
+ "Authorization information for IMAP servers. In .netrc format."
:type
'(choice file
(repeat :tag "Entries"
@@ -241,6 +248,16 @@
(const :format "" "password")
(string :format "Password: %v")))))))
+(defcustom nnimap-prune-cache t
+ "If non-nil, nnimap check wheter articles still exist on server
+before using data stored in NOV cache."
+ :type 'boolean)
+
+(deffoo nnimap-request-list-method 'imap-mailbox-list
+ "Method to use to request a list of all folders from the server.
+If this is 'imap-mailbox-lsub, then use a server-side subscription list to
+restrict visible folders.")
+
;; Internal variables:
(defvar nnimap-debug "*nnimap-debug*")
@@ -265,6 +282,7 @@
;; Utility functions:
(defun nnimap-replace-in-string (string regexp to)
+ "Replace substrings in STRING matching REGEXP with TO."
(if (string-match regexp string)
(concat (substring string 0 (match-beginning 0))
to
@@ -273,19 +291,19 @@
string))
(defsubst nnimap-get-server-buffer (server)
- "Return buffer for SERVER. If SERVER is nil, the current server is
-used."
+ "Return buffer for SERVER, if nil use current server."
(cadr (assoc (or server nnimap-current-server) nnimap-server-buffer-alist)))
(defun nnimap-possibly-change-server (server)
- ;; Return buffer of server SERVER. If SERVER is nil, return current
- ;; server buffer. Changes the current server as a side-effect.
+ "Return buffer for SERVER, changing the current server as a side-effect.
+If SERVER is nil, uses the current server."
(setq nnimap-current-server (or server nnimap-current-server)
nnimap-server-buffer (nnimap-get-server-buffer nnimap-current-server)))
(defun nnimap-verify-uidvalidity (group server)
- (let* ((gnusgroup (gnus-group-prefixed-name
- group (gnus-server-to-method
+ "Verify stored uidvalidity match current one in GROUP on SERVER."
+ (let* ((gnusgroup (gnus-group-prefixed-name
+ group (gnus-server-to-method
(format "nnimap:%s" server))))
(new-uidvalidity (imap-mailbox-get 'uidvalidity))
(old-uidvalidity (gnus-group-get-parameter gnusgroup 'uidvalidity)))
@@ -298,6 +316,8 @@
t)))
(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."
(with-current-buffer nnimap-server-buffer
(when (imap-mailbox-select group nil examine)
(let (minuid maxuid)
@@ -310,23 +330,20 @@
(list (imap-mailbox-get 'exists) minuid maxuid)))))
(defun nnimap-possibly-change-group (group &optional server)
+ "Make GROUP the current group, and SERVER the current server."
(when (nnimap-possibly-change-server server)
(with-current-buffer nnimap-server-buffer
- (if (null group)
+ (if (or (null group) (imap-current-mailbox-p group))
imap-current-mailbox
- (if (imap-current-mailbox-p group)
- t
- (when imap-current-mailbox
- (nnimap-expunge-close-group))
- (if (imap-mailbox-select group)
- (if (nnimap-verify-uidvalidity group
- (or server nnimap-current-server))
- imap-current-mailbox
- (imap-mailbox-unselect)
- (gnus-message 1 "nnimap: Group %s is not uid-valid." group)
- (ding)
- nil)
- (nnheader-report 'nnimap (imap-error-text))))))))
+ (if (imap-mailbox-select group)
+ (if (nnimap-verify-uidvalidity group
+ (or server nnimap-current-server))
+ imap-current-mailbox
+ (imap-mailbox-unselect)
+ (gnus-message 1 "nnimap: Group %s is not uid-valid." group)
+ (ding)
+ nil)
+ (nnheader-report 'nnimap (imap-error-text)))))))
(defun nnimap-replace-whitespace (string)
"Return STRING with all whitespace replaced with space."
@@ -338,12 +355,13 @@
;; Required backend functions
(defun nnimap-retrieve-headers-progress ()
+ "Hook to insert NOV line for current article into `nntp-server-buffer'."
(and (numberp nnmail-large-newsgroup)
(zerop (% (incf nnimap-counter) nnimap-progress-how-often))
(> nnimap-length nnmail-large-newsgroup)
(nnheader-message 6 "nnimap: Retrieving headers... %c"
- (nth (/ (% nnimap-counter
- (* (length nnimap-progress-chars)
+ (nth (/ (% nnimap-counter
+ (* (length nnimap-progress-chars)
nnimap-progress-how-often))
nnimap-progress-how-often)
nnimap-progress-chars)))
@@ -357,7 +375,7 @@
(imap-envelope-from
(car-safe (imap-message-envelope-from
imap-current-message))))
- (nnimap-replace-whitespace
+ (nnimap-replace-whitespace
(imap-message-envelope-date imap-current-message))
(nnimap-replace-whitespace
(imap-message-envelope-message-id imap-current-message))
@@ -367,7 +385,7 @@
"HEADER.FIELDS REFERENCES"
(imap-message-get
imap-current-message 'BODYDETAIL)))
- (imap-message-get imap-current-message
+ (imap-message-get imap-current-message
'RFC822.HEADER))))
(if (> (length str) (length "References: "))
(substring str (length "References: "))
@@ -381,23 +399,27 @@
nil))))) ;; extra-headers
(defun nnimap-retrieve-which-headers (articles fetch-old)
- ;; get a range of articles to fetch based on articles and fetch-old
+ "Get a range of articles to fetch based on ARTICLES and FETCH-OLD."
(with-current-buffer nnimap-server-buffer
(if (numberp (car-safe articles))
- (append (gnus-uncompress-sequence
- (and fetch-old
- (cons (if (numberp fetch-old)
- (max 1 (- (car articles) fetch-old))
- 1)
- (1- (car articles)))))
- articles)
+ (imap-search
+ (concat "UID "
+ (nnimap-range-to-string
+ (gnus-compress-sequence
+ (append (gnus-uncompress-sequence
+ (and fetch-old
+ (cons (if (numberp fetch-old)
+ (max 1 (- (car articles) fetch-old))
+ 1)
+ (1- (car articles)))))
+ articles)))))
(mapcar (lambda (msgid)
(imap-search
(format "HEADER Message-Id %s" msgid)))
articles))))
(defun nnimap-group-overview-filename (group server)
- "Make pathname for GROUP."
+ "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
@@ -431,55 +453,63 @@
nil))))))
(defun nnimap-retrieve-headers-from-server (articles group server)
- (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 nnimap-server-buffer)
- "BODY.PEEK[HEADER.FIELDS (References)])"
- "RFC822.HEADER.LINES (References))"))
- nil nil nnimap-server-buffer)
- (and (numberp nnmail-large-newsgroup)
- (> nnimap-length nnmail-large-newsgroup)
- (nnheader-message 6 "nnimap: Retrieving headers...done"))))
+ (with-current-buffer nnimap-server-buffer
+ (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))")))
+ (and (numberp nnmail-large-newsgroup)
+ (> nnimap-length nnmail-large-newsgroup)
+ (nnheader-message 6 "nnimap: Retrieving headers...done")))))
+
+(defun nnimap-use-nov-p (group server)
+ (or gnus-nov-is-evil nnimap-nov-is-evil
+ (unless (and (gnus-make-directory
+ (file-name-directory
+ (nnimap-group-overview-filename group server)))
+ (file-writable-p
+ (nnimap-group-overview-filename group server)))
+ (message "nnimap: Nov cache not writable, %s"
+ (nnimap-group-overview-filename group server)))))
(deffoo nnimap-retrieve-headers (articles &optional group server fetch-old)
(when (nnimap-possibly-change-group group server)
(with-current-buffer nntp-server-buffer
(erase-buffer)
- (when (setq articles (nnimap-retrieve-which-headers articles fetch-old))
- (if (or gnus-nov-is-evil nnimap-nov-is-evil
- (unless (and (gnus-make-directory
- (file-name-directory
- (nnimap-group-overview-filename group server)))
- (file-writable-p
- (nnimap-group-overview-filename group server)))
- (message "nnimap: Nov cache not writable, %s"
- (nnimap-group-overview-filename group server))))
- (nnimap-retrieve-headers-from-server
- (gnus-compress-sequence articles) group server)
- (let (cached (low (car articles)) (high (car (last articles))))
- (if (setq cached (nnimap-retrieve-headers-from-file group server))
- (progn
- ;; fetch articles before cache block
+ (if (nnimap-use-nov-p group server)
+ (nnimap-retrieve-headers-from-server
+ (gnus-compress-sequence articles) group server)
+ (let* ((uids (nnimap-retrieve-which-headers articles fetch-old))
+ cached (low (car uids)) (high (car (last uids))))
+ (if (setq cached (nnimap-retrieve-headers-from-file group server))
+ (progn
+ ;; fetch articles with uids before cache block
+ (when (< low (car cached))
(goto-char (point-min))
- (if (< low (car cached))
- (nnimap-retrieve-headers-from-server
- (cons low (1- (car cached))) group server))
- ;; fetch articles after cache block
+ (nnimap-retrieve-headers-from-server
+ (cons low (1- (car cached))) group server))
+ ;; fetch articles with uids after cache block
+ (when (> high (cdr cached))
(goto-char (point-max))
- (if (> high (cdr cached))
- (nnimap-retrieve-headers-from-server
- (cons (1+ (cdr cached)) high) group server)))
- ;; nothing cached, fetch whole range from server
- (nnimap-retrieve-headers-from-server (cons low high) group
- server))
- (when (buffer-modified-p)
- (nnmail-write-region
- 1 (point-max) (nnimap-group-overview-filename group server)
- nil 'nomesg))
- (nnheader-nov-delete-outside-range low high))))
+ (nnimap-retrieve-headers-from-server
+ (cons (1+ (cdr cached)) high) group server))
+ (when nnimap-prune-cache
+ ;; 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)))))
+ ;; nothing cached, fetch whole range from server
+ (nnimap-retrieve-headers-from-server (cons low high) group server))
+ (when (buffer-modified-p)
+ (nnmail-write-region 1 (point-max)
+ (nnimap-group-overview-filename group server)
+ nil 'nomesg))
+ (nnheader-nov-delete-outside-range low high)))
'nov)))
(defun nnimap-open-connection (server)
@@ -493,7 +523,7 @@
(let (list alist user passwd)
(and (fboundp 'gnus-parse-netrc)
(setq list (gnus-parse-netrc nnimap-authinfo-file)
- alist (or (and (gnus-netrc-get
+ alist (or (and (gnus-netrc-get
(gnus-netrc-machine list server) "machine")
(gnus-netrc-machine list server))
(gnus-netrc-machine list nnimap-address))
@@ -546,7 +576,7 @@
(kill-buffer (nnimap-get-server-buffer server))
(setq nnimap-server-buffer nil
nnimap-current-server nil
- nnimap-server-buffer-alist
+ nnimap-server-buffer-alist
(delq server nnimap-server-buffer-alist)))
(nnoo-close-server 'nnimap server)))
@@ -582,7 +612,7 @@
nnimap-server-buffer))))
(when article
(gnus-message 9 "nnimap: Fetching (part of) article %d..." article)
- (insert (nnimap-demule
+ (insert (nnimap-demule
(or (imap-fetch article part prop nil nnimap-server-buffer)
"")))
(nnheader-ms-strip-cr)
@@ -594,11 +624,11 @@
(cons group article)))))
(deffoo nnimap-request-article (article &optional group server to-buffer)
- (nnimap-request-article-part
+ (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
+ (nnimap-request-article-part
article "RFC822.HEADER" 'RFC822.HEADER group server to-buffer))
(deffoo nnimap-request-body (article &optional group server to-buffer)
@@ -608,31 +638,30 @@
(deffoo nnimap-request-group (group &optional server fast)
(nnimap-request-update-info-internal
group
- (gnus-get-info (gnus-group-prefixed-name
+ (gnus-get-info (gnus-group-prefixed-name
group (gnus-server-to-method (format "nnimap:%s" server))))
server)
(when (nnimap-possibly-change-group group server)
- (with-current-buffer nnimap-server-buffer
- (let (info)
- (cond (fast group)
- ((null (setq info (nnimap-find-minmax-uid group)))
- (nnheader-report 'nnimap "Could not get active info for %s"
- group))
- (t
- (nnheader-insert "211 %d %d %d %s\n" (or (nth 0 info) 0)
- (max 1 (or (nth 1 info) 1))
- (or (nth 2 info) 0) group)
- (nnheader-report 'nnimap "Group %s selected" group)
- t))))))
+ (let (info)
+ (cond (fast group)
+ ((null (setq info (nnimap-find-minmax-uid group t)))
+ (nnheader-report 'nnimap "Could not get active info for %s"
+ group))
+ (t
+ (nnheader-insert "211 %d %d %d %s\n" (or (nth 0 info) 0)
+ (max 1 (or (nth 1 info) 1))
+ (or (nth 2 info) 0) group)
+ (nnheader-report 'nnimap "Group %s selected" group)
+ t)))))
-(defun nnimap-expunge-close-group (&optional server)
+(defun nnimap-close-group (group &optional server)
(with-current-buffer nnimap-server-buffer
- (when (nnimap-possibly-change-server server)
+ (when (nnimap-possibly-change-group group server)
(case nnimap-expunge-on-close
('always (imap-mailbox-expunge)
(imap-mailbox-close))
('ask (if (and (imap-search "DELETED")
- (gnus-y-or-n-p (format
+ (gnus-y-or-n-p (format
"Expunge articles in group `%s'? "
imap-current-mailbox)))
(progn (imap-mailbox-expunge)
@@ -641,9 +670,6 @@
(t (imap-mailbox-unselect)))
(not imap-current-mailbox))))
-(deffoo nnimap-close-group (group &optional server)
- (nnimap-expunge-close-group server))
-
(defun nnimap-pattern-to-list-arguments (pattern)
(mapcar (lambda (p)
(cons (car-safe p) (or (cdr-safe p) p)))
@@ -655,24 +681,24 @@
(deffoo nnimap-request-list (&optional server)
(when (nnimap-possibly-change-server server)
(with-current-buffer nntp-server-buffer
- (gnus-message 5 "nnimap: Generating active list%s..."
- (if (> (length server) 0) (concat " for " server) ""))
- (erase-buffer)
- (dolist (pattern (nnimap-pattern-to-list-arguments
- nnimap-list-pattern))
- (dolist (mbx (imap-mailbox-list
- nnimap-server-buffer (cdr pattern) t (car pattern)))
- (or (member "\\NoSelect"
- (imap-mailbox-get 'list-flags mbx nnimap-server-buffer))
+ (erase-buffer))
+ (gnus-message 5 "nnimap: Generating active list%s..."
+ (if (> (length server) 0) (concat " for " server) ""))
+ (with-current-buffer nnimap-server-buffer
+ (dolist (pattern (nnimap-pattern-to-list-arguments nnimap-list-pattern))
+ (dolist (mbx (funcall nnimap-request-list-method
+ nil (cdr pattern) t (car pattern)))
+ (or (member "\\NoSelect" (imap-mailbox-get 'list-flags mbx))
(let ((info (nnimap-find-minmax-uid mbx 'examine)))
(when info
;; Escape SPC in mailboxes xxx relies on gnus internals
- (insert (format "%s %d %d y\n"
- (nnimap-replace-in-string mbx " " "\\ ")
- (or (nth 2 info) 0)
- (max 1 (or (nth 1 info) 1)))))))))
- (gnus-message 5 "nnimap: Generating active list%s...done"
- (if server (concat " for " server) "")))
+ (with-current-buffer nntp-server-buffer
+ (insert (format "%s %d %d y\n"
+ (nnimap-replace-in-string mbx " " "\\ ")
+ (or (nth 2 info) 0)
+ (max 1 (or (nth 1 info) 1)))))))))))
+ (gnus-message 5 "nnimap: Generating active list%s...done"
+ (if server (concat " for " server) ""))
t))
(deffoo nnimap-request-post (&optional server)
@@ -702,7 +728,7 @@
(erase-buffer)
(dolist (group groups)
(gnus-message 7 "nnimap: Checking mailbox %s" group)
- (or (member "\\NoSelect"
+ (or (member "\\NoSelect"
(imap-mailbox-get 'list-flags group nnimap-server-buffer))
(let ((info (nnimap-find-minmax-uid group 'examine)))
;; Escape SPC in mailboxes xxx relies on gnus internals
@@ -721,7 +747,7 @@
(gnus-info-group info))
(when (nnimap-mark-permanent-p 'read)
- (gnus-info-set-read
+ (gnus-info-set-read
info
(let (seen unseen)
;; read info could contain articles marked unread by other
@@ -759,7 +785,7 @@
(gnus-message 5 "nnimap: Updating info for %s...done"
(gnus-info-group info))
-
+
info))))
(deffoo nnimap-request-type (group &optional article)
@@ -794,19 +820,18 @@
(nnimap-range-to-string range)
(nnimap-mark-to-flag marks nil t)))
((eq what 'add)
- (imap-message-flags-add
+ (imap-message-flags-add
(nnimap-range-to-string range)
(nnimap-mark-to-flag marks nil t)))
((eq what 'set)
(imap-message-flags-set
(nnimap-range-to-string range)
(nnimap-mark-to-flag marks nil t)))))))
- (gnus-message 7 "nnimap: Setting marks in %s...done"
- (nnoo-current-server 'nnimap) group))))
+ (gnus-message 7 "nnimap: Setting marks in %s...done" group))))
nil)
(defun nnimap-split-to-groups (rules)
- ;; tries to match all rules in nnimap-split-rule against content of
+ ;; tries to match all rules in nnimap-split-rule against content of
;; nntp-server-buffer, returns a list of groups that matched.
(with-current-buffer nntp-server-buffer
;; Fold continuation lines.
@@ -872,7 +897,8 @@
"\\Seen \\Deleted")))))
(when (imap-mailbox-select inbox) ;; just in case
;; todo: UID EXPUNGE (if available) to remove splitted articles
- (nnimap-expunge-close-group)))
+ (imap-mailbox-expunge)
+ (imap-mailbox-close)))
t))))
(deffoo nnimap-request-scan (&optional group server)
@@ -884,15 +910,15 @@
(gnus-message 5 "nnimap: Listing subscribed mailboxes%s%s..."
(if (> (length server) 0) " on " "") server)
(erase-buffer)
- (dolist (pattern (nnimap-pattern-to-list-arguments
+ (dolist (pattern (nnimap-pattern-to-list-arguments
nnimap-list-pattern))
- (dolist (mbx (imap-mailbox-lsub nnimap-server-buffer (car pattern)))
- (or (member "\\NoSelect"
+ (dolist (mbx (imap-mailbox-lsub nnimap-server-buffer "*" t (car pattern)))
+ (or (member "\\NoSelect"
(imap-mailbox-get 'list-flags mbx nnimap-server-buffer))
;; Escape SPC in mailboxes xxx relies on gnus internals
(let ((info (nnimap-find-minmax-uid mbx 'examine)))
(when info
- (insert (format "%s %d %d y\n"
+ (insert (format "%s %d %d y\n"
(nnimap-replace-in-string mbx " " "\\ ")
(or (nth 2 info) 0)
(max 1 (or (nth 1 info) 1)))))))))
@@ -915,7 +941,7 @@
(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"
+ (let ((date (format-time-string "%d-%b-%Y"
(nnimap-time-substract
(current-time)
(days-to-time daysago)))))
@@ -924,7 +950,7 @@
date)))
(defun nnimap-request-expire-articles-progress ()
- (gnus-message 5 "nnimap: Marking article %d for deletion..."
+ (gnus-message 5 "nnimap: Marking article %d for deletion..."
imap-current-message))
;; Notice that we don't actually delete anything, we just mark them deleted.
@@ -933,14 +959,14 @@
(when (and artseq (nnimap-possibly-change-group group server))
(with-current-buffer nnimap-server-buffer
(if force
- (and (imap-message-flags-add
+ (and (imap-message-flags-add
(nnimap-range-to-string 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
+ (and (imap-message-flags-add
(nnimap-range-to-string artseq) "\\Deleted")
(setq articles nil)))
((numberp days)
@@ -948,11 +974,11 @@
(format "UID %s NOT SINCE %s"
(nnimap-range-to-string artseq)
(nnimap-date-days-ago days))))
- (imap-fetch-data-hook
+ (imap-fetch-data-hook
'(nnimap-request-expire-articles-progress)))
(and oldarts
(imap-message-flags-add
- (nnimap-range-to-string
+ (nnimap-range-to-string
(gnus-compress-sequence oldarts))
"\\Deleted")
(setq articles (gnus-set-difference
@@ -1004,10 +1030,12 @@
(deffoo nnimap-request-delete-group (group force &optional server)
(when (nnimap-possibly-change-server server)
- (if force
- (imap-mailbox-delete group nnimap-server-buffer)
- ;; UNSUBSCRIBE?
- t)))
+ (with-current-buffer nnimap-server-buffer
+ (if force
+ (or (null (imap-mailbox-status group 'uidvalidity))
+ (imap-mailbox-delete group))
+ ;; UNSUBSCRIBE?
+ t))))
(deffoo nnimap-request-rename-group (group new-name &optional server)
(when (nnimap-possibly-change-server server)
@@ -1043,7 +1071,7 @@
(when (nnimap-possibly-change-server (cadr method))
(unless (imap-capability 'ACL nnimap-server-buffer)
(error "Your server does not support ACL editing"))
- (gnus-edit-form (setq acl (imap-mailbox-acl-get mailbox
+ (gnus-edit-form (setq acl (imap-mailbox-acl-get mailbox
nnimap-server-buffer))
(format "Editing the access control list for `%s'.
@@ -1069,8 +1097,8 @@
hierarchy)
d - delete (STORE DELETED flag, perform EXPUNGE)
a - administer (perform SETACL)" group)
- `(lambda (form)
- (gnus-group-nnimap-edit-acl-done
+ `(lambda (form)
+ (gnus-group-nnimap-edit-acl-done
,mailbox ',method ',acl form))))))
(defun gnus-group-nnimap-edit-acl-done (mailbox method old-acls new-acls)
@@ -1080,7 +1108,7 @@
(mapcar (lambda (old-acl)
(unless (assoc (car old-acl) new-acls)
(or (imap-mailbox-acl-delete (car old-acl) mailbox)
- (error "Can't delete ACL for %s..." (car old-acl)))))
+ (error "Can't delete ACL for %s" (car old-acl)))))
old-acls)
;; set all changed acl's
(mapcar (lambda (new-acl)
@@ -1089,7 +1117,7 @@
(unless (and old-rights new-rights
(string= old-rights new-rights))
(or (imap-mailbox-acl-set (car new-acl) new-rights mailbox)
- (error "Can't set ACL for %s to %s..." (car new-acl)
+ (error "Can't set ACL for %s to %s" (car new-acl)
new-rights)))))
new-acls)
t)))
@@ -1120,7 +1148,7 @@
;;
(defconst nnimap-mark-to-predicate-alist
- (mapcar
+ (mapcar
(lambda (pair) ; cdr is the mark
(or (assoc (cdr pair)
'((read . "SEEN")
@@ -1137,8 +1165,8 @@
gnus-expire\") to be used within a IMAP SEARCH query."
(cdr (assq pred nnimap-mark-to-predicate-alist)))
-(defconst nnimap-mark-to-flag-alist
- (mapcar
+(defconst nnimap-mark-to-flag-alist
+ (mapcar
(lambda (pair)
(or (assoc (cdr pair)
'((read . "\\Seen")
@@ -1190,7 +1218,7 @@
alist)))
(defun nnimap-update-alist-soft (key value alist)
- (if value
+ (if value
(cons (cons key value) (nnimap-remassoc key alist))
(nnimap-remassoc key alist)))
@@ -1198,7 +1226,7 @@
(mapconcat
(lambda (item)
(if (consp item)
- (format "%d:%d"
+ (format "%d:%d"
(car item) (cdr item))
(format "%d" item)))
(if (and (listp range) (not (listp (cdr range))))
@@ -1218,7 +1246,7 @@
nnimap-possibly-change-group
;nnimap-replace-whitespace
nnimap-retrieve-headers-progress
-nnimap-retrieve-headers-get-range
+nnimap-retrieve-which-headers
nnimap-group-overview-filename
nnimap-retrieve-headers-from-file
nnimap-retrieve-headers-from-server
@@ -1235,7 +1263,6 @@
nnimap-request-head
nnimap-request-body
nnimap-request-group
-nnimap-expunge-close-group
nnimap-close-group
nnimap-pattern-to-list-arguments
nnimap-request-list