From: Katsumi Yamaoka Date: Tue, 23 Mar 2010 07:37:09 +0000 (+0000) Subject: Synch with Gnus trunk X-Git-Tag: emacs-pretest-24.0.90~104^2~275^2~438^2~678 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=ec7995fa614cc47343697d8fe62e0fa4a118df97;p=emacs.git Synch with Gnus trunk ===================== 2010-03-23 Katsumi Yamaoka * gnus-art.el (canlock-verify): Autoload it for Emacs 21. * message.el (ecomplete-setup): Autoload it for Emacs <23. * mml-sec.el (mml-secure-cache-passphrase): Default to t that is password-cache's default if it is not bound. (mml-secure-passphrase-cache-expiry): Default to 16 that is password-cache-expiry's default if it is not bound. * pop3.el (pop3-list): Don't use 3rd arg of `split-string' which is not available in Emacs 21. 2010-03-23 Teodor Zlatanov * auth-source.el (auth-sources): Fix up definition so extra parameters are always inline. 2010-03-22 Martin Stjernholm * nnimap.el (nnimap-verify-uidvalidity): Fixed bug where uidvalidity wasn't updated after mismatch. Clear cached mailbox info correctly when uidvalidity changes. (nnimap-group-prefixed-name): New function to avoid some code duplication. (nnimap-verify-uidvalidity, nnimap-group-overview-filename) (nnimap-request-group): Use it. (nnimap-retrieve-groups, nnimap-verify-uidvalidity) (nnimap-update-unseen): Significantly improved speed of Gnus startup with many imap folders. This is done by caching the group status from the imap server persistently in a group parameter `imap-status'. (This was cached before too if `nnimap-retrieve-groups-asynchronous' was set, but not persistently, so every Gnus startup was still very slow.) 2010-03-20 Teodor Zlatanov * auth-source.el: Set up autoloads. Bump to 23.2 because of the secrets.el dependency. (auth-sources): Add optional user name. Add secrets.el configuration choice (unused right now). 2010-03-20 Teodor Zlatanov * gnus-sum.el (gnus-summary-make-menu-bar): Let `gnus-registry-install-shortcuts' fill in the functions. * gnus-registry.el (gnus-summary-misc-menu): Declare to avoid warnings. (gnus-registry-misc-menus): Variable to hold registry mark menus. (gnus-registry-install-shortcuts): Populate and use it in a `gnus-summary-menu-hook' lambda, under "Gnus"->"Registry Marks". 2010-03-20 Martin Stjernholm * 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 * pop3.el (pop3-display-message-size-flag): Display message size byte counts during POP3 download. (pop3-movemail): Use it. (pop3-list): Implement listing of available messages. 2010-03-20 Mark Triggs (tiny change) * nnir.el (nnir-get-article-nov-override-function): New function to override the normal NOV retrieval. (nnir-retrieve-headers): Use it. --- diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 58d1c0dc8da..59b3ae87d80 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,90 @@ +2010-03-23 Katsumi Yamaoka + + * gnus-art.el (canlock-verify): Autoload it for Emacs 21. + + * message.el (ecomplete-setup): Autoload it for Emacs <23. + + * mml-sec.el (mml-secure-cache-passphrase): Default to t that is + password-cache's default if it is not bound. + (mml-secure-passphrase-cache-expiry): Default to 16 that is + password-cache-expiry's default if it is not bound. + + * pop3.el (pop3-list): Don't use 3rd arg of `split-string' which is not + available in Emacs 21. + +2010-03-23 Teodor Zlatanov + + * auth-source.el (auth-sources): Fix up definition so extra parameters + are always inline. + +2010-03-22 Martin Stjernholm + + * nnimap.el (nnimap-verify-uidvalidity): Fixed bug where uidvalidity + wasn't updated after mismatch. Clear cached mailbox info correctly + when uidvalidity changes. + (nnimap-group-prefixed-name): New function to avoid some code + duplication. + (nnimap-verify-uidvalidity, nnimap-group-overview-filename) + (nnimap-request-group): Use it. + (nnimap-retrieve-groups, nnimap-verify-uidvalidity) + (nnimap-update-unseen): Significantly improved speed of Gnus startup + with many imap folders. This is done by caching the group status from + the imap server persistently in a group parameter `imap-status'. (This + was cached before too if `nnimap-retrieve-groups-asynchronous' was set, + but not persistently, so every Gnus startup was still very slow.) + +2010-03-20 Teodor Zlatanov + + * auth-source.el: Set up autoloads. Bump to 23.2 because of the + secrets.el dependency. + (auth-sources): Add optional user name. Add secrets.el configuration + choice (unused right now). + +2010-03-20 Teodor Zlatanov + + * gnus-sum.el (gnus-summary-make-menu-bar): Let + `gnus-registry-install-shortcuts' fill in the functions. + + * gnus-registry.el (gnus-summary-misc-menu): Declare to avoid + warnings. + (gnus-registry-misc-menus): Variable to hold registry mark menus. + (gnus-registry-install-shortcuts): Populate and use it in a + `gnus-summary-menu-hook' lambda, under "Gnus"->"Registry Marks". + +2010-03-20 Martin Stjernholm + + * 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 + + * pop3.el (pop3-display-message-size-flag): Display message size byte + counts during POP3 download. + (pop3-movemail): Use it. + (pop3-list): Implement listing of available messages. + +2010-03-20 Mark Triggs (tiny change) + + * nnir.el (nnir-get-article-nov-override-function): New function to + override the normal NOV retrieval. + (nnir-retrieve-headers): Use it. + 2010-03-19 Michael Albinus * auth-source.el (netrc-machine-user-or-password): Autoload. diff --git a/lisp/gnus/auth-source.el b/lisp/gnus/auth-source.el index 82c9ea8a44d..3b0d700a86f 100644 --- a/lisp/gnus/auth-source.el +++ b/lisp/gnus/auth-source.el @@ -35,6 +35,9 @@ (eval-when-compile (require 'cl)) (autoload 'netrc-machine-user-or-password "netrc") +(autoload 'secrets-search-items "secrets") +(autoload 'secrets-get-alias "secrets") +(autoload 'secrets-get-attribute "secrets") (defgroup auth-source nil "Authentication sources." @@ -49,7 +52,7 @@ "List of authentication protocols and their names" :group 'auth-source - :version "23.1" ;; No Gnus + :version "23.2" ;; No Gnus :type '(repeat :tag "Authentication Protocols" (cons :tag "Protocol Entry" (symbol :tag "Protocol") @@ -71,7 +74,7 @@ (defcustom auth-source-do-cache t "Whether auth-source should cache information." :group 'auth-source - :version "23.1" ;; No Gnus + :version "23.2" ;; No Gnus :type `boolean) (defcustom auth-source-debug nil @@ -85,7 +88,7 @@ If the value is t, debug messages are logged with `message'. If the value is a function, debug messages are logged by calling that function using the same arguments as `message'." :group 'auth-source - :version "23.1" ;; No Gnus + :version "23.2" ;; No Gnus :type `(choice :tag "auth-source debugging mode" (const :tag "Log using `message' to the *Messages* buffer" t) @@ -96,19 +99,32 @@ If the value is a function, debug messages are logged by calling "Whether auth-source should hide passwords in log messages. Only relevant if `auth-source-debug' is not nil." :group 'auth-source - :version "23.1" ;; No Gnus + :version "23.2" ;; No Gnus :type `boolean) (defcustom auth-sources '((:source "~/.authinfo.gpg" :host t :protocol t)) "List of authentication sources. -Each entry is the authentication type with optional properties." +Each entry is the authentication type with optional properties. + +It's best to customize this with `M-x customize-variable' because the choices +can get pretty complex." :group 'auth-source - :version "23.1" ;; No Gnus + :version "23.2" ;; No Gnus :type `(repeat :tag "Authentication Sources" (list :tag "Source definition" (const :format "" :value :source) - (string :tag "Authentication Source") + (choice :tag "Authentication backend choice" + (string :tag "Authentication Source (file)") + (list :tag "secrets.el (Secret Service API/KWallet/GNOME KeyRing)" + (const :format "" :value :secrets) + (choice :tag "Collection to use" + (string :tag "Collection name") + (const :tag "Default" 'default) + (const :tag "Any" t) + (const :tag "Temporary" "session") + (string :tag "Specific session name") + (const :tag "Fallback" nil)))) (const :format "" :value :host) (choice :tag "Host (machine) choice" (const :tag "Any" t) @@ -118,7 +134,15 @@ Each entry is the authentication type with optional properties." (choice :tag "Protocol" (const :tag "Any" t) (const :tag "Fallback" nil) - ,@auth-source-protocols-customize)))) + ,@auth-source-protocols-customize) + (repeat :tag "Extra Parameters" :inline t + (choice :tag "Extra parameter" + (list :tag "Preferred username" :inline t + (const :format "" :value :preferred-username) + (choice :tag "Personality or username" + (const :tag "Any" t) + (const :tag "Fallback" nil) + (string :tag "Specific user name")))))))) ;; temp for debugging ;; (unintern 'auth-source-protocols) diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index f385c71069b..17f1d0cdb1f 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -1583,7 +1583,8 @@ downloaded into the agent." (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 @@ downloaded into the agent." (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 @@ article numbers will be returned." (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 @@ If REREAD is not nil, downloaded articles are marked as unread." (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 @@ If REREAD is not nil, downloaded articles are marked as unread." (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 diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 1a66404f841..b3b156f69dc 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -4192,6 +4192,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is (put-text-property (match-end 0) (point-max) 'face eface))))))))) +(autoload 'canlock-verify "canlock" nil t) ;; for Emacs 21. + (defun article-verify-cancel-lock () "Verify Cancel-Lock header." (interactive) diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index e77b66e150d..db10440116b 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -60,6 +60,7 @@ (require 'gnus-sum) (require 'gnus-util) (require 'nnmail) +(require 'easymenu) (defvar gnus-adaptive-word-syntax-table) @@ -137,6 +138,10 @@ references.'" (const :tag "Always Install" t) (const :tag "Ask Me" ask))) +(defvar gnus-summary-misc-menu) ;; Avoid byte compiler warning. + +(defvar gnus-registry-misc-menus nil) ; ugly way to keep the menus + (defcustom gnus-registry-clean-empty t "Whether the empty registry entries should be deleted. Registry entries are considered empty when they have no groups @@ -764,7 +769,8 @@ FUNCTION should take two parameters, a mark symbol and the cell value." "Install the keyboard shortcuts and menus for the registry. Uses `gnus-registry-marks' to find what shortcuts to install." (let (keys-plist) - (gnus-registry-do-marks + (setq gnus-registry-misc-menus nil) + (gnus-registry-do-marks :char (lambda (mark data) (let ((function-format @@ -813,19 +819,34 @@ Uses `gnus-registry-marks' to find what shortcuts to install." ;; all this just to get the mark, I must be doing it wrong (intern ,(symbol-name mark)) articles ,remove t) + (gnus-message + 9 + "Applying mark %s to %d articles" + ,(symbol-name mark) (length articles)) (dolist (article articles) (gnus-summary-update-article - article + article (assoc article (gnus-data-list nil))))))) (push (intern function-name) keys-plist) - (push shortcut keys-plist) - (gnus-message + (push shortcut keys-plist) + (push (vector (format "%s %s" + (upcase-initials variant-name) + (symbol-name mark)) + (intern function-name) t) + gnus-registry-misc-menus) + (gnus-message 9 "Defined mark handling function %s" function-name)))))) (gnus-define-keys-1 - '(gnus-registry-mark-map "M" gnus-summary-mark-map) - keys-plist))) + '(gnus-registry-mark-map "M" gnus-summary-mark-map) + keys-plist) + (add-hook 'gnus-summary-menu-hook + (lambda () + (easy-menu-add-item + gnus-summary-misc-menu + nil + (cons "Registry Marks" gnus-registry-misc-menus)))))) ;;; use like this: ;;; (defalias 'gnus-user-format-function-M diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 2464b132839..608224e436d 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -2635,17 +2635,6 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) ["Set expirable mark" gnus-summary-mark-as-expirable t] ["Set bookmark" gnus-summary-set-bookmark t] ["Remove bookmark" gnus-summary-remove-bookmark t]) - ("Registry Mark" - ["Important" gnus-registry-set-article-Important-mark t] - ["Not Important" gnus-registry-remove-article-Important-mark t] - ["Work" gnus-registry-set-article-Work-mark t] - ["Not Work" gnus-registry-remove-article-Work-mark t] - ["Later" gnus-registry-set-article-Later-mark t] - ["Not Later" gnus-registry-remove-article-Later-mark t] - ["Personal" gnus-registry-set-article-Personal-mark t] - ["Not Personal" gnus-registry-remove-article-Personal-mark t] - ["To Do" gnus-registry-set-article-To-Do-mark t] - ["Not To Do" gnus-registry-remove-article-To-Do-mark t]) ("Limit to" ["Marks..." gnus-summary-limit-to-marks t] ["Subject..." gnus-summary-limit-to-subject t] @@ -2691,6 +2680,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) gnus-newsgroup-process-stack] ["Save" gnus-summary-save-process-mark t] ["Run command on marked..." gnus-summary-universal-argument t])) + ("Registry Marks") ("Scroll article" ["Page forward" gnus-summary-next-page ,@(if (featurep 'xemacs) '(t) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index abdc163bb16..03a4a40a66f 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -2850,6 +2850,8 @@ See also `message-forbidden-properties'." (inhibit-read-only t)) (remove-text-properties begin end message-forbidden-properties)))) +(autoload 'ecomplete-setup "ecomplete") ;; for Emacs <23. + ;;;###autoload (define-derived-mode message-mode text-mode "Message" "Major mode for editing mail and news to be sent. diff --git a/lisp/gnus/mml-sec.el b/lisp/gnus/mml-sec.el index e394593ec12..35155b89ac2 100644 --- a/lisp/gnus/mml-sec.el +++ b/lisp/gnus/mml-sec.el @@ -105,12 +105,18 @@ details." :group 'message :type 'boolean) -(defcustom mml-secure-cache-passphrase password-cache +(defcustom mml-secure-cache-passphrase + (if (boundp 'password-cache) + password-cache + t) "If t, cache passphrase." :group 'message :type 'boolean) -(defcustom mml-secure-passphrase-cache-expiry password-cache-expiry +(defcustom mml-secure-passphrase-cache-expiry + (if (boundp 'password-cache-expiry) + password-cache-expiry + 16) "How many seconds the passphrase is cached. Whether the passphrase is cached at all is controlled by `mml-secure-cache-passphrase'." diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index b939f50e0fc..c76169cb2b7 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -501,6 +501,20 @@ See also `nnimap-log'." ;; 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))) @@ -521,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))) @@ -544,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 () @@ -563,36 +583,39 @@ 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-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." @@ -618,7 +641,7 @@ 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 + 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... @@ -665,9 +688,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 @@ -964,8 +985,10 @@ function is generally only called when Gnus is shutting down." 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) @@ -979,11 +1002,15 @@ function is generally only called when Gnus is shutting down." (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 @@ -1020,8 +1047,7 @@ function is generally only called when Gnus is shutting down." (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) @@ -1044,8 +1070,8 @@ function is generally only called when Gnus is shutting down." (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) @@ -1060,7 +1086,7 @@ function is generally only called when Gnus is shutting down." (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,11 +1115,12 @@ function is generally only called when Gnus is shutting down." (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) "")) @@ -1143,73 +1170,88 @@ function is generally only called when Gnus is shutting down." (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)) @@ -1218,7 +1260,7 @@ function is generally only called when Gnus is shutting down." (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) @@ -1264,7 +1306,7 @@ function is generally only called when Gnus is shutting down." t)) (gnus-message 5 "nnimap: Updating info for %s...done" - (gnus-info-group info)) + (nnimap-decode-group-name (gnus-info-group info))) info)))) @@ -1277,7 +1319,8 @@ function is generally only called when Gnus is shutting down." (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)) @@ -1318,7 +1361,8 @@ function is generally only called when Gnus is shutting down." (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 () @@ -1329,6 +1373,7 @@ function is generally only called when Gnus is shutting down." (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)) @@ -1381,12 +1426,16 @@ function is generally only called when Gnus is shutting down." (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 @@ -1415,7 +1464,7 @@ function is generally only called when Gnus is shutting down." (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)) @@ -1458,10 +1507,11 @@ function is generally only called when Gnus is shutting down." (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)) @@ -1469,10 +1519,11 @@ function is generally only called when Gnus is shutting down." (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." @@ -1603,7 +1654,8 @@ function is generally only called when Gnus is shutting down." 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)) @@ -1623,13 +1675,15 @@ function is generally only called when Gnus is shutting down." ;; 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 @@ -1641,7 +1695,9 @@ function is generally only called when Gnus is shutting down." (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) @@ -1650,7 +1706,8 @@ function is generally only called when Gnus is shutting down." (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)) @@ -1660,7 +1717,8 @@ function is generally only called when Gnus is shutting down." ;; 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 @@ -1669,7 +1727,8 @@ function is generally only called when Gnus is shutting down." (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) diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index 02685c7594c..5475506746a 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@ -358,6 +358,14 @@ (defvar nnir-imap-search-argument-history () "The history for querying search options in nnir") +(defvar nnir-get-article-nov-override-function nil + "If non-nil, a function that will be passed each search result. This +should return a message's headers in NOV format. + +If this variable is nil, or if the provided function returns nil for a search +result, `gnus-retrieve-headers' will be called instead.") + + ;;; Developer Extension Variable: (defvar nnir-engines @@ -779,25 +787,31 @@ and show thread that contains this article." (nnir-possibly-change-server server) (let ((gnus-override-method (gnus-server-to-method server))) - (case (setq foo (gnus-retrieve-headers (list artno) artfullgroup nil)) - (nov - (goto-char (point-min)) - (setq novitem (nnheader-parse-nov)) - (unless novitem - (pop-to-buffer nntp-server-buffer) - (error - "nnheader-parse-nov returned nil for article %s in group %s" - artno artfullgroup))) - (headers - (goto-char (point-min)) - (setq novitem (nnheader-parse-head)) - (unless novitem - (pop-to-buffer nntp-server-buffer) - (error - "nnheader-parse-head returned nil for article %s in group %s" - artno artfullgroup))) - (t (error "Unknown header type %s while requesting article %s of group %s" - foo artno artfullgroup)))) + ;; if nnir-get-article-nov-override-function is set, use it + (if nnir-get-article-nov-override-function + (setq novitem (funcall nnir-get-article-nov-override-function + artitem)) + ;; else, set novitem through nnheader-parse-nov/nnheader-parse-head + (case (setq foo (gnus-retrieve-headers (list artno) + artfullgroup nil)) + (nov + (goto-char (point-min)) + (setq novitem (nnheader-parse-nov)) + (unless novitem + (pop-to-buffer nntp-server-buffer) + (error + "nnheader-parse-nov returned nil for article %s in group %s" + artno artfullgroup))) + (headers + (goto-char (point-min)) + (setq novitem (nnheader-parse-head)) + (unless novitem + (pop-to-buffer nntp-server-buffer) + (error + "nnheader-parse-head returned nil for article %s in group %s" + artno artfullgroup))) + (t (error "Unknown header type %s while requesting article %s of group %s" + foo artno artfullgroup))))) ;; replace article number in original group with article number ;; in nnir group (mail-header-set-number novitem art) diff --git a/lisp/gnus/pop3.el b/lisp/gnus/pop3.el index b3012b4b198..20f7ba34b3c 100644 --- a/lisp/gnus/pop3.el +++ b/lisp/gnus/pop3.el @@ -98,6 +98,12 @@ thing can fall apart and leave you with a corrupt mailbox." :type 'boolean :group 'pop3) +(defcustom pop3-display-message-size-flag t + "*If non-nil, display the size of the message that is being fetched." + :version "22.1" ;; Oort Gnus + :type 'boolean + :group 'pop3) + (defvar pop3-timestamp nil "Timestamp returned when initially connected to the POP server. Used for APOP authentication.") @@ -135,6 +141,7 @@ Shorter values mean quicker response, but are more CPU intensive.") (crashbuf (get-buffer-create " *pop3-retr*")) (n 1) message-count + message-sizes (pop3-password pop3-password)) ;; for debugging only (if pop3-debug (switch-to-buffer (process-buffer process))) @@ -149,10 +156,18 @@ Shorter values mean quicker response, but are more CPU intensive.") (pop3-pass process)) (t (error "Invalid POP3 authentication scheme"))) (setq message-count (car (pop3-stat process))) + (when (and pop3-display-message-size-flag + (> message-count 0)) + (setq message-sizes (pop3-list process))) (unwind-protect (while (<= n message-count) - (message "Retrieving message %d of %d from %s..." - n message-count pop3-mailhost) + (if pop3-display-message-size-flag + (message "Retrieving message %d of %d from %s... (%.1fk)" + n message-count pop3-mailhost + (/ (cdr (assoc n message-sizes)) + 1024.0)) + (message "Retrieving message %d of %d from %s..." + n message-count pop3-mailhost)) (pop3-retr process n crashbuf) (save-excursion (set-buffer crashbuf) @@ -451,8 +466,28 @@ If NOW, use that time instead." )) (defun pop3-list (process &optional msg) - "Scan listing of available messages. -This function currently does nothing.") + "If MSG is nil, return an alist of (MESSAGE-ID . SIZE) pairs. +Otherwise, return the size of the message-id MSG" + (pop3-send-command process (if msg + (format "LIST %d" msg) + "LIST")) + (let ((response (pop3-read-response process t))) + (if msg + (string-to-number (nth 2 (split-string response " "))) + (let ((start pop3-read-point) end) + (save-excursion + (set-buffer (process-buffer process)) + (while (not (re-search-forward "^\\.\r\n" nil t)) + (pop3-accept-process-output process) + (goto-char start)) + (setq pop3-read-point (point-marker)) + (goto-char (match-beginning 0)) + (setq end (point-marker)) + (mapcar #'(lambda (s) (let ((split (split-string s " "))) + (cons (string-to-number (nth 0 split)) + (string-to-number (nth 1 split))))) + (delete "" (split-string (buffer-substring start end) + "\r\n")))))))) (defun pop3-retr (process msg crashbuf) "Retrieve message-id MSG to buffer CRASHBUF."