;;; nnimap.el --- imap backend for Gnus
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004
;; Free Software Foundation, Inc.
;; Author: Simon Josefsson <jas@pdc.kth.se>
;;; Code:
(eval-when-compile (require 'cl))
-(eval-when-compile (require 'gnus-clfns))
(require 'imap)
(require 'nnoo)
(string :format "Login: %v"))
(cons :format "%v"
(const :format "" "password")
- (string :format "Password: %v")))))))
+ (string :format "Password: %v"))))))
+ :group 'nnimap)
(defcustom nnimap-prune-cache t
"If non-nil, nnimap check whether articles still exist on server before using data stored in NOV cache."
- :type 'boolean)
+ :type 'boolean
+ :group 'nnimap)
(defvar nnimap-request-list-method 'imap-mailbox-list
"Method to use to request a list of all folders from the server.
(with-temp-buffer
(buffer-disable-undo)
(insert headers)
- (let ((head (nnheader-parse-naked-head)))
+ (let ((head (nnheader-parse-naked-head uid)))
(mail-header-set-number head uid)
(mail-header-set-chars head chars)
(mail-header-set-lines head lines)
(imap-capability 'IMAP4rev1 nnimap-server-buffer))
(imap-close nnimap-server-buffer)
(nnheader-report 'nnimap "Server %s is not IMAP4 compliant" server))
- (let* ((list (gnus-parse-netrc nnimap-authinfo-file))
+ (let* ((list (netrc-parse nnimap-authinfo-file))
(port (if nnimap-server-port
(int-to-string nnimap-server-port)
"imap"))
- (alist (or (gnus-netrc-machine list server port "imap")
- (gnus-netrc-machine list
- (or nnimap-server-address
- nnimap-address)
- port "imap")))
- (user (gnus-netrc-get alist "login"))
- (passwd (gnus-netrc-get alist "password")))
+ (alist (or (netrc-machine list server port "imap")
+ (netrc-machine list
+ (or nnimap-server-address
+ nnimap-address)
+ port "imap")
+ (netrc-machine list server port "imaps")
+ (netrc-machine list
+ (or nnimap-server-address
+ nnimap-address)
+ port "imaps")))
+ (user (netrc-get alist "login"))
+ (passwd (netrc-get alist "password")))
(if (imap-authenticate user passwd nnimap-server-buffer)
(prog1
(push (list server nnimap-server-buffer)
All buffers that have been created by that
backend should be killed. (Not the nntp-server-buffer, though.) This
function is generally only called when Gnus is shutting down."
- (mapcar (lambda (server) (nnimap-close-server (car server)))
- nnimap-server-buffer-alist)
+ (mapc (lambda (server) (nnimap-close-server (car server)))
+ nnimap-server-buffer-alist)
(setq nnimap-server-buffer-alist nil))
(deffoo nnimap-status-message (&optional server)
(nnoo-status-message 'nnimap server)))
(defun nnimap-demule (string)
- (funcall (if (and (fboundp 'string-as-multibyte)
- (subrp (symbol-function 'string-as-multibyte)))
- 'string-as-multibyte
+ ;; BEWARE: we used to use string-as-multibyte here which is braindead
+ ;; because it will turn accidental emacs-mule-valid byte sequences
+ ;; into multibyte chars. --Stef
+ (funcall (if (and (fboundp 'string-to-multibyte)
+ (subrp (symbol-function 'string-to-multibyte)))
+ 'string-to-multibyte
'identity)
(or string "")))
(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
- (nnimap-mark-to-flag mark))
- (setq marks (cons mark marks))))
- cmdmarks)
+ (mapc (lambda (mark)
+ (if (imap-message-flag-permanent-p
+ (nnimap-mark-to-flag mark))
+ (setq marks (cons mark marks))))
+ cmdmarks)
(when (and range marks)
(cond ((eq what 'del)
(imap-message-flags-del
(error "Your server does not support ACL editing"))
(with-current-buffer nnimap-server-buffer
;; delete all removed identifiers
- (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)))))
- old-acls)
+ (mapc (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)))))
+ old-acls)
;; set all changed acl's
- (mapcar (lambda (new-acl)
- (let ((new-rights (cdr new-acl))
- (old-rights (cdr (assoc (car new-acl) old-acls))))
- (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)
- new-rights)))))
- new-acls)
+ (mapc (lambda (new-acl)
+ (let ((new-rights (cdr new-acl))
+ (old-rights (cdr (assoc (car new-acl) old-acls))))
+ (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)
+ new-rights)))))
+ new-acls)
t)))
\f