;; .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)
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."
(with-current-buffer nnimap-server-buffer
(setq uid imap-current-message
mbx imap-current-mailbox
- headers (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))
+ 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
(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
(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))))
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)
(nth 2 (car data))
data))))
(nnheader-ms-strip-cr)
- (gnus-message 9 "nnimap: Fetching (part of) article %d...done"
+ (gnus-message 10 "nnimap: Fetching (part of) article %d...done"
article)
(if (bobp)
(nnheader-report 'nnimap "No such article: %s"
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
(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"
(gnus-info-marks info))
t)))
gnus-article-mark-lists)
+
+ ;; 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))
(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"
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")))
;; this 'or' is for Cyrus server bug
(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))
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
projects / gnus / blobdiff