X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnnimap.el;h=d412af46d0c25ed243e6fd737b3c86b366953888;hb=0f63151c0cfcb3498678c203edb84e6a1d2b57e0;hp=06a5210304384e1fee3c2216c2fe93906fe4bd89;hpb=fa540ae08ec5fa40247027c1556f9b7265391f1a;p=gnus diff --git a/lisp/nnimap.el b/lisp/nnimap.el index 06a521030..d412af46d 100644 --- a/lisp/nnimap.el +++ b/lisp/nnimap.el @@ -1,9 +1,9 @@ ;;; nnimap.el --- imap backend for Gnus ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, -;; 2007, 2008 Free Software Foundation, Inc. +;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc. -;; Author: Simon Josefsson +;; Author: Simon Josefsson ;; Jim Radford ;; Keywords: mail @@ -59,6 +59,10 @@ ;;; Code: +;; For Emacs < 22.2. +(eval-and-compile + (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) + (require 'imap) (require 'nnoo) (require 'nnmail) @@ -163,6 +167,8 @@ the inbox string is also a regexp. The actual splitting rules are as 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" @@ -460,11 +466,17 @@ An example plist would be '(\"name\" \"Gnus\" \"version\" gnus-version-number (plist :key-type string :value-type string))) (defcustom nnimap-debug nil - "If non-nil, random debug spews are placed in *nnimap-debug* buffer. + "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 *nnimap-debug* -buffer. It is not written to disk, however. Do not enable this -variable unless you are comfortable with that." +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) @@ -489,6 +501,20 @@ variable unless you are comfortable with that." ;; 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))) @@ -509,9 +535,7 @@ 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))) @@ -532,10 +556,18 @@ If SERVER is nil, uses the current server." (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 () @@ -551,37 +583,40 @@ If SERVER is nil, uses the current server." "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 (if imap-enable-exchange-bug-workaround "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))))) + (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 "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." @@ -607,13 +642,12 @@ If EXAMINE is non-nil the group is selected read-only." (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 @@ -621,7 +655,8 @@ If EXAMINE is non-nil the group is selected read-only." ;; to make it more clear. (mm-with-unibyte-buffer (buffer-disable-undo) - (insert headers) + ;; 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) @@ -654,9 +689,7 @@ If EXAMINE is non-nil the group is selected read-only." "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 @@ -782,12 +815,17 @@ If EXAMINE is non-nil the group is selected read-only." (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) @@ -796,10 +834,14 @@ If EXAMINE is non-nil the group is selected read-only." nnimap-authinfo-file) (netrc-parse nnimap-authinfo-file))) (port (if nnimap-server-port - (int-to-string nnimap-server-port) - "imap")) + (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-source-user-or-password "login" server port) ; this is preferred to netrc-* + auth-user ; this is preferred to netrc-* (netrc-machine-user-or-password "login" list @@ -809,7 +851,7 @@ If EXAMINE is non-nil the group is selected read-only." (list port) (list "imap" "imaps" "143" "993")))) (passwd (or - (auth-source-user-or-password "password" server port) ; this is preferred to netrc-* + auth-passwd ; this is preferred to netrc-* (netrc-machine-user-or-password "password" list @@ -901,40 +943,17 @@ function is generally only called when Gnus is shutting down." (when (nnimap-possibly-change-server server) (nnoo-status-message 'nnimap server))) -(defvar nnimap-demule-use-string-to-multibyte (fboundp 'string-to-multibyte) - "Temporary internal debug variable. -If you have problems (UTF-8 not decoded correctly on IMAP) with -the default value, please report it as a bug!") -;; FIXME: Clarify if we need to make this variable conditional on the Emacs -;; version (Emacs 22 vs. Emacs 23;Emacs 21 doesn't have `string-to-multibyte' -;; anyhow). --rsteib -;; -;; http://thread.gmane.org/gmane.emacs.gnus.general/67112 -;; (bug#464, reported by James Cloos) -;; http://thread.gmane.org/gmane.emacs.bugs/21524 -;; (bug#1174, reported by Frank Schmitt) - -(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 - (gnus-message 9 "nnimap-demule-use-string-to-multibyte: %s" - nnimap-demule-use-string-to-multibyte) - (if nnimap-demule-use-string-to-multibyte - ;; Stefan - (funcall (if (and (fboundp 'string-to-multibyte) - (subrp (symbol-function 'string-to-multibyte))) - 'string-to-multibyte - 'identity) - (or string ""))) - ;; Simon - (funcall (if (and (fboundp 'string-as-multibyte) - (subrp (symbol-function 'string-as-multibyte))) - 'string-as-multibyte - 'identity) - (or string ""))) +;; 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." @@ -967,24 +986,32 @@ the default value, please report it as a bug!") article))) (when article (gnus-message 10 "nnimap: Fetching (part of) article %d from %s..." - article (or group imap-current-mailbox - gnus-newsgroup-name)) + 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 gnus-newsgroup-name)) + 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 - gnus-newsgroup-name) + 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 @@ -1021,8 +1048,7 @@ the default value, please report it as a bug!") (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) @@ -1045,8 +1071,8 @@ the default value, please report it as a bug!") (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) @@ -1061,7 +1087,7 @@ the default value, please report it as a bug!") (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 @@ -1089,13 +1115,16 @@ the default value, please report it as a bug!") (dolist (pattern (nnimap-pattern-to-list-arguments nnimap-list-pattern)) (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))) - (when info - (with-current-buffer nntp-server-buffer - (insert (format "\"%s\" %d %d y\n" - mbx (or (nth 2 info) 0) - (max 1 (or (nth 1 info) 1))))))))))) + (unless (member "\\noselect" + (mapcar #'downcase + (imap-mailbox-get 'list-flags mbx))) + (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" + 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) "")) t)) @@ -1144,73 +1173,88 @@ the default value, please report it as a bug!") (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 + ;; " ". + (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)) @@ -1219,7 +1263,7 @@ the default value, please report it as a bug!") (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) @@ -1265,7 +1309,7 @@ the default value, please report it as a bug!") t)) (gnus-message 5 "nnimap: Updating info for %s...done" - (gnus-info-group info)) + (nnimap-decode-group-name (gnus-info-group info))) info)))) @@ -1278,7 +1322,8 @@ the default value, please report it as a bug!") (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)) @@ -1319,7 +1364,8 @@ the default value, please report it as a bug!") (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 () @@ -1330,6 +1376,7 @@ the default value, please report it as a bug!") (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)) @@ -1382,12 +1429,16 @@ the default value, please report it as a bug!") (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 @@ -1416,7 +1467,7 @@ the default value, please report it as a bug!") (and (setq msgid (nnmail-fetch-field "message-id")) (nnmail-cache-insert msgid - to-group + (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)) @@ -1451,18 +1502,19 @@ the default value, please report it as a bug!") (nnimap-before-find-minmax-bugworkaround) (dolist (pattern (nnimap-pattern-to-list-arguments nnimap-list-pattern)) - (dolist (mbx (imap-mailbox-lsub (cdr pattern) (car pattern) nil - nnimap-server-buffer)) + (dolist (mbx (funcall nnimap-request-list-method (cdr pattern) (car pattern) nil + 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))) + (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)) @@ -1470,10 +1522,11 @@ the default value, please report it as a bug!") (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) - (nnheader-report 'nnimap "%S" - (imap-error-text 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." @@ -1604,7 +1657,8 @@ the default value, please report it as a bug!") 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)) @@ -1624,13 +1678,15 @@ the default value, please report it as a bug!") ;; 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 @@ -1642,7 +1698,9 @@ the default value, please report it as a bug!") (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) @@ -1651,7 +1709,8 @@ the default value, please report it as a bug!") (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)) @@ -1661,7 +1720,8 @@ the default value, please report it as a bug!") ;; delete all removed identifiers (mapc (lambda (old-acl) (unless (assoc (car old-acl) new-acls) - (or (imap-mailbox-acl-delete (car old-acl) mailbox) + (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 @@ -1670,7 +1730,8 @@ the default value, please report it as a bug!") (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) + (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) @@ -1749,69 +1810,6 @@ be used in a STORE FLAGS command." "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-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