X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fnnimap.el;h=944c81431ca5444f5fb30fccba32b76a07cff7aa;hb=cf85cd945add46ce6477643a1f9c4f413723eb41;hp=7001a0d5b923397a73731c9db194dc6d821c0b12;hpb=04ba5250e9e47ebe40860a0902d4ef6405ca143f;p=elisp%2Fgnus.git- diff --git a/lisp/nnimap.el b/lisp/nnimap.el index 7001a0d..944c814 100644 --- a/lisp/nnimap.el +++ b/lisp/nnimap.el @@ -1,5 +1,5 @@ ;;; 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 @@ -61,7 +61,6 @@ ;;; Code: (eval-when-compile (require 'cl)) -(eval-when-compile (require 'gnus-clfns)) (require 'imap) (require 'nnoo) @@ -393,17 +392,56 @@ just like \"ticked\" articles, in other IMAP clients.") (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. If this is 'imap-mailbox-lsub, then use a server-side subscription list to restrict visible folders.") +(defcustom nnimap-id nil + "Plist with client identity to send to server upon login. +Nil means no information is sent, symbol `no' to disable ID query +alltogheter, or plist with identifier-value pairs to send to +server. RFC 2971 describes the list as follows: + + Any string may be sent as a field, but the following are defined to + describe certain values that might be sent. Implementations are free + to send none, any, or all of these. Strings are not case-sensitive. + Field strings MUST NOT be longer than 30 octets. Value strings MUST + NOT be longer than 1024 octets. Implementations MUST NOT send more + than 30 field-value pairs. + + name Name of the program + version Version number of the program + os Name of the operating system + os-version Version of the operating system + vendor Vendor of the client/server + support-url URL to contact for support + address Postal address of contact/vendor + date Date program was released, specified as a date-time + in IMAP4rev1 + command Command used to start the program + arguments Arguments supplied on the command line, if any + if any + environment Description of environment, i.e., UNIX environment + variables or Windows registry settings + + Implementations MUST NOT send the same field name more than once. + +An example plist would be '(\"name\" \"Gnus\" \"version\" gnus-version-number +\"os\" system-configuration \"vendor\" \"GNU\")." + :group 'nnimap + :type '(choice (const :tag "No information" nil) + (const :tag "Disable ID query" no) + (plist :key-type string :value-type string))) + (defcustom nnimap-debug nil "If non-nil, random debug spews are placed in *nnimap-debug* buffer." :group 'nnimap @@ -552,7 +590,7 @@ If EXAMINE is non-nil the group is selected read-only." (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) @@ -718,21 +756,27 @@ If EXAMINE is non-nil the group is selected read-only." (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) nnimap-server-buffer-alist) + (imap-id nnimap-id nnimap-server-buffer) (nnimap-possibly-change-server server)) (imap-close nnimap-server-buffer) (kill-buffer nnimap-server-buffer) @@ -794,8 +838,8 @@ Return nil if the server couldn't be closed for some reason." 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) @@ -804,9 +848,12 @@ function is generally only called when Gnus is shutting down." (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 ""))) @@ -1181,11 +1228,11 @@ function is generally only called when Gnus is shutting down." (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 @@ -1514,21 +1561,21 @@ function is generally only called when Gnus is shutting down." (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)))