Changes committed gnus/lisp (ChangeLog gnus-agent.el nnimap.el)
"Ted Zlatanov" <[email protected]> Sat, 20 Mar 2010 17:44:10 +0100
| Newsgroups | gmane.emacs.gnus.commits |
|---|---|
| Message-ID | <[email protected]> |
Modified: ChangeLog gnus-agent.el nnimap.el * nnimap.el (nnimap-decode-group-name, nnimap-encode-group-name): In-place substitutions for the group name encoding/decoding. (nnimap-find-minmax-uid, nnimap-possibly-change-group) (nnimap-retrieve-headers-progress, nnimap-possibly-change-group) (nnimap-retrieve-headers-progress, nnimap-request-article-part) (nnimap-update-unseen, nnimap-request-list) (nnimap-retrieve-groups, nnimap-request-update-info-internal) (nnimap-request-set-mark, nnimap-split-to-groups) (nnimap-split-articles, nnimap-request-newgroups) (nnimap-request-create-group, nnimap-request-accept-article) (nnimap-request-delete-group, nnimap-request-rename-group) (nnimap-acl-get, nnimap-acl-edit): Use them. Replace `mbx' with `encoded-mbx' for consistency. (nnimap-close-group): Call `imap-current-mailbox' instead of using the variable `imap-current-mailbox'. * gnus-agent.el (gnus-agent-fetch-articles, gnus-agent-fetch-headers) (gnus-agent-regenerate-group): Use `gnus-agent-decoded-group-name'. Index: ChangeLog diff -u gnus/lisp/ChangeLog:7.2066 gnus/lisp/ChangeLog:7.2067 --- ChangeLog:7.2066 Sat Mar 20 17:19:52 2010 +++ ChangeLog Sat Mar 20 17:44:09 2010 @@ -1,3 +1,24 @@ +2010-03-20 Martin Stjernholm <[email protected]> + + * nnimap.el (nnimap-decode-group-name, nnimap-encode-group-name): + In-place substitutions for the group name encoding/decoding. + (nnimap-find-minmax-uid, nnimap-possibly-change-group) + (nnimap-retrieve-headers-progress, nnimap-possibly-change-group) + (nnimap-retrieve-headers-progress, nnimap-request-article-part) + (nnimap-update-unseen, nnimap-request-list) + (nnimap-retrieve-groups, nnimap-request-update-info-internal) + (nnimap-request-set-mark, nnimap-split-to-groups) + (nnimap-split-articles, nnimap-request-newgroups) + (nnimap-request-create-group, nnimap-request-accept-article) + (nnimap-request-delete-group, nnimap-request-rename-group) + (nnimap-acl-get, nnimap-acl-edit): Use them. Replace `mbx' with + `encoded-mbx' for consistency. + (nnimap-close-group): Call `imap-current-mailbox' instead of using the + variable `imap-current-mailbox'. + + * gnus-agent.el (gnus-agent-fetch-articles, gnus-agent-fetch-headers) + (gnus-agent-regenerate-group): Use `gnus-agent-decoded-group-name'. + 2010-03-20 Bojan Petrovic <[email protected]> * pop3.el (pop3-display-message-size-flag): Display message size byte Index: gnus-agent.el diff -u gnus/lisp/gnus-agent.el:7.82 gnus/lisp/gnus-agent.el:7.83 --- gnus-agent.el:7.82 Wed Jan 13 11:59:43 2010 +++ gnus-agent.el Sat Mar 20 17:44:09 2010 @@ -1583,7 +1583,8 @@ (setq selected-sets (nreverse selected-sets)) (gnus-make-directory dir) - (gnus-message 7 "Fetching articles for %s..." group) + (gnus-message 7 "Fetching articles for %s..." + (gnus-agent-decoded-group-name group)) (unwind-protect (while (setq articles (pop selected-sets)) @@ -1594,7 +1595,8 @@ (let (article) (while (setq article (pop articles)) (gnus-message 10 "Fetching article %s for %s..." - article group) + article + (gnus-agent-decoded-group-name group)) (when (or (gnus-backlog-request-article group article nntp-server-buffer) @@ -1942,7 +1944,8 @@ (if articles (progn - (gnus-message 7 "Fetching headers for %s..." group) + (gnus-message 7 "Fetching headers for %s..." + (gnus-agent-decoded-group-name group)) ;; Fetch them. (gnus-make-directory (nnheader-translate-file-chars @@ -3904,7 +3907,7 @@ (sit-for 1) t))))) (when group - (gnus-message 5 "Regenerating in %s" group) + (gnus-message 5 "Regenerating in %s" (gnus-agent-decoded-group-name group)) (let* ((gnus-command-method (or gnus-command-method (gnus-find-method-for-group group))) (file (gnus-agent-article-name ".overview" group)) @@ -3981,7 +3984,8 @@ (or (not nov-arts) (> (car downloaded) (car nov-arts)))) ;; This entry is missing from the overview file - (gnus-message 3 "Regenerating NOV %s %d..." group + (gnus-message 3 "Regenerating NOV %s %d..." + (gnus-agent-decoded-group-name group) (car downloaded)) (let ((file (concat dir (number-to-string (car downloaded))))) (mm-with-unibyte-buffer Index: nnimap.el diff -u gnus/lisp/nnimap.el:7.61 gnus/lisp/nnimap.el:7.62 --- nnimap.el:7.61 Wed Jan 13 11:59:44 2010 +++ nnimap.el Sat Mar 20 17:44:09 2010 @@ -497,6 +497,14 @@ ;; 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)))) + (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))) @@ -559,36 +567,39 @@ "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-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))))) + (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." @@ -614,7 +625,7 @@ (let (headers lines chars uid mbx) (with-current-buffer nnimap-server-buffer (setq uid imap-current-message - mbx imap-current-mailbox + 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... @@ -955,8 +966,10 @@ 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) @@ -970,11 +983,15 @@ (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 @@ -1035,7 +1052,8 @@ (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) + (imap-mailbox-status (nnimap-decode-group-name group) + 'unseen nnimap-server-buffer) (nth 3 old))) nnimap-mailbox-info)) @@ -1051,7 +1069,7 @@ (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 @@ -1080,11 +1098,12 @@ (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) "")) @@ -1134,35 +1153,39 @@ (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) + (setq decoded-group (nnimap-decode-group-name group)) + (gnus-message 9 "nnimap: Quickly checking mailbox %s" + decoded-group) (add-to-list (if (gnus-gethash-safe (gnus-group-prefixed-name group server) nnimap-mailbox-info) '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) + (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 + (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 + (imap-mailbox-get 'uidnext decoded-group nnimap-server-buffer)))) (push (list group) slowgroups) (insert (nth 3 (gnus-gethash (gnus-group-prefixed-name @@ -1171,34 +1194,35 @@ (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) + (imap-mailbox-put 'uidnext nil decoded-group nnimap-server-buffer) + (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 + (when (> (or (imap-mailbox-get 'recent decoded-group nnimap-server-buffer) 0) 0) - (push (list (cons group 0)) nnmail-split-history)) + (push (list (cons decoded-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) + 'uidvalidity decoded-group nnimap-server-buffer) (imap-mailbox-status - group 'uidvalidity nnimap-server-buffer)) + decoded-group 'uidvalidity nnimap-server-buffer)) (or (imap-mailbox-get - 'uidnext group nnimap-server-buffer) + 'uidnext decoded-group nnimap-server-buffer) (imap-mailbox-status - group 'uidnext nnimap-server-buffer)) + decoded-group 'uidnext nnimap-server-buffer)) (or (imap-mailbox-get - 'unseen group nnimap-server-buffer) + 'unseen decoded-group nnimap-server-buffer) (imap-mailbox-status - group 'unseen nnimap-server-buffer)) + decoded-group 'unseen nnimap-server-buffer)) str) nnimap-mailbox-info))))))) (gnus-message 5 "nnimap: Checking mailboxes...done") @@ -1209,7 +1233,7 @@ (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) @@ -1255,7 +1279,7 @@ t)) (gnus-message 5 "nnimap: Updating info for %s...done" - (gnus-info-group info)) + (nnimap-decode-group-name (gnus-info-group info))) info)))) @@ -1268,7 +1292,8 @@ (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)) @@ -1309,7 +1334,8 @@ (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 () @@ -1320,6 +1346,7 @@ (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)) @@ -1372,12 +1399,16 @@ (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 @@ -1406,7 +1437,7 @@ (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)) @@ -1449,10 +1480,11 @@ (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)) @@ -1460,10 +1492,11 @@ (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." @@ -1594,7 +1627,8 @@ 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)) @@ -1614,13 +1648,15 @@ ;; 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 @@ -1632,7 +1668,9 @@ (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) @@ -1641,7 +1679,8 @@ (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)) @@ -1651,7 +1690,8 @@ ;; 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 @@ -1660,7 +1700,8 @@ (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)