;;; nnimap.el --- imap backend for Gnus
-;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
-;; Author: Simon Josefsson <jas@pdc.kth.se>
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
+;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+
+;; Author: Simon Josefsson <simon@josefsson.org>
;; Jim Radford <radford@robby.caltech.edu>
;; Keywords: mail
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; o Split up big fetches (1,* header especially) in smaller chunks
;; o What do I do with gnus-newsgroup-*?
;; o Tell Gnus about new groups (how can we tell?)
-;; o Respooling (fix Gnus?) (unnecessery?)
+;; o Respooling (fix Gnus?) (unnecessary?)
;; o Add support for the following: (if applicable)
;; request-list-newsgroups, request-regenerate
;; list-active-group,
;;; Code:
+;; For Emacs < 22.2.
+(eval-and-compile
+ (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
+
(require 'imap)
(require 'nnoo)
(require 'nnmail)
(require 'gnus-start)
(require 'gnus-int)
+(eval-when-compile (require 'cl))
+
+(autoload 'auth-source-user-or-password "auth-source")
+
(nnoo-declare nnimap)
(defconst nnimap-version "nnimap 1.0")
(defvoo nnimap-server-port nil
"Port number on physical IMAP server.
-If nil, defaults to 993 for SSL connections and 143 otherwise.")
+If nil, defaults to 993 for TLS/SSL connections and 143 otherwise.")
;; Splitting variables
(functionp value))
(defcustom nnimap-split-rule nil
- "Mail will be split according to theese rules.
+ "Mail will be split according to these rules.
Mail is read from mailbox(es) specified in `nnimap-split-inbox'.
before, either a function, or a list with group/regexp or
group/function elements."
:group 'nnimap
+ ;; FIXME: Doesn't allow `("my2server" ("INBOX" nnimap-split-fancy))'
+ ;; per example above. -- fx
:type '(choice :tag "Rule type"
(repeat :menu-tag "Single-server"
:tag "Single-server list"
:type 'string)
(defcustom nnimap-split-fancy nil
- "Like the variable `nnmail-split-fancy', which see."
+ "Like the variable `nnmail-split-fancy'."
:group 'nnimap
:type 'sexp)
+(defvar nnimap-split-download-body-default nil
+ "Internal variable with default value for `nnimap-split-download-body'.")
+
+(defcustom nnimap-split-download-body 'default
+ "Whether to download entire articles during splitting.
+This is generally not required, and will slow things down considerably.
+You may need it if you want to use an advanced splitting function that
+analyzes the body before splitting the article.
+If this variable is nil, bodies will not be downloaded; if this
+variable is the symbol `default' the default behavior is
+used (which currently is nil, unless you use a statistical
+spam.el test); if this variable is another non-nil value bodies
+will be downloaded."
+ :version "22.1"
+ :group 'nnimap
+ :type '(choice (const :tag "Let system decide" deault)
+ boolean))
+
;; Performance / bug workaround variables
(defcustom nnimap-close-asynchronous t
"Close mailboxes asynchronously in `nnimap-close-group'.
-This means that errors cought by nnimap when closing the mailbox will
+This means that errors caught by nnimap when closing the mailbox will
not prevent Gnus from updating the group status, which may be harmful.
However, it increases speed."
+ :version "22.1"
:type 'boolean
:group 'nnimap)
This increases the speed of closing mailboxes (quiting group) but may
decrease the speed of selecting another mailbox later. Re-selecting
the same mailbox will be faster though."
+ :version "22.1"
:type 'boolean
:group 'nnimap)
In summary, the default is O((1-p)*k+p*n) and changing it to nil makes
it O(n). If p is small, then the default is probably faster."
+ :version "22.1"
:type 'boolean
:group 'nnimap)
-(defvoo nnimap-need-unselect-to-notice-new-mail nil
+(defvoo nnimap-need-unselect-to-notice-new-mail t
"Unselect mailboxes before looking for new mail in them.
Some servers seem to need this under some circumstances.")
+(defvoo nnimap-logout-timeout nil
+ "Close server immediately if it can't logout in this number of seconds.
+If it is nil, never close server until logout completes. This variable
+overrides `imap-logout-timeout' on a per-server basis.")
+
;; Authorization / Privacy variables
(defvoo nnimap-auth-method nil
Change this if
-1) you want to connect with SSL. The SSL integration with IMAP is
- brain-dead so you'll have to tell it specifically.
+1) you want to connect with TLS/SSL. The TLS/SSL integration
+ with IMAP is suboptimal so you'll have to tell it
+ specifically.
2) your server is more capable than your environment -- i.e. your
server accept Kerberos login's but you haven't installed the
`imtest' program or your machine isn't configured for Kerberos.
-Possible choices: kerberos4, ssl, network")
+Possible choices: gssapi, kerberos4, starttls, tls, ssl, network, shell.
+See also `imap-streams' and `imap-stream-alist'.")
(defvoo nnimap-authenticator nil
"How nnimap authenticate itself to the server.
installed the `imtest' program or your machine isn't configured for
Kerberos.
-Possible choices: kerberos4, cram-md5, login, anonymous.")
+Possible choices: gssapi, kerberos4, digest-md5, cram-md5, login, anonymous.
+See also `imap-authenticators' and `imap-authenticator-alist'")
(defvoo nnimap-directory (nnheader-concat gnus-directory "overview/")
"Directory to keep NOV cache files for nnimap groups.
Unlike other backends, you do not need to take special care if you
flip this variable.")
+(defvoo nnimap-search-uids-not-since-is-evil nil
+ "If non-nil, avoid \"UID SEARCH UID ... NOT SINCE\" queries when expiring.
+Instead, use \"UID SEARCH SINCE\" to prune the list of expirable
+articles within Gnus. This seems to be faster on Courier in some cases.")
+
(defvoo nnimap-expunge-on-close 'always ; 'ask, 'never
"Whether to expunge a group when it is closed.
When a IMAP group with articles marked for deletion is closed, this
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.")
+2060 for more information on valid strings.
+
+However, if `nnimap-search-uids-not-since-is-evil' is true, this
+variable has no effect since the search logic is reversed.")
(defvoo nnimap-importantize-dormant t
"If non-nil, mark \"dormant\" articles as \"ticked\" for 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.
+A nil value means no information is sent, symbol `no' to disable ID query
+altogether, 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, trace nnimap- functions into `nnimap-debug-buffer'.
+Uses `trace-function-background', so you can turn it off with,
+say, `untrace-all'.
+
+Note that username, passwords and other privacy sensitive
+information (such as e-mail) may be stored in the buffer.
+It is not written to disk, however. Do not enable this
+variable unless you are comfortable with that.
+
+This variable only takes effect when loading the `nnimap' library.
+See also `nnimap-log'."
+ :group 'nnimap
+ :type 'boolean)
+
;; Internal variables:
+(defvar nnimap-debug-buffer "*nnimap-debug*")
(defvar nnimap-mailbox-info (gnus-make-hashtable 997))
-(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)
(defvar nnimap-progress-chars '(?| ?/ ?- ?\\))
(defvar nnimap-progress-how-often 20)
(defvar nnimap-counter)
-(defvar nnimap-callback-callback-function nil
- "Gnus callback the nnimap asynchronous callback should call.")
-(defvar nnimap-callback-buffer nil
- "Which buffer the asynchronous article prefetch callback should work in.")
(defvar nnimap-server-buffer-alist nil) ;; Map server name to buffers.
(defvar nnimap-current-server nil) ;; Current server
(defvar nnimap-server-buffer nil) ;; Current servers' buffer
;; Utility functions:
+(defsubst nnimap-decode-group-name (group)
+ (and group
+ (gnus-group-decoded-name group)))
+
+(defsubst nnimap-encode-group-name (group)
+ (and group
+ (mm-encode-coding-string group (gnus-group-name-charset nil group))))
+
+(defun nnimap-group-prefixed-name (group &optional server)
+ (gnus-group-prefixed-name group
+ (gnus-server-to-method
+ (format "nnimap:%s"
+ (or server nnimap-current-server)))))
+
(defsubst nnimap-get-server-buffer (server)
"Return buffer for SERVER, if nil use current server."
(cadr (assoc (or server nnimap-current-server) nnimap-server-buffer-alist)))
+(defun nnimap-remove-server-from-buffer-alist (server list)
+ "Remove SERVER from LIST."
+ (let (l)
+ (dolist (e list)
+ (unless (equal server (car-safe e))
+ (push e l)))
+ l))
+
(defun nnimap-possibly-change-server (server)
"Return buffer for SERVER, changing the current server as a side-effect.
If SERVER is nil, uses the current server."
(defun nnimap-verify-uidvalidity (group server)
"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))))
+ (let* ((gnusgroup (nnimap-group-prefixed-name group server))
(new-uidvalidity (imap-mailbox-get 'uidvalidity))
(old-uidvalidity (gnus-group-get-parameter gnusgroup 'uidvalidity))
(dir (file-name-as-directory (expand-file-name nnimap-directory)))
(if old-uidvalidity
(if (not (equal old-uidvalidity new-uidvalidity))
;; uidvalidity clash
- (gnus-delete-file file)
- (gnus-group-set-parameter gnusgroup 'uidvalidity new-uidvalidity)
+ (progn
+ (gnus-group-set-parameter gnusgroup 'uidvalidity new-uidvalidity)
+ (gnus-group-remove-parameter gnusgroup 'imap-status)
+ (gnus-sethash (gnus-group-prefixed-name group server)
+ nil nnimap-mailbox-info)
+ (gnus-delete-file file))
t)
(gnus-group-add-parameter gnusgroup (cons 'uidvalidity new-uidvalidity))
+ (gnus-group-remove-parameter gnusgroup 'imap-status)
+ (gnus-sethash ; Maybe not necessary here.
+ (gnus-group-prefixed-name group server)
+ nil nnimap-mailbox-info)
t)))
(defun nnimap-before-find-minmax-bugworkaround ()
(imap-mailbox-unselect nnimap-server-buffer))))
(defun nnimap-find-minmax-uid (group &optional examine)
- "Find lowest and highest active article nummber in GROUP.
+ "Find lowest and highest active article number in GROUP.
If EXAMINE is non-nil the group is selected read-only."
(with-current-buffer nnimap-server-buffer
- (when (or (string= group (imap-current-mailbox))
- (imap-mailbox-select group examine))
- (let (minuid maxuid)
- (when (> (imap-mailbox-get 'exists) 0)
- (imap-fetch "1,*" "UID" nil 'nouidfetch)
- (imap-message-map (lambda (uid Uid)
- (setq minuid (if minuid (min minuid uid) uid)
- maxuid (if maxuid (max maxuid uid) uid)))
- 'UID))
- (list (imap-mailbox-get 'exists) minuid maxuid)))))
+ (let ((decoded-group (nnimap-decode-group-name group)))
+ (when (or (string= decoded-group (imap-current-mailbox))
+ (imap-mailbox-select decoded-group examine))
+ (let (minuid maxuid)
+ (when (> (imap-mailbox-get 'exists) 0)
+ (imap-fetch-safe '("1,*" . "1,*:*") "UID" nil 'nouidfetch)
+ (imap-message-map (lambda (uid Uid)
+ (setq minuid (if minuid (min minuid uid) uid)
+ maxuid (if maxuid (max maxuid uid) uid)))
+ 'UID))
+ (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 (or (null group) (imap-current-mailbox-p group))
- imap-current-mailbox
- (if (imap-mailbox-select group)
- (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))
- (nnheader-report 'nnimap (imap-error-text)))))))
+ (let ((decoded-group (nnimap-decode-group-name group)))
+ (with-current-buffer nnimap-server-buffer
+ (if (or (null group) (imap-current-mailbox-p decoded-group))
+ imap-current-mailbox ; Note: utf-7 encoded.
+ (if (imap-mailbox-select decoded-group)
+ (if (or (nnimap-verify-uidvalidity
+ group (or server nnimap-current-server))
+ (zerop (imap-mailbox-get 'exists decoded-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? "
+ decoded-group)))
+ imap-current-mailbox ; Note: utf-7 encoded.
+ (imap-mailbox-unselect)
+ (error "nnimap: Group %s is not uid-valid" decoded-group))
+ (nnheader-report 'nnimap (imap-error-text))))))))
(defun nnimap-replace-whitespace (string)
"Return STRING with all whitespace replaced with space."
(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)))
+ mbx (nnimap-encode-group-name (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))
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
+ ;; At this stage, we only have bytes, so let's use unibyte buffers
+ ;; to make it more clear.
+ (mm-with-unibyte-buffer
(buffer-disable-undo)
- (insert headers)
- (let ((head (nnheader-parse-naked-head)))
+ ;; headers can be nil if article is write-only
+ (when headers (insert headers))
+ (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)
articles))))
(defun nnimap-group-overview-filename (group server)
- "Make pathname for GROUP on SERVER."
+ "Make file name for GROUP on SERVER."
(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)))
+ (nnimap-group-prefixed-name group server)
'uidvalidity))
(name (nnheader-translate-file-chars
(concat nnimap-nov-file-name
(if (imap-capability 'IMAP4rev1)
(format "BODY.PEEK[HEADER.FIELDS %s])" headers)
(format "RFC822.HEADER.LINES %s)" headers)))))
+ (with-current-buffer nntp-server-buffer
+ (sort-numeric-fields 1 (point-min) (point-max)))
(and (numberp nnmail-large-newsgroup)
(> nnimap-length nnmail-large-newsgroup)
(nnheader-message 6 "nnimap: Retrieving headers...done")))))
(nnheader-nov-delete-outside-range low high))))
'nov)))
+(declare-function netrc-parse "netrc" (file))
+(declare-function netrc-machine-user-or-password "netrc"
+ (mode authinfo-file-or-list machines ports defaults))
+
(defun nnimap-open-connection (server)
+ ;; Note: `nnimap-open-server' that calls this function binds
+ ;; `imap-logout-timeout' to `nnimap-logout-timeout'.
(if (not (imap-open nnimap-address nnimap-server-port nnimap-stream
nnimap-authenticator nnimap-server-buffer))
(nnheader-report 'nnimap "Can't open connection to server %s" server)
+ (require 'netrc)
(unless (or (imap-capability 'IMAP4 nnimap-server-buffer)
(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))
- (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")))
+ (let* ((list (progn (gnus-message 7 "Parsing authinfo file `%s'."
+ nnimap-authinfo-file)
+ (netrc-parse nnimap-authinfo-file)))
+ (port (if nnimap-server-port
+ (int-to-string nnimap-server-port)
+ "imap"))
+ (auth-info
+ (auth-source-user-or-password '("login" "password") server port))
+ (auth-user (nth 0 auth-info))
+ (auth-passwd (nth 1 auth-info))
+ (user (or
+ auth-user ; this is preferred to netrc-*
+ (netrc-machine-user-or-password
+ "login"
+ list
+ (list server
+ (or nnimap-server-address
+ nnimap-address))
+ (list port)
+ (list "imap" "imaps" "143" "993"))))
+ (passwd (or
+ auth-passwd ; this is preferred to netrc-*
+ (netrc-machine-user-or-password
+ "password"
+ list
+ (list server
+ (or nnimap-server-address
+ nnimap-address))
+ (list port)
+ (list "imap" "imaps" "143" "993")))))
(if (imap-authenticate user passwd nnimap-server-buffer)
- (prog1
+ (prog2
+ (setq nnimap-server-buffer-alist
+ (nnimap-remove-server-from-buffer-alist
+ server
+ nnimap-server-buffer-alist))
(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)
(setq nnimap-server-buffer (cadr (assq 'nnimap-server-buffer 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)
- (if (with-current-buffer nnimap-server-buffer
- (memq imap-state '(auth select examine)))
- t
- (imap-close nnimap-server-buffer)
- (nnimap-open-connection server)))
- (nnimap-open-connection server))))
+ (let ((imap-logout-timeout nnimap-logout-timeout))
+ (or (and nnimap-server-buffer
+ (imap-opened nnimap-server-buffer)
+ (if (with-current-buffer nnimap-server-buffer
+ (memq imap-state '(auth selected examine)))
+ t
+ (imap-close nnimap-server-buffer)
+ (nnimap-open-connection server)))
+ (nnimap-open-connection server)))))
(deffoo nnimap-server-opened (&optional server)
"Whether SERVER is opened.
(deffoo nnimap-close-server (&optional server)
"Close connection to server and free all resources connected to it.
Return nil if the server couldn't be closed for some reason."
- (let ((server (or server nnimap-current-server)))
+ (let ((server (or server nnimap-current-server))
+ (imap-logout-timeout nnimap-logout-timeout))
(when (or (nnimap-server-opened server)
(imap-opened (nnimap-get-server-buffer server)))
(imap-close (nnimap-get-server-buffer server))
(setq nnimap-server-buffer nil
nnimap-current-server nil
nnimap-server-buffer-alist
- (delq server nnimap-server-buffer-alist)))
+ (nnimap-remove-server-from-buffer-alist
+ server
+ nnimap-server-buffer-alist)))
(nnoo-close-server 'nnimap server)))
(deffoo nnimap-request-close ()
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)
(when (nnimap-possibly-change-server 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
- 'identity)
- (or string "")))
-
-(defun nnimap-callback ()
- (remove-hook 'imap-fetch-data-hook 'nnimap-callback)
- (with-current-buffer nnimap-callback-buffer
- (insert
- (with-current-buffer nnimap-server-buffer
- (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)))
+;; We used to use a string-as-multibyte here, but it is really incorrect.
+;; This function is used when we're about to insert a unibyte string
+;; into a potentially multibyte buffer. The string is either an article
+;; header or body (or both?), undecoded. When Emacs is asked to convert
+;; a unibyte string to multibyte, it may either use the equivalent of
+;; nothing (e.g. non-Mule XEmacs), string-make-unibyte (i.e. decode using
+;; locale), string-as-multibyte (decode using emacs-internal coding system)
+;; or string-to-multibyte (keep the data undecoded as a sequence of bytes).
+;; Only the last one preserves the data such that we can reliably later on
+;; decode the text using the mime info.
+(defalias 'nnimap-demule 'mm-string-to-multibyte)
+
+(defun nnimap-make-callback (article gnus-callback buffer)
+ "Return a callback function."
+ `(lambda ()
+ (nnimap-callback ,article ,gnus-callback ,buffer)))
+
+(defun nnimap-callback (article gnus-callback buffer)
+ (when (eq article (imap-current-message))
+ (remove-hook 'imap-fetch-data-hook
+ (nnimap-make-callback article gnus-callback buffer))
+ (with-current-buffer buffer
+ (insert
+ (with-current-buffer nnimap-server-buffer
+ (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 article 'BODYDETAIL)))
+ (imap-message-get article 'RFC822)))))
+ (nnheader-ms-strip-cr)
+ (funcall gnus-callback t))))
(defun nnimap-request-article-part (article part prop &optional
group server to-buffer detail)
article)))
(when article
(gnus-message 10 "nnimap: Fetching (part of) article %d from %s..."
- article (or group imap-current-mailbox))
+ article (or (nnimap-decode-group-name group)
+ (imap-current-mailbox)
+ (nnimap-decode-group-name
+ gnus-newsgroup-name)))
(if (not nnheader-callback-function)
(with-current-buffer (or to-buffer nntp-server-buffer)
(erase-buffer)
(let ((data (imap-fetch article part prop nil
nnimap-server-buffer)))
- (insert (nnimap-demule (if detail
- (nth 2 (car data))
- data))))
+ ;; data can be nil if article is write-only
+ (when data
+ (insert (nnimap-demule (if detail
+ (nth 2 (car data))
+ data)))))
(nnheader-ms-strip-cr)
(gnus-message
10 "nnimap: Fetching (part of) article %d from %s...done"
- article (or group imap-current-mailbox))
+ article (or (nnimap-decode-group-name group)
+ (imap-current-mailbox)
+ (nnimap-decode-group-name gnus-newsgroup-name)))
(if (bobp)
(nnheader-report 'nnimap "No such article %d in %s: %s"
- article (or group imap-current-mailbox)
+ article (or (nnimap-decode-group-name group)
+ (imap-current-mailbox)
+ (nnimap-decode-group-name
+ gnus-newsgroup-name))
(imap-error-text nnimap-server-buffer))
(cons group article)))
- (add-hook 'imap-fetch-data-hook 'nnimap-callback)
- (setq nnimap-callback-callback-function nnheader-callback-function
- nnimap-callback-buffer nntp-server-buffer)
+ (add-hook 'imap-fetch-data-hook
+ (nnimap-make-callback article
+ nnheader-callback-function
+ nntp-server-buffer))
(imap-fetch-asynch article part nil nnimap-server-buffer)
(cons group article))))))
(deffoo nnimap-request-group (group &optional server fast)
(nnimap-request-update-info-internal
group
- (gnus-get-info (gnus-group-prefixed-name
- group (gnus-server-to-method (format "nnimap:%s" server))))
+ (gnus-get-info (nnimap-group-prefixed-name group server))
server)
(when (nnimap-possibly-change-group group server)
(nnimap-before-find-minmax-bugworkaround)
"Update the unseen count in `nnimap-mailbox-info'."
(gnus-sethash
(gnus-group-prefixed-name group server)
- (let ((old (gnus-gethash-safe (gnus-group-prefixed-name group server)
+ (let ((old (gnus-gethash-safe (gnus-group-prefixed-name group server)
nnimap-mailbox-info)))
(list (nth 0 old) (nth 1 old)
- (imap-mailbox-status group 'unseen nnimap-server-buffer)
- (nth 3 old)))
+ (imap-mailbox-status (nnimap-decode-group-name group)
+ 'unseen nnimap-server-buffer)))
nnimap-mailbox-info))
(defun nnimap-close-group (group &optional server)
(imap-mailbox-close nnimap-close-asynchronous))))
(ask (if (and (imap-search "DELETED")
(gnus-y-or-n-p (format "Expunge articles in group `%s'? "
- imap-current-mailbox)))
+ (imap-current-mailbox))))
(progn
(imap-mailbox-expunge nnimap-close-asynchronous)
(unless nnimap-dont-close
(dolist (mbx (funcall nnimap-request-list-method
(cdr pattern) (car pattern)))
(or (member "\\NoSelect" (imap-mailbox-get 'list-flags mbx))
- (let ((info (nnimap-find-minmax-uid mbx 'examine)))
+ (let* ((encoded-mbx (nnimap-encode-group-name mbx))
+ (info (nnimap-find-minmax-uid encoded-mbx 'examine)))
(when info
(with-current-buffer nntp-server-buffer
(insert (format "\"%s\" %d %d y\n"
- mbx (or (nth 2 info) 0)
+ encoded-mbx (or (nth 2 info) 0)
(max 1 (or (nth 1 info) 1)))))))))))
(gnus-message 5 "nnimap: Generating active list%s...done"
(if (> (length server) 0) (concat " for " server) ""))
(with-current-buffer nntp-server-buffer
(erase-buffer)
(nnimap-before-find-minmax-bugworkaround)
- (let (asyncgroups slowgroups)
+ (let (asyncgroups slowgroups decoded-group)
(if (null nnimap-retrieve-groups-asynchronous)
(setq slowgroups groups)
(dolist (group groups)
- (gnus-message 9 "nnimap: Quickly checking mailbox %s" group)
- (add-to-list (if (gnus-gethash-safe
- (gnus-group-prefixed-name group server)
- nnimap-mailbox-info)
+ (setq decoded-group (nnimap-decode-group-name group))
+ (gnus-message 9 "nnimap: Quickly checking mailbox %s"
+ decoded-group)
+ (add-to-list (if (gnus-group-get-parameter
+ (nnimap-group-prefixed-name group)
+ 'imap-status)
'asyncgroups
'slowgroups)
(list group (imap-mailbox-status-asynch
- group '(uidvalidity uidnext unseen)
+ decoded-group
+ '(uidvalidity uidnext unseen)
nnimap-server-buffer))))
(dolist (asyncgroup asyncgroups)
- (let ((group (nth 0 asyncgroup))
- (tag (nth 1 asyncgroup))
- new old)
+ (let* ((group (nth 0 asyncgroup))
+ (tag (nth 1 asyncgroup))
+ (gnusgroup (nnimap-group-prefixed-name group))
+ (saved-uidvalidity (gnus-group-get-parameter gnusgroup
+ 'uidvalidity))
+ (saved-imap-status (gnus-group-get-parameter gnusgroup
+ 'imap-status))
+ (saved-info (and saved-imap-status
+ (split-string saved-imap-status " "))))
+ (setq decoded-group (nnimap-decode-group-name group))
(when (imap-ok-p (imap-wait-for-tag tag nnimap-server-buffer))
- (if (or (not (string=
- (nth 0 (gnus-gethash (gnus-group-prefixed-name
- group server)
- nnimap-mailbox-info))
- (imap-mailbox-get 'uidvalidity group
+ (if (or (not (equal
+ saved-uidvalidity
+ (imap-mailbox-get 'uidvalidity decoded-group
nnimap-server-buffer)))
- (not (string=
- (nth 1 (gnus-gethash (gnus-group-prefixed-name
- group server)
- nnimap-mailbox-info))
- (imap-mailbox-get 'uidnext group
+ (not (equal
+ (nth 0 saved-info)
+ (imap-mailbox-get 'uidnext decoded-group
nnimap-server-buffer))))
(push (list group) slowgroups)
- (insert (nth 3 (gnus-gethash (gnus-group-prefixed-name
- group server)
- nnimap-mailbox-info))))))))
+ (gnus-sethash
+ (gnus-group-prefixed-name group server)
+ (list (imap-mailbox-get 'uidvalidity
+ decoded-group nnimap-server-buffer)
+ (imap-mailbox-get 'uidnext
+ decoded-group nnimap-server-buffer)
+ (imap-mailbox-get 'unseen
+ decoded-group nnimap-server-buffer))
+ nnimap-mailbox-info)
+ (insert (format "\"%s\" %s %s y\n" group
+ (nth 2 saved-info)
+ (nth 1 saved-info))))))))
(dolist (group slowgroups)
(if nnimap-retrieve-groups-asynchronous
(setq group (car group)))
- (gnus-message 7 "nnimap: Mailbox %s modified" group)
- (imap-mailbox-put 'uidnext nil group nnimap-server-buffer)
- (or (member "\\NoSelect" (imap-mailbox-get 'list-flags group
+ (setq decoded-group (nnimap-decode-group-name group))
+ (gnus-message 7 "nnimap: Mailbox %s modified" decoded-group)
+ (or (member "\\NoSelect" (imap-mailbox-get 'list-flags decoded-group
nnimap-server-buffer))
- (let* ((info (nnimap-find-minmax-uid group 'examine))
- (str (format "\"%s\" %d %d y\n" group
- (or (nth 2 info) 0)
- (max 1 (or (nth 1 info) 1)))))
- (when (> (or (imap-mailbox-get 'recent group
+ (let* ((gnusgroup (nnimap-group-prefixed-name group))
+ (status (imap-mailbox-status
+ decoded-group '(uidvalidity uidnext unseen)
+ nnimap-server-buffer))
+ (info (nnimap-find-minmax-uid group 'examine))
+ (min-uid (max 1 (or (nth 1 info) 1)))
+ (max-uid (or (nth 2 info) 0)))
+ (when (> (or (imap-mailbox-get 'recent decoded-group
nnimap-server-buffer) 0)
0)
- (push (list (cons group 0)) nnmail-split-history))
- (insert str)
- (when nnimap-retrieve-groups-asynchronous
- (gnus-sethash
- (gnus-group-prefixed-name group server)
- (list (or (imap-mailbox-get
- 'uidvalidity group nnimap-server-buffer)
- (imap-mailbox-status
- group 'uidvalidity nnimap-server-buffer))
- (or (imap-mailbox-get
- 'uidnext group nnimap-server-buffer)
- (imap-mailbox-status
- group 'uidnext nnimap-server-buffer))
- (or (imap-mailbox-get
- 'unseen group nnimap-server-buffer)
- (imap-mailbox-status
- group 'unseen nnimap-server-buffer))
- str)
- nnimap-mailbox-info)))))))
+ (push (list (cons decoded-group 0)) nnmail-split-history))
+ (insert (format "\"%s\" %d %d y\n" group max-uid min-uid))
+ (gnus-sethash
+ (gnus-group-prefixed-name group server)
+ status
+ nnimap-mailbox-info)
+ (if (not (equal (nth 0 status)
+ (gnus-group-get-parameter gnusgroup
+ 'uidvalidity)))
+ (nnimap-verify-uidvalidity group nnimap-current-server))
+ ;; The imap-status parameter is a string on the form
+ ;; "<uidnext> <min-uid> <max-uid>".
+ (gnus-group-add-parameter
+ gnusgroup
+ (cons 'imap-status
+ (format "%s %s %s" (nth 1 status) min-uid max-uid))))))))
(gnus-message 5 "nnimap: Checking mailboxes...done")
'active))
(when info ;; xxx what does this mean? should we create a info?
(with-current-buffer nnimap-server-buffer
(gnus-message 5 "nnimap: Updating info for %s..."
- (gnus-info-group info))
+ (nnimap-decode-group-name (gnus-info-group info)))
(when (nnimap-mark-permanent-p 'read)
(let (seen unseen)
;; read info could contain articles marked unread by other
;; imap clients! we correct this
- (setq seen (gnus-uncompress-range (gnus-info-read info))
- unseen (imap-search "UNSEEN UNDELETED")
- seen (gnus-set-difference seen unseen)
- ;; seen might lack articles marked as read by other
- ;; imap clients! we correct this
- seen (append seen (imap-search "SEEN"))
- ;; remove dupes
- seen (sort seen '<)
- seen (gnus-compress-sequence seen t)
- ;; we can't return '(1) since this isn't a "list of ranges",
- ;; and we can't return '((1)) since g-list-of-unread-articles
- ;; is buggy so we return '((1 . 1)).
+ (setq unseen (gnus-compress-sequence
+ (imap-search "UNSEEN UNDELETED"))
+ seen (gnus-range-difference (gnus-info-read info) unseen)
+ seen (gnus-range-add seen
+ (gnus-compress-sequence
+ (imap-search "SEEN")))
seen (if (and (integerp (car seen))
(null (cdr seen)))
(list (cons (car seen) (car seen)))
seen))
(gnus-info-set-read info seen)))
- (mapcar (lambda (pred)
- (when (or (eq (cdr pred) 'recent)
- (and (nnimap-mark-permanent-p (cdr pred))
- (member (nnimap-mark-to-flag (cdr pred))
- (imap-mailbox-get 'flags))))
- (gnus-info-set-marks
- info
- (gnus-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)
+ (dolist (pred gnus-article-mark-lists)
+ (when (or (eq (cdr pred) 'recent)
+ (and (nnimap-mark-permanent-p (cdr pred))
+ (member (nnimap-mark-to-flag (cdr pred))
+ (imap-mailbox-get 'flags))))
+ (gnus-info-set-marks
+ info
+ (gnus-update-alist-soft
+ (cdr pred)
+ (gnus-compress-sequence
+ (imap-search (nnimap-mark-to-predicate (cdr pred))))
+ (gnus-info-marks info))
+ t)))
(when nnimap-importantize-dormant
;; nnimap mark dormant article as ticked too (for other clients)
t))
(gnus-message 5 "nnimap: Updating info for %s...done"
- (gnus-info-group info))
+ (nnimap-decode-group-name (gnus-info-group info)))
info))))
(when (nnimap-possibly-change-group group server)
(with-current-buffer nnimap-server-buffer
(let (action)
- (gnus-message 7 "nnimap: Setting marks in %s..." group)
+ (gnus-message 7 "nnimap: Setting marks in %s..."
+ (nnimap-decode-group-name group))
(while (setq action (pop actions))
(let ((range (nth 0 action))
(what (nth 1 action))
(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
(imap-message-flags-set
(imap-range-to-message-set range)
(nnimap-mark-to-flag marks nil t)))))))
- (gnus-message 7 "nnimap: Setting marks in %s...done" group))))
+ (gnus-message 7 "nnimap: Setting marks in %s...done"
+ (nnimap-decode-group-name group)))))
nil)
(defun nnimap-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.
+ ;; Note: This function takes and returns decoded group names.
(with-current-buffer nntp-server-buffer
;; Fold continuation lines.
(goto-char (point-min))
(list nnimap-split-inbox)))
(defun nnimap-split-articles (&optional group server)
+ ;; Note: Assumes decoded group names in nnimap-split-inbox,
+ ;; nnimap-split-rule, nnimap-split-fancy, and nnmail-split-history.
(when (nnimap-possibly-change-server server)
(with-current-buffer nnimap-server-buffer
- (let (rule inbox removeorig (inboxes (nnimap-split-find-inbox server)))
+ (let (rule inbox removeorig
+ (inboxes (nnimap-split-find-inbox server)))
;; iterate over inboxes
(while (and (setq inbox (pop inboxes))
- (nnimap-possibly-change-group inbox)) ;; SELECT
+ (nnimap-possibly-change-group
+ (nnimap-encode-group-name inbox))) ;; SELECT
;; find split rule for this server / inbox
(when (setq rule (nnimap-split-find-rule server inbox))
;; iterate over articles
(dolist (article (imap-search nnimap-split-predicate))
- (when (nnimap-request-head article)
+ (when (if (if (eq nnimap-split-download-body 'default)
+ nnimap-split-download-body-default
+ nnimap-split-download-body)
+ (and (nnimap-request-article article)
+ (with-current-buffer nntp-server-buffer (mail-narrow-to-head)))
+ (nnimap-request-head article))
;; copy article to right group(s)
(setq removeorig nil)
(dolist (to-group (nnimap-split-to-groups rule))
(setq removeorig t)
(when nnmail-cache-accepted-message-ids
(with-current-buffer nntp-server-buffer
- (let (msgid)
- (and (setq msgid
+ (let (msgid)
+ (and (setq msgid
(nnmail-fetch-field "message-id"))
- (nnmail-cache-insert msgid to-group)))))
+ (nnmail-cache-insert msgid
+ (nnimap-encode-group-name to-group)
+ (nnmail-fetch-field "subject"))))))
;; 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))))
+ (if (if (eq nnimap-split-download-body 'default)
+ nnimap-split-download-body-default
+ nnimap-split-download-body)
+ (widen))
;; remove article if it was successfully copied somewhere
(and removeorig
(imap-message-flags-add (format "%d" article)
(nnimap-before-find-minmax-bugworkaround)
(dolist (pattern (nnimap-pattern-to-list-arguments
nnimap-list-pattern))
- (dolist (mbx (imap-mailbox-lsub "*" (car pattern) nil
+ (dolist (mbx (imap-mailbox-lsub (cdr pattern) (car pattern) nil
nnimap-server-buffer))
(or (catch 'found
(dolist (mailbox (imap-mailbox-get 'list-flags mbx
(if (string= (downcase mailbox) "\\noselect")
(throw 'found t)))
nil)
- (let ((info (nnimap-find-minmax-uid mbx 'examine)))
+ (let* ((encoded-mbx (nnimap-encode-group-name mbx))
+ (info (nnimap-find-minmax-uid encoded-mbx 'examine)))
(when info
(insert (format "\"%s\" %d %d y\n"
- mbx (or (nth 2 info) 0)
+ encoded-mbx (or (nth 2 info) 0)
(max 1 (or (nth 1 info) 1)))))))))
(gnus-message 5 "nnimap: Listing subscribed mailboxes%s%s...done"
(if (> (length server) 0) " on " "") server))
(deffoo nnimap-request-create-group (group &optional server args)
(when (nnimap-possibly-change-server server)
- (or (imap-mailbox-status group 'uidvalidity nnimap-server-buffer)
- (imap-mailbox-create group nnimap-server-buffer))))
+ (let ((decoded-group (nnimap-decode-group-name group)))
+ (or (imap-mailbox-status decoded-group 'uidvalidity nnimap-server-buffer)
+ (imap-mailbox-create decoded-group nnimap-server-buffer)
+ (nnheader-report 'nnimap "%S"
+ (imap-error-text nnimap-server-buffer))))))
(defun nnimap-time-substract (time1 time2)
"Return TIME for TIME1 - TIME2."
(list (- ms 1) (+ (expt 2 16) ls))
(list ms ls))))
+(eval-when-compile (require 'parse-time))
(defun nnimap-date-days-ago (daysago)
"Return date, in format \"3-Aug-1998\", for DAYSAGO days ago."
+ (require 'parse-time)
(let* ((time (nnimap-time-substract (current-time) (days-to-time daysago)))
(date (format-time-string
(format "%%d-%s-%%Y"
nnmail-expiry-wait)))
(cond ((or force (eq days 'immediate))
(let ((oldarts (imap-search
- (concat "UID "
+ (concat "UID "
(imap-range-to-message-set artseq)))))
(when oldarts
(nnimap-expiry-target oldarts group server)
(when (imap-message-flags-add
- (imap-range-to-message-set oldarts) "\\Deleted")
+ (imap-range-to-message-set
+ (gnus-compress-sequence oldarts)) "\\Deleted")
+ (setq articles (gnus-set-difference
+ articles oldarts))))))
+ ((and nnimap-search-uids-not-since-is-evil (numberp days))
+ (let* ((all-new-articles
+ (gnus-compress-sequence
+ (imap-search (format "SINCE %s"
+ (nnimap-date-days-ago days)))))
+ (oldartseq
+ (gnus-range-difference artseq all-new-articles))
+ (oldarts (gnus-uncompress-range oldartseq)))
+ (when oldarts
+ (nnimap-expiry-target oldarts group server)
+ (when (imap-message-flags-add
+ (imap-range-to-message-set oldartseq)
+ "\\Deleted")
(setq articles (gnus-set-difference
articles oldarts))))))
((numberp days)
(when oldarts
(nnimap-expiry-target oldarts group server)
(when (imap-message-flags-add
- (imap-range-to-message-set oldarts) "\\Deleted")
- (setq articles (gnus-set-difference
+ (imap-range-to-message-set
+ (gnus-compress-sequence oldarts)) "\\Deleted")
+ (setq articles (gnus-set-difference
articles oldarts)))))))))))
;; return articles not deleted
articles)
-(deffoo nnimap-request-move-article (article group server
- accept-form &optional last)
+(deffoo nnimap-request-move-article (article group server accept-form
+ &optional last move-is-internal)
(when (nnimap-possibly-change-server server)
(save-excursion
(let ((buf (get-buffer-create " *nnimap move*"))
(nnimap-current-move-group group)
(nnimap-current-move-server nnimap-current-server)
result)
- (and (nnimap-request-article article group server)
- (save-excursion
- (set-buffer buf)
+ (gnus-message 10 "nnimap-request-move-article: this is an %s move"
+ (if move-is-internal
+ "internal"
+ "external"))
+ ;; request the article only when the move is NOT internal
+ (and (or move-is-internal
+ (nnimap-request-article article group server))
+ (with-current-buffer buf
(buffer-disable-undo (current-buffer))
(insert-buffer-substring nntp-server-buffer)
(setq result (eval accept-form))
(kill-buffer buf)
result)
+ (nnimap-possibly-change-group group server)
(imap-message-flags-add
(imap-range-to-message-set (list article))
"\\Deleted" 'silent nnimap-server-buffer))
nnimap-current-move-group)
(imap-message-copy (number-to-string
nnimap-current-move-article)
- group 'dontcreate nil
+ (nnimap-decode-group-name group)
+ 'dontcreate nil
nnimap-server-buffer))
(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))))
+ (delete-region (point) (progn (forward-line) (point))))
;; turn into rfc822 format (\r\n eol's)
(while (search-forward "\n" nil t)
(replace-match "\r\n"))
(when nnmail-cache-accepted-message-ids
(nnmail-cache-insert (nnmail-fetch-field "message-id")
- group)))
+ group
+ (nnmail-fetch-field "subject"))))
(when (and last nnmail-cache-accepted-message-ids)
(nnmail-cache-close))
;; 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
+ (imap-message-append (nnimap-decode-group-name group)
+ (current-buffer) nil nil
nnimap-server-buffer)))
(cons group (nth 1 uid))
(nnheader-report 'nnimap (imap-error-text nnimap-server-buffer))))))
(deffoo nnimap-request-delete-group (group force &optional server)
(when (nnimap-possibly-change-server server)
+ (setq group (nnimap-decode-group-name group))
+ (when (string= group (imap-current-mailbox nnimap-server-buffer))
+ (imap-mailbox-unselect nnimap-server-buffer))
(with-current-buffer nnimap-server-buffer
(if force
(or (null (imap-mailbox-status group 'uidvalidity))
(deffoo nnimap-request-rename-group (group new-name &optional server)
(when (nnimap-possibly-change-server server)
- (imap-mailbox-rename group new-name nnimap-server-buffer)))
+ (imap-mailbox-rename (nnimap-decode-group-name group)
+ (nnimap-decode-group-name new-name)
+ nnimap-server-buffer)))
(defun nnimap-expunge (mailbox server)
(when (nnimap-possibly-change-group mailbox server)
(defun nnimap-acl-get (mailbox server)
(when (nnimap-possibly-change-server server)
(and (imap-capability 'ACL nnimap-server-buffer)
- (imap-mailbox-acl-get mailbox nnimap-server-buffer))))
+ (imap-mailbox-acl-get (nnimap-decode-group-name mailbox)
+ nnimap-server-buffer))))
(defun nnimap-acl-edit (mailbox method old-acls new-acls)
(when (nnimap-possibly-change-server (cadr method))
(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)
+ (nnimap-decode-group-name 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
+ (nnimap-decode-group-name mailbox))
+ (error "Can't set ACL for %s to %s" (car new-acl)
+ new-rights)))))
+ new-acls)
t)))
\f
result)))
(defun nnimap-mark-permanent-p (mark &optional group)
- "Return t iff MARK can be permanently (between IMAP sessions) saved on articles, in GROUP."
+ "Return t if MARK can be permanently (between IMAP sessions) saved on articles, in GROUP."
(imap-message-flag-permanent-p (nnimap-mark-to-flag mark)))
(when nnimap-debug
(require 'trace)
- (buffer-disable-undo (get-buffer-create 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-retrieve-which-headers
- nnimap-group-overview-filename
- nnimap-retrieve-headers-from-file
- nnimap-retrieve-headers-from-server
- nnimap-retrieve-headers
- nnimap-open-connection
- nnimap-open-server
- nnimap-server-opened
- nnimap-close-server
- nnimap-request-close
- nnimap-status-message
- ;;nnimap-demule
- nnimap-request-article-part
- nnimap-request-article
- nnimap-request-head
- nnimap-request-body
- nnimap-request-group
- nnimap-close-group
- nnimap-pattern-to-list-arguments
- nnimap-request-list
- nnimap-request-post
- nnimap-retrieve-groups
- nnimap-request-update-info-internal
- nnimap-request-type
- nnimap-request-set-mark
- nnimap-split-to-groups
- nnimap-split-find-rule
- nnimap-split-find-inbox
- nnimap-split-articles
- nnimap-request-scan
- nnimap-request-newgroups
- nnimap-request-create-group
- nnimap-time-substract
- nnimap-date-days-ago
- nnimap-request-expire-articles-progress
- nnimap-request-expire-articles
- nnimap-request-move-article
- nnimap-request-accept-article
- nnimap-request-delete-group
- nnimap-request-rename-group
- gnus-group-nnimap-expunge
- gnus-group-nnimap-edit-acl
- gnus-group-nnimap-edit-acl-done
- nnimap-group-mode-hook
- nnimap-mark-to-predicate
- nnimap-mark-to-flag-1
- nnimap-mark-to-flag
- nnimap-mark-permanent-p
- )))
+ (buffer-disable-undo (get-buffer-create nnimap-debug-buffer))
+ (mapc (lambda (f) (trace-function-background f nnimap-debug-buffer))
+ '(
+ 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-retrieve-which-headers
+ nnimap-group-overview-filename
+ nnimap-retrieve-headers-from-file
+ nnimap-retrieve-headers-from-server
+ nnimap-retrieve-headers
+ nnimap-open-connection
+ nnimap-open-server
+ nnimap-server-opened
+ nnimap-close-server
+ nnimap-request-close
+ nnimap-status-message
+ ;;nnimap-demule
+ nnimap-request-article-part
+ nnimap-request-article
+ nnimap-request-head
+ nnimap-request-body
+ nnimap-request-group
+ nnimap-close-group
+ nnimap-pattern-to-list-arguments
+ nnimap-request-list
+ nnimap-request-post
+ nnimap-retrieve-groups
+ nnimap-request-update-info-internal
+ nnimap-request-type
+ nnimap-request-set-mark
+ nnimap-split-to-groups
+ nnimap-split-find-rule
+ nnimap-split-find-inbox
+ nnimap-split-articles
+ nnimap-request-scan
+ nnimap-request-newgroups
+ nnimap-request-create-group
+ nnimap-time-substract
+ nnimap-date-days-ago
+ nnimap-request-expire-articles-progress
+ nnimap-request-expire-articles
+ nnimap-request-move-article
+ nnimap-request-accept-article
+ nnimap-request-delete-group
+ nnimap-request-rename-group
+ gnus-group-nnimap-expunge
+ gnus-group-nnimap-edit-acl
+ gnus-group-nnimap-edit-acl-done
+ nnimap-group-mode-hook
+ nnimap-mark-to-predicate
+ nnimap-mark-to-flag-1
+ nnimap-mark-to-flag
+ nnimap-mark-permanent-p
+ )))
(provide 'nnimap)
+;; arch-tag: 2b001f20-3ff9-4094-a0ad-46807c1ba70b
;;; nnimap.el ends here
projects / gnus / blobdiff