;;; nnimap.el --- imap backend for Gnus
-;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
+
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;; 2005, 2006, 2007 Free Software Foundation, Inc.
;; Author: Simon Josefsson <jas@pdc.kth.se>
;; Jim Radford <radford@robby.caltech.edu>
;; 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)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; 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.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; 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,
(require 'gnus-start)
(require 'gnus-int)
+(eval-when-compile (require 'cl))
+
(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'.
: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.
+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.
+Note that username, passwords and other privacy sensitive
+information (such as e-mail) may be stored in the *nnimap-debug*
+buffer. It is not written to disk, however. Do not enable this
+variable unless you are comfortable with that."
+ :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)
"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."
(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))
(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)
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
(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")))))
'nov)))
(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)
(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"))
+ (user (netrc-machine-user-or-password
+ "login"
+ list
+ (list server
+ (or nnimap-server-address
+ nnimap-address))
+ (list port)
+ (list "imap" "imaps")))
+ (passwd (netrc-machine-user-or-password
+ "password"
+ list
+ (list server
+ (or nnimap-server-address
+ nnimap-address))
+ (list port)
+ (list "imap" "imaps"))))
(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)
(nnoo-status-message 'nnimap server)))
(defun nnimap-demule (string)
+ ;; 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
+ ;; Reverted, braindead got 7.5 out of 10 on imdb, so it can't be
+ ;; that bad. --Simon
(funcall (if (and (fboundp 'string-as-multibyte)
(subrp (symbol-function 'string-as-multibyte)))
'string-as-multibyte
(defun nnimap-make-callback (article gnus-callback buffer)
"Return a callback function."
- `(lambda ()
+ `(lambda ()
(nnimap-callback ,article ,gnus-callback ,buffer)))
(defun nnimap-callback (article gnus-callback buffer)
(imap-error-text nnimap-server-buffer))
(cons group article)))
(add-hook 'imap-fetch-data-hook
- (nnimap-make-callback article
- nnheader-callback-function
+ (nnimap-make-callback article
+ nnheader-callback-function
nntp-server-buffer))
(imap-fetch-asynch article part nil nnimap-server-buffer)
(cons group article))))))
"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)
'asyncgroups
'slowgroups)
(list group (imap-mailbox-status-asynch
- group '(uidvalidity uidnext unseen)
+ group '(uidvalidity uidnext unseen)
nnimap-server-buffer))))
(dolist (asyncgroup asyncgroups)
(let ((group (nth 0 asyncgroup))
(nth 0 (gnus-gethash (gnus-group-prefixed-name
group server)
nnimap-mailbox-info))
- (imap-mailbox-get 'uidvalidity group
+ (imap-mailbox-get 'uidvalidity group
nnimap-server-buffer)))
(not (string=
(nth 1 (gnus-gethash (gnus-group-prefixed-name
(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)
(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
(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
+ 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
(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))))
+ (imap-mailbox-create 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)
+ (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))
(save-excursion
(set-buffer buf)
(buffer-disable-undo (current-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))
;; 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
(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
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