# HG changeset patch # User Katsumi Yamaoka # Date 1285892750 0 # Node ID 3b9bd3888ee9c3ab23f719c48ae7eceb521eca0e # Parent 49d445615c077847c2142e318e56e57e348e533d nnimap.el (nnimap-request-accept-article): Get the Message-ID without the \r. nnimap.el (nnimap-find-article-by-message-id): Use EXAMINE instead of SELECT to get the message-id. gnus-art.el, gnus.el, nnimap.el: Fix up make-obsolete-variable declarations throughout. gnus.texi (Mail Source Specifiers): Remove webmail.el mentions. mail-source.el: Removed webmail support. nntp.el (nntp-server-list-active-group): Document. gnus.texi (NNTP): Document nntp-server-list-active-group. gnus.texi (Customizing the IMAP Connection): Remove extra quote. nnimap.el (nnimap-find-article-by-message-id): Really return the article number. nnimap.el: Add nnimap-split-fancy. netrc.el (netrc-credentials, netrc-machine): Return the value of the "default" entry. nnimap.el: Use tls.el exclusively, and not starttls.el at all. nnimap.el (nnimap-wait-for-connection): Accept the moronic openssl s_client -starttls output, too. nnrss.el (nnrss-use-local): Add documentation. message.el (message-ignored-supersedes-headers): Strip Injection-* headers before superseding. nnimap.el (nnimap-open-connection): Reinstate the auto-upgrade from unencrypted to STARTTLS, if possible. nnir.el: Use the server names without suffixes. gnus-sum.el (gnus-summary-show-thread): Skip past invisible text when expanding threads. gnus-registry.el: Don't follow nnmairix references. Install the nnregistry refer method. gnus.texi (Spam Package Configuration Examples, SpamOracle): Remove nnimap-split-rule from examples. diff -r 49d445615c07 -r 3b9bd3888ee9 doc/misc/ChangeLog --- a/doc/misc/ChangeLog Thu Sep 30 16:26:40 2010 -0700 +++ b/doc/misc/ChangeLog Fri Oct 01 00:25:50 2010 +0000 @@ -1,3 +1,20 @@ +2010-09-30 Teodor Zlatanov + + * gnus.texi (Spam Package Configuration Examples, SpamOracle): Remove + nnimap-split-rule from examples. + +2010-09-30 Lars Magne Ingebrigtsen + + * gnus.texi (Mail Source Specifiers): Remove webmail.el mentions. + (NNTP): Document nntp-server-list-active-group. Suggested by Barry + Fishman. + (Client-Side IMAP Splitting): Add nnimap-split-fancy. + +2010-09-30 Julien Danjou + + * gnus.texi (Gravatars): Fix documentation about + gnu-gravatar-properties. + 2010-09-29 Daiki Ueno * epa.texi (Bug Reports): New section. @@ -6,6 +23,16 @@ * Makefile.in (top_srcdir): Remove unused variable. +2010-09-29 Lars Magne Ingebrigtsen + + * gnus.texi (Using IMAP): Remove the @acronyms from the headings. + (Client-Side IMAP Splitting): Document 'default. + +2010-09-27 Lars Magne Ingebrigtsen + + * gnus.texi (Customizing the IMAP Connection): Document + nnimap-fetch-partial-articles. + 2010-09-26 Lars Magne Ingebrigtsen * gnus-news.texi: Mention nnimap-inbox. diff -r 49d445615c07 -r 3b9bd3888ee9 doc/misc/gnus.texi --- a/doc/misc/gnus.texi Thu Sep 30 16:26:40 2010 -0700 +++ b/doc/misc/gnus.texi Fri Oct 01 00:25:50 2010 +0000 @@ -14394,6 +14394,12 @@ Note that not all servers support the recommended ID. This works for INN versions 2.3.0 and later, for instance. +@item nntp-server-list-active-group +If @code{nil}, then always use @samp{GROUP} instead of @samp{LIST +ACTIVE}. This is usually slower, but on misconfigured servers that +don't update their active files often, this can help. + + @end table @menu @@ -14836,7 +14842,7 @@ (nnimap-inbox "INBOX") (nnimap-split-methods default) (nnimap-expunge t) - (nnimap-stream 'ssl) + (nnimap-stream ssl) (nnir-search-engine imap) (nnimap-expunge-inbox t)) @end example @@ -14906,6 +14912,9 @@ Mail}), except the symbol @code{default}, which means that it should use the value of the @code{nnmail-split-methods} variable. +@item nnimap-split-fancy +Uses the same syntax as @code{nnmail-split-fancy}. + @end table @@ -15559,45 +15568,6 @@ :fetchflag "\\Seen") @end lisp -@item webmail -Get mail from a webmail server, such as @uref{http://www.hotmail.com/}, -@uref{http://webmail.netscape.com/}, @uref{http://www.netaddress.com/}, -@uref{http://mail.yahoo.com/}. - -NOTE: Webmail largely depends on cookies. A "one-line-cookie" patch is -required for url "4.0pre.46". - -WARNING: Mails may be lost. NO WARRANTY. - -Keywords: - -@table @code -@item :subtype -The type of the webmail server. The default is @code{hotmail}. The -alternatives are @code{netscape}, @code{netaddress}, @code{my-deja}. - -@item :user -The user name to give to the webmail server. The default is the login -name. - -@item :password -The password to give to the webmail server. If not specified, the user is -prompted. - -@item :dontexpunge -If non-@code{nil}, only fetch unread articles and don't move them to -trash folder after finishing the fetch. - -@end table - -An example webmail source: - -@lisp -(webmail :subtype 'hotmail - :user "user-name" - :password "secret") -@end lisp - @item group Get the actual mail source from the @code{mail-source} group parameter, @xref{Group Parameters}. @@ -24196,8 +24166,8 @@ spam-move-spam-nonspam-groups-only nil spam-mark-only-unseen-as-spam t spam-mark-ham-unread-before-move-from-spam-group t - nnimap-split-rule 'nnimap-split-fancy ;; @r{understand what this does before you copy it to your own setup!} + ;; @r{for nnimap you'll probably want to set nnimap-split-methods, see the manual} nnimap-split-fancy '(| ;; @r{trace references to parents and put in their group} (: gnus-registry-split-fancy-with-parent) @@ -24919,8 +24889,8 @@ @example (setq spam-use-spamoracle t spam-split-group "Junk" + ;; @r{for nnimap you'll probably want to set nnimap-split-methods, see the manual} nnimap-split-inbox '("INBOX") - nnimap-split-rule 'nnimap-split-fancy nnimap-split-fancy '(| (: spam-split) "INBOX")) @end example @@ -26239,7 +26209,7 @@ Masanobu @sc{Umeda}---the writer of the original @sc{gnus}. @item -Shenghuo Zhu---uudecode.el, mm-uu.el, rfc1843.el, webmail.el, +Shenghuo Zhu---uudecode.el, mm-uu.el, rfc1843.el, nnwarchive and many, many other things connected with @acronym{MIME} and other types of en/decoding, as well as general bug fixing, new functionality and stuff. diff -r 49d445615c07 -r 3b9bd3888ee9 lisp/ChangeLog --- a/lisp/ChangeLog Thu Sep 30 16:26:40 2010 -0700 +++ b/lisp/ChangeLog Fri Oct 01 00:25:50 2010 +0000 @@ -1,3 +1,13 @@ +2010-09-30 Lars Magne Ingebrigtsen + + * tls.el (tls-starttls-switches): New variable. + (tls-find-starttls-argument): Use it. + (open-tls-stream): Ditto. + +1 * netrc.el (netrc-credentials): Return the value of the "default" + entry. + (netrc-machine): Ditto. + 2010-09-30 Eli Zaretskii * vc/vc-hooks.el (vc-default-mode-line-string): Doc fix. diff -r 49d445615c07 -r 3b9bd3888ee9 lisp/gnus/ChangeLog --- a/lisp/gnus/ChangeLog Thu Sep 30 16:26:40 2010 -0700 +++ b/lisp/gnus/ChangeLog Fri Oct 01 00:25:50 2010 +0000 @@ -1,3 +1,59 @@ +2010-09-30 Teodor Zlatanov + + * gnus-registry.el (gnus-registry-install-nnregistry): New function to + install the nnregistry refer method. + (gnus-registry-install-hooks): Use it. + (gnus-registry-unfollowed-groups): Add nnmairix to the default + unfollowed groups. + +2010-09-30 Jose A. Ortega Ruiz (tiny change) + + * gnus-sum.el (gnus-summary-show-thread): Skip past invisible text when + expanding threads. + +2010-09-30 Lars Magne Ingebrigtsen + + * nnir.el: Use the server names without suffixes (bug #7009). + + * nnimap.el (nnimap-open-connection): Reinstate the auto-upgrade from + unencrypted to STARTTLS, if possible. + +2010-09-30 Teemu Likonen (tiny change) + + * message.el (message-ignored-supersedes-headers): Strip Injection-* + headers before superseding. + +2010-09-30 Lars Magne Ingebrigtsen + + * nnrss.el (nnrss-use-local): Add documentation. + + * nnimap.el (nnimap-extend-tls-programs): New function. + (nnimap-open-connection): Use tls.el exclusively, and not starttls.el. + (nnimap-wait-for-connection): Accept the greeting from the stupid + output from openssl s_client -starttls, too. + + * nnimap.el (nnimap-find-article-by-message-id): Really return the + article number. + (nnimap-split-fancy): New variable. + (nnimap-split-incoming-mail): Use it. + + * nntp.el (nntp-server-list-active-group): Document. + + * nnimap.el (nnimap-find-article-by-message-id): Use EXAMINE instead of + SELECT to get the message-id. + + * mail-source.el (mail-sources): Removed webmail support. + (defvar): Ditto. + (mail-source-fetcher-alist): Ditto. + (mail-source-fetch-webmail): Removed. + + * webmail.el: Removed -- doesn't seem relevant any more. + + * gnus.el: Fix up make-obsolete-variable declarations throughout. + + * nnimap.el (nnimap-request-accept-article): Get the Message-ID without + the \r. + 2010-09-30 Julien Danjou * gnus-agent.el (gnus-agent-add-group): Fix call to @@ -44,11 +100,13 @@ (nnimap-request-accept-article): Add \r\n to the lines to make this work with Cyrus. - * nnregistry.el: Added. - * nndraft.el (nndraft-request-expire-articles): Use the group name instead if "nndraft". Fix found by Nils Ackermann. +2010-09-29 Ludovic Courtes + + * nnregistry.el: Added. + 2010-09-29 Stefan Monnier * nnmail.el (group, group-art-list, group-art): diff -r 49d445615c07 -r 3b9bd3888ee9 lisp/gnus/gnus-art.el --- a/lisp/gnus/gnus-art.el Thu Sep 30 16:26:40 2010 -0700 +++ b/lisp/gnus/gnus-art.el Fri Oct 01 00:25:50 2010 +0000 @@ -725,7 +725,7 @@ :group 'gnus-article-various) (make-obsolete-variable 'gnus-article-hide-pgp-hook nil - "Gnus 5.10 (Emacs-22.1)") + "Gnus 5.10 (Emacs 22.1)") (defface gnus-button '((t (:weight bold))) @@ -1412,7 +1412,7 @@ :type gnus-article-treat-custom) (make-obsolete-variable 'gnus-treat-display-xface - 'gnus-treat-display-x-face "22.1") + 'gnus-treat-display-x-face "Emacs 22.1") (defcustom gnus-treat-display-x-face (and (not noninteractive) diff -r 49d445615c07 -r 3b9bd3888ee9 lisp/gnus/gnus-registry.el --- a/lisp/gnus/gnus-registry.el Thu Sep 30 16:26:40 2010 -0700 +++ b/lisp/gnus/gnus-registry.el Fri Oct 01 00:25:50 2010 +0000 @@ -122,12 +122,14 @@ :type 'symbol) (defcustom gnus-registry-unfollowed-groups - '("delayed$" "drafts$" "queue$" "INBOX$") + '("delayed$" "drafts$" "queue$" "INBOX$" "^nnmairix:") "List of groups that gnus-registry-split-fancy-with-parent won't return. The group names are matched, they don't have to be fully qualified. This parameter tells the Registry 'never split a message into a group that matches one of these, regardless of -references.'" +references.' + +nnmairix groups are specifically excluded because they are ephemeral." :group 'gnus-registry :type '(repeat regexp)) @@ -1127,6 +1129,7 @@ (setq gnus-registry-install t) ; in case it was 'ask or nil (gnus-registry-install-hooks) (gnus-registry-install-shortcuts) + (gnus-registry-install-nnregistry) (gnus-registry-read)) ;;;###autoload @@ -1143,6 +1146,19 @@ (add-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids)) +;;;###autoload +(defun gnus-registry-install-nnregistry () + "Install the nnregistry refer method in `gnus-refer-article-method'." + (interactive) + (when (featurep 'nnregistry) + (setq gnus-refer-article-method + (delete-dups + (append + (if (listp gnus-refer-article-method) + gnus-refer-article-method + (list gnus-refer-article-method)) + (list 'nnregistry)))))) + (defun gnus-registry-unload-hook () "Uninstall the registry hooks." (interactive) diff -r 49d445615c07 -r 3b9bd3888ee9 lisp/gnus/gnus-sum.el --- a/lisp/gnus/gnus-sum.el Thu Sep 30 16:26:40 2010 -0700 +++ b/lisp/gnus/gnus-sum.el Fri Oct 01 00:25:50 2010 +0000 @@ -11327,15 +11327,19 @@ (gnus-remove-overlays (point-min) (point-max) 'invisible 'gnus-sum) (gnus-summary-position-point)) +(defsubst gnus-summary--inv (p) + (and (eq (get-char-property p 'invisible) 'gnus-sum) p)) + (defun gnus-summary-show-thread () "Show thread subtrees. Returns nil if no thread was there to be shown." (interactive) (let* ((orig (point)) (end (point-at-eol)) + (end (or (gnus-summary--inv end) (gnus-summary--inv (1- end)))) ;; Leave point at bol (beg (progn (beginning-of-line) (if (bobp) (point) (1- (point))))) - (eoi (when (eq (get-char-property end 'invisible) 'gnus-sum) + (eoi (when end (if (fboundp 'next-single-char-property-change) (or (next-single-char-property-change end 'invisible) (point-max)) diff -r 49d445615c07 -r 3b9bd3888ee9 lisp/gnus/gnus.el --- a/lisp/gnus/gnus.el Thu Sep 30 16:26:40 2010 -0700 +++ b/lisp/gnus/gnus.el Fri Oct 01 00:25:50 2010 +0000 @@ -1427,7 +1427,7 @@ :group 'gnus-message :type '(choice (const :tag "default" nil) string)) -(make-obsolete-variable 'gnus-local-domain nil "24.1") +(make-obsolete-variable 'gnus-local-domain nil "Emacs 24.1") (defvar gnus-local-organization nil "String with a description of what organization (if any) the user belongs to. diff -r 49d445615c07 -r 3b9bd3888ee9 lisp/gnus/mail-source.el --- a/lisp/gnus/mail-source.el Thu Sep 30 16:26:40 2010 -0700 +++ b/lisp/gnus/mail-source.el Fri Oct 01 00:25:50 2010 +0000 @@ -219,34 +219,6 @@ (boolean :tag "Dontexpunge")) (group :inline t (const :format "" :value :plugged) - (boolean :tag "Plugged")))) - (cons :tag "Webmail server" - (const :format "" webmail) - (checklist :tag "Options" :greedy t - (group :inline t - (const :format "" :value :subtype) - ;; Should be generated from - ;; `webmail-type-definition', but we - ;; can't require webmail without W3. - (choice :tag "Subtype" - :value hotmail - (const hotmail) - (const yahoo) - (const netaddress) - (const netscape) - (const my-deja))) - (group :inline t - (const :format "" :value :user) - (string :tag "User")) - (group :inline t - (const :format "" :value :password) - (string :tag "Password")) - (group :inline t - (const :format "" - :value :dontexpunge) - (boolean :tag "Dontexpunge")) - (group :inline t - (const :format "" :value :plugged) (boolean :tag "Plugged")))))))) (defcustom mail-source-ignore-errors nil @@ -387,13 +359,7 @@ (:prescript) (:prescript-delay) (:postscript) - (:dontexpunge)) - (webmail - (:subtype hotmail) - (:user (or (user-login-name) (getenv "LOGNAME") (getenv "USER"))) - (:password) - (:dontexpunge) - (:authentication password))) + (:dontexpunge))) "Mapping from keywords to default values. All keywords that can be used must be listed here.")) @@ -402,8 +368,7 @@ (directory mail-source-fetch-directory) (pop mail-source-fetch-pop) (maildir mail-source-fetch-maildir) - (imap mail-source-fetch-imap) - (webmail mail-source-fetch-webmail)) + (imap mail-source-fetch-imap)) "A mapping from source type to fetcher function.") (defvar mail-source-password-cache nil) @@ -1138,30 +1103,6 @@ ?s server ?P port ?u user)) found))) -(autoload 'webmail-fetch "webmail") - -(defun mail-source-fetch-webmail (source callback) - "Fetch for webmail source." - (mail-source-bind (webmail source) - (let ((mail-source-string (format "webmail:%s:%s" subtype user)) - (webmail-newmail-only dontexpunge) - (webmail-move-to-trash-can (not dontexpunge))) - (when (eq authentication 'password) - (setq password - (or password - (cdr (assoc (format "webmail:%s:%s" subtype user) - mail-source-password-cache)) - (read-passwd - (format "Password for %s at %s: " user subtype)))) - (when (and password - (not (assoc (format "webmail:%s:%s" subtype user) - mail-source-password-cache))) - (push (cons (format "webmail:%s:%s" subtype user) password) - mail-source-password-cache))) - (webmail-fetch mail-source-crash-box subtype user password) - (mail-source-callback callback (symbol-name subtype)) - (mail-source-delete-crash-box)))) - (provide 'mail-source) ;;; mail-source.el ends here diff -r 49d445615c07 -r 3b9bd3888ee9 lisp/gnus/message.el --- a/lisp/gnus/message.el Thu Sep 30 16:26:40 2010 -0700 +++ b/lisp/gnus/message.el Fri Oct 01 00:25:50 2010 +0000 @@ -283,7 +283,7 @@ :link '(custom-manual "(message)Mail Headers") :type 'regexp) -(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-ID:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:\\|^X-Hashcash:\\|^X-Payment:\\|^Approved:" +(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-ID:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:\\|^X-Hashcash:\\|^X-Payment:\\|^Approved:\\|^Injection-Date:\\|^Injection-Info:" "*Header lines matching this regexp will be deleted before posting. It's best to delete old Path and Date headers before posting to avoid any confusion." diff -r 49d445615c07 -r 3b9bd3888ee9 lisp/gnus/nnimap.el --- a/lisp/gnus/nnimap.el Thu Sep 30 16:26:40 2010 -0700 +++ b/lisp/gnus/nnimap.el Fri Oct 01 00:25:50 2010 +0000 @@ -38,6 +38,7 @@ (require 'nnoo) (require 'netrc) (require 'utf7) +(require 'tls) (require 'parse-time) (autoload 'auth-source-forget-user-or-password "auth-source") @@ -70,8 +71,11 @@ "How mail is split. Uses the same syntax as nnmail-split-methods") +(defvoo nnimap-split-fancy nil + "Uses the same syntax as nnmail-split-fancy.") + (make-obsolete-variable 'nnimap-split-rule "see `nnimap-split-methods'" - "Gnus 5.13") + "Emacs 24.1") (defvoo nnimap-authenticator nil "How nnimap authenticate itself to the server. @@ -306,9 +310,11 @@ (setq port (or nnimap-server-port "imap"))) '("imap")) ((eq nnimap-stream 'starttls) - (starttls-open-stream - "*nnimap*" (current-buffer) nnimap-address - (setq port (or nnimap-server-port "imap"))) + (let ((tls-program (nnimap-extend-tls-programs))) + (open-tls-stream + "*nnimap*" (current-buffer) nnimap-address + (setq port (or nnimap-server-port "imap")) + 'starttls)) '("imap")) ((eq nnimap-stream 'ssl) (open-tls-stream @@ -342,11 +348,23 @@ #'upcase (nnimap-find-parameter "CAPABILITY" (cdr (nnimap-command "CAPABILITY"))))) - (when (eq nnimap-stream 'starttls) - (nnimap-command "STARTTLS") - (starttls-negotiate (nnimap-process nnimap-object))) (when nnimap-server-port (push (format "%s" nnimap-server-port) ports)) + ;; If this is a STARTTLS-capable server, then sever the + ;; connection and start a STARTTLS connection instead. + (when (and (eq nnimap-stream 'network) + (member "STARTTLS" (nnimap-capabilities nnimap-object))) + (let ((nnimap-stream 'starttls)) + (let ((tls-process + (nnimap-open-connection buffer))) + ;; If the STARTTLS connection was successful, we + ;; kill our first non-encrypted connection. If it + ;; wasn't successful, we just use our unencrypted + ;; connection. + (when (memq (process-status tls-process) '(open run)) + (delete-process (nnimap-process nnimap-object)) + (kill-buffer (current-buffer)) + (return tls-process))))) (unless (equal connection-result "PREAUTH") (if (not (setq credentials (if (eq nnimap-authenticator 'anonymous) @@ -378,7 +396,16 @@ (when nnimap-object (when (member "QRESYNC" (nnimap-capabilities nnimap-object)) (nnimap-command "ENABLE QRESYNC")) - t))))))) + (nnimap-process nnimap-object)))))))) + +(defun nnimap-extend-tls-programs () + (let ((programs tls-program) + result) + (unless (consp programs) + (setq programs (list programs))) + (dolist (program programs) + (push (concat program " " "%s") result)) + (nreverse result))) (defun nnimap-find-parameter (parameter elems) (let (result) @@ -729,16 +756,20 @@ (defun nnimap-find-article-by-message-id (group message-id) - (when (nnimap-possibly-change-group group nil) - (with-current-buffer (nnimap-buffer) - (let ((result - (nnimap-command "UID SEARCH HEADER Message-Id %S" message-id)) - article) - (when (car result) - ;; Select the last instance of the message in the group. - (and (setq article - (car (last (assoc "SEARCH" (cdr result))))) - (string-to-number article))))))) + (with-current-buffer (nnimap-buffer) + (erase-buffer) + (setf (nnimap-group nnimap-object) nil) + (nnimap-send-command "EXAMINE %S" (utf7-encode group t)) + (let ((sequence + (nnimap-send-command "UID SEARCH HEADER Message-Id %S" message-id)) + article result) + (setq result (nnimap-wait-for-response sequence)) + (when (and result + (car (setq result (nnimap-parse-response)))) + ;; Select the last instance of the message in the group. + (and (setq article + (car (last (assoc "SEARCH" (cdr result))))) + (string-to-number article)))))) (defun nnimap-delete-article (articles) (with-current-buffer (nnimap-buffer) @@ -796,10 +827,10 @@ (deffoo nnimap-request-accept-article (group &optional server last) (when (nnimap-possibly-change-group nil server) (nnmail-check-syntax) - (nnimap-add-cr) - (let ((message (buffer-string)) - (message-id (message-field-value "message-id")) - sequence) + (let ((message-id (message-field-value "message-id")) + sequence message) + (nnimap-add-cr) + (setq message (buffer-string)) (with-current-buffer (nnimap-buffer) (setq sequence (nnimap-send-command "APPEND %S {%d}" (utf7-encode group t) @@ -1183,11 +1214,11 @@ (goto-char (point-min)) (while (and (memq (process-status process) '(open run)) - (not (re-search-forward "^\\* .*\n" nil t))) + (not (re-search-forward "^[*.] .*\n" nil t))) (nnheader-accept-process-output process) (goto-char (point-min))) (forward-line -1) - (and (looking-at "\\* \\([A-Z0-9]+\\)") + (and (looking-at "[*.] \\([A-Z0-9]+\\)") (match-string 1)))) (defun nnimap-wait-for-response (sequence &optional messagep) @@ -1299,6 +1330,8 @@ (nnmail-split-methods (if (eq nnimap-split-methods 'default) nnmail-split-methods nnimap-split-methods)) + (nnmail-split-fancy (or nnimap-split-fancy + nnmail-split-fancy)) (nnmail-inhibit-default-split-group t) (groups (nnimap-get-groups)) new-articles) diff -r 49d445615c07 -r 3b9bd3888ee9 lisp/gnus/nnir.el --- a/lisp/gnus/nnir.el Thu Sep 30 16:26:40 2010 -0700 +++ b/lisp/gnus/nnir.el Fri Oct 01 00:25:50 2010 +0000 @@ -881,7 +881,9 @@ (when (file-readable-p (concat prefix dirnam article)) ;; remove trailing slash and, for nnmaildir, cur/new/tmp (setq dirnam - (substring dirnam 0 (if (string= server "nnmaildir:") -5 -1))) + (substring dirnam 0 + (if (string= (gnus-group-server server) "nnmaildir") + -5 -1))) ;; Set group to dirnam without any leading dots or slashes, ;; and with all subsequent slashes replaced by dots @@ -890,7 +892,7 @@ "[/\\]" "." t))) (vector (nnir-group-full-name group server) - (if (string= server "nnmaildir:") + (if (string= (gnus-group-server server) "nnmaildir") (nnmaildir-base-name-to-article-number (substring article 0 (string-match ":" article)) group nil) @@ -1200,7 +1202,7 @@ ;; is sufficient. Note that we can't only use the value of ;; nnml-use-compressed-files because old articles might have been ;; saved with a different value. - (article-pattern (if (string= server "nnmaildir:") + (article-pattern (if (string= (gnus-group-server server) "nnmaildir") ":[0-9]+" "^[0-9]+\\(\\.[a-z0-9]+\\)?$")) score artno dirnam filenam) @@ -1450,7 +1452,7 @@ (when group (error "The Namazu backend cannot search specific groups")) (save-excursion - (let ((article-pattern (if (string= server "nnmaildir:") + (let ((article-pattern (if (string= (gnus-group-server server) "nnmaildir") ":[0-9]+" "^[0-9]+$")) artlist diff -r 49d445615c07 -r 3b9bd3888ee9 lisp/gnus/nnrss.el --- a/lisp/gnus/nnrss.el Thu Sep 30 16:26:40 2010 -0700 +++ b/lisp/gnus/nnrss.el Fri Oct 01 00:25:50 2010 +0000 @@ -77,7 +77,8 @@ (defvar nnrss-group-alist '() "List of RSS addresses.") -(defvar nnrss-use-local nil) +(defvar nnrss-use-local nil + "If non-nil nnrss will read the feeds from local files in nnrss-directory.") (defvar nnrss-description-field 'X-Gnus-Description "Field name used for DESCRIPTION. diff -r 49d445615c07 -r 3b9bd3888ee9 lisp/gnus/nntp.el --- a/lisp/gnus/nntp.el Thu Sep 30 16:26:40 2010 -0700 +++ b/lisp/gnus/nntp.el Fri Oct 01 00:25:50 2010 +0000 @@ -267,6 +267,11 @@ "*Hook run just before posting an article. It is supposed to be used to insert Cancel-Lock headers.") +(defvoo nntp-server-list-active-group 'try + "If nil, then always use GROUP instead of LIST ACTIVE. +This is usually slower, but on misconfigured servers that don't +update their active files often, this can help.") + ;;; Internal variables. (defvar nntp-record-commands nil @@ -296,7 +301,6 @@ (defvoo nntp-inhibit-output nil) (defvoo nntp-server-xover 'try) -(defvoo nntp-server-list-active-group 'try) (defvar nntp-async-timer nil) (defvar nntp-async-process-list nil) diff -r 49d445615c07 -r 3b9bd3888ee9 lisp/gnus/webmail.el --- a/lisp/gnus/webmail.el Thu Sep 30 16:26:40 2010 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,836 +0,0 @@ -;;; webmail.el --- interface of web mail - -;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. - -;; Author: Shenghuo Zhu -;; Keywords: hotmail netaddress - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;; Note: Now mail.yahoo.com provides POP3 service, the webmail -;; fetching is not going to be supported. - -;; Note: You need to have `url' and `w3' installed for this backend to -;; work. `w3' must be 4.0pre46+one-line-cookie patch or standalone -;; `url'. - -;; Todo: To support more web mail servers. - -;; Known bugs: -;; 1. Net@ddress may corrupt `X-Face'. - -;; Warning: -;; Webmail is an experimental function, which means NO WARRANTY. - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'nnoo) -(require 'message) -(require 'gnus-util) -(require 'gnus) -(require 'nnmail) -(require 'mm-util) -(require 'mm-url) -(require 'mml) -(eval-when-compile - (ignore-errors - (require 'url) - (require 'url-cookie))) -;; Report failure to find w3 at load time if appropriate. -(eval '(progn - (require 'url) - (require 'url-cookie))) - -;;; - -(defvar webmail-type-definition - '((hotmail - ;; Hotmail hate other HTTP user agents and use one line cookie - (paranoid agent cookie post) - (address . "www.hotmail.com") - (open-url "http://www.hotmail.com/") - (open-snarf . webmail-hotmail-open) - ;; W3 hate redirect POST - (login-url - "http://%s/cgi-bin/dologin?login=%s&passwd=%s&enter=Sign+in&sec=no&curmbox=ACTIVE&_lang=&js=yes&id=2&tw=-10000&beta=" - webmail-aux user password) - ;;(login-snarf . webmail-hotmail-login) - ;;(list-url "%s" webmail-aux) - (list-snarf . webmail-hotmail-list) - (article-snarf . webmail-hotmail-article) - (trash-url - "%s&login=%s&f=33792&curmbox=ACTIVE&_lang=&foo=inbox&js=&page=&%s=on&_HMaction=MoveTo&tobox=trAsH&nullbox=" - webmail-aux user id)) - (yahoo - (paranoid agent cookie post) - (address . "mail.yahoo.com") - (open-url "http://mail.yahoo.com/") - (open-snarf . webmail-yahoo-open) - (login-url;; yahoo will not accept GET - content - ("%s" webmail-aux) - ".tries=&.src=ym&.last=&promo=&.intl=&.bypass=&.partner=&.chkP=Y&.done=&login=%s&passwd=%s" - user password) - (login-snarf . webmail-yahoo-login) - (list-url "%s&rb=Inbox&YN=1" webmail-aux) - (list-snarf . webmail-yahoo-list) - (article-snarf . webmail-yahoo-article) - (trash-url - "%s/ym/ShowFolder?YY=52107&inc=50&order=down&sort=date&pos=0&box=Inbox&DEL=Delete&destBox=&Mid=%s&destBox2=" - webmail-aux id)) - (netaddress - (paranoid cookie post) - (address . "www.netaddress.com") - (open-url "http://www.netaddress.com/") - (open-snarf . webmail-netaddress-open) - (login-url - content - ("%s" webmail-aux) - "LoginState=2&SuccessfulLogin=%%2Ftpl&NewServerName=www.netaddress.com&JavaScript=JavaScript1.2&DomainID=4&Domain=usa.net&NA31site=classic.netaddress.com&NA31port=80&UserID=%s&passwd=%s" - user password) - (login-snarf . webmail-netaddress-login) - (list-url - "http://www.netaddress.com/tpl/Mail/%s/List?FolderID=-4&SortUseCase=True" - webmail-session) - (list-snarf . webmail-netaddress-list) - (article-url "http://www.netaddress.com/") - (article-snarf . webmail-netaddress-article) - (trash-url - "http://www.netaddress.com/tpl/Message/%s/Move?FolderID=-4&Q=%s&N=&Sort=Date&F=-1" - webmail-session id)))) - -(defvar webmail-variables - '(address article-snarf article-url list-snarf list-url - login-url login-snarf open-url open-snarf site articles - post-process paranoid trash-url)) - -(defconst webmail-version "webmail 1.0") - -(defvar webmail-newmail-only nil - "Only fetch new mails.") - -(defvar webmail-move-to-trash-can t - "Move mail to trash can after fetch it.") - -;;; Internal variables - -(defvar webmail-address nil) -(defvar webmail-paranoid nil) -(defvar webmail-aux nil) -(defvar webmail-session nil) -(defvar webmail-article-snarf nil) -(defvar webmail-article-url nil) -(defvar webmail-list-snarf nil) -(defvar webmail-list-url nil) -(defvar webmail-login-url nil) -(defvar webmail-login-snarf nil) -(defvar webmail-open-snarf nil) -(defvar webmail-open-url nil) -(defvar webmail-trash-url nil) -(defvar webmail-articles nil) -(defvar webmail-post-process nil) - -(defvar webmail-buffer nil) -(defvar webmail-buffer-list nil) - -(defvar webmail-type nil) - -(defvar webmail-error-function nil) - -(defvar webmail-debug-file "~/.emacs-webmail-debug") - -;;; Interface functions - -(defun webmail-debug (str) - (with-temp-buffer - (insert "\n---------------- A bug at " str " ------------------\n") - (dolist (sym '(webmail-type user)) - (if (boundp sym) - (gnus-pp `(setq ,sym ',(eval sym))))) - (insert "---------------- webmail buffer ------------------\n\n") - (insert-buffer-substring webmail-buffer) - (insert "\n---------------- end of buffer ------------------\n\n") - (append-to-file (point-min) (point-max) webmail-debug-file))) - -(defun webmail-error (str) - (if webmail-error-function - (funcall webmail-error-function str)) - (message "%s HTML has changed or your w3 package is too old.(%s)" - webmail-type str) - (error "%s HTML has changed or your w3 package is too old.(%s)" - webmail-type str)) - -(defun webmail-setdefault (type) - (let ((type-def (cdr (assq type webmail-type-definition))) - (vars webmail-variables) - pair) - (setq webmail-type type) - (dolist (var vars) - (if (setq pair (assq var type-def)) - (set (intern (concat "webmail-" (symbol-name var))) (cdr pair)) - (set (intern (concat "webmail-" (symbol-name var))) nil))))) - -(defun webmail-eval (expr) - (cond - ((consp expr) - (cons (webmail-eval (car expr)) (webmail-eval (cdr expr)))) - ((symbolp expr) - (eval expr)) - (t - expr))) - -(defun webmail-url (xurl) - (mm-with-unibyte-current-buffer - (cond - ((eq (car xurl) 'content) - (pop xurl) - (mm-url-fetch-simple (if (stringp (car xurl)) - (car xurl) - (apply 'format (webmail-eval (car xurl)))) - (apply 'format (webmail-eval (cdr xurl))))) - ((eq (car xurl) 'post) - (pop xurl) - (mm-url-fetch-form (car xurl) (webmail-eval (cdr xurl)))) - (t - (mm-url-insert (apply 'format (webmail-eval xurl))))))) - -(defun webmail-init () - "Initialize buffers and such." - (if (gnus-buffer-live-p webmail-buffer) - (set-buffer webmail-buffer) - (setq webmail-buffer - (nnheader-set-temp-buffer " *webmail*")) - (mm-disable-multibyte))) - -(defvar url-package-name) -(defvar url-package-version) -(defvar url-cookie-multiple-line) -(defvar url-confirmation-func) - -;; Hack W3 POST redirect. See `url-parse-mime-headers'. -;; -;; Netscape uses "GET" as redirect method when orignal method is POST -;; and status is 302, .i.e no security risks by default without -;; confirmation. -;; -;; Some web servers (at least Apache used by yahoo) return status 302 -;; instead of 303, though they mean 303. - -(defun webmail-url-confirmation-func (prompt) - (cond - ((equal prompt (concat "Honor redirection with non-GET method " - "(possible security risks)? ")) - nil) - ((equal prompt "Continue (with method of GET)? ") - t) - (t (error prompt)))) - -(defun webmail-refresh-redirect () - "Redirect refresh url in META." - (goto-char (point-min)) - (while (re-search-forward - "]*URL=\\([^\"]+\\)\"" - nil t) - (let ((url (match-string 1))) - (erase-buffer) - (mm-with-unibyte-current-buffer - (mm-url-insert url))) - (goto-char (point-min)))) - -(defun webmail-fetch (file subtype user password) - (save-excursion - (webmail-setdefault subtype) - (let ((url-package-name (if (memq 'agent webmail-paranoid) - "Mozilla" - url-package-name)) - (url-package-version (if (memq 'agent webmail-paranoid) - "4.0" - url-package-version)) - (url-cookie-multiple-line (if (memq 'cookie webmail-paranoid) - nil - url-cookie-multiple-line)) - (url-confirmation-func (if (memq 'post webmail-paranoid) - 'webmail-url-confirmation-func - url-confirmation-func)) - (url-http-silence-on-insecure-redirection t) - url-cookie-storage url-cookie-secure-storage - url-cookie-confirmation - item id (n 0)) - (webmail-init) - (setq webmail-articles nil) - (when webmail-open-url - (erase-buffer) - (webmail-url webmail-open-url)) - (if webmail-open-snarf (funcall webmail-open-snarf)) - (when webmail-login-url - (erase-buffer) - (webmail-url webmail-login-url)) - (if webmail-login-snarf - (funcall webmail-login-snarf)) - (when webmail-list-url - (erase-buffer) - (webmail-url webmail-list-url)) - (if webmail-list-snarf - (funcall webmail-list-snarf)) - (while (setq item (pop webmail-articles)) - (message "Fetching mail #%d..." (setq n (1+ n))) - (erase-buffer) - (mm-with-unibyte-current-buffer - (mm-url-insert (cdr item))) - (setq id (car item)) - (if webmail-article-snarf - (funcall webmail-article-snarf file id)) - (when (and webmail-trash-url webmail-move-to-trash-can) - (message "Move mail #%d to trash can..." n) - (condition-case err - (progn - (webmail-url webmail-trash-url) - (let (buf) - (while (setq buf (pop webmail-buffer-list)) - (kill-buffer buf)))) - (error - (let (buf) - (while (setq buf (pop webmail-buffer-list)) - (kill-buffer buf))) - (error err)))))) - (if webmail-post-process - (funcall webmail-post-process)))) - -(defun webmail-encode-8bit () - (goto-char (point-min)) - (skip-chars-forward "^\200-\377") - (while (not (eobp)) - (insert (format "&%d;" (mm-char-int (char-after)))) - (delete-char 1) - (skip-chars-forward "^\200-\377"))) - -;;; hotmail - -(defun webmail-hotmail-open () - (goto-char (point-min)) - (if (re-search-forward - "action=\"https?://\\([^/]+\\)/cgi-bin/dologin" nil t) - (setq webmail-aux (match-string 1)) - (webmail-error "open@1"))) - -(defun webmail-hotmail-login () - (let (site) - (goto-char (point-min)) - (if (re-search-forward - "https?://\\([^/]+hotmail\\.msn\\.com\\)/cgi-bin/" nil t) - (setq site (match-string 1)) - (webmail-error "login@1")) - (goto-char (point-min)) - (if (re-search-forward - "\\(/cgi-bin/HoTMaiL\\?[^\"]*a=b[^\"]*\\)" nil t) - (setq webmail-aux (concat "http://" site (match-string 1))) - (webmail-error "login@2")))) - -(defun webmail-hotmail-list () - (goto-char (point-min)) - (skip-chars-forward " \t\n\r") - (let (site url newp (total "0")) - (if (eobp) - (setq total "0") - (if (re-search-forward "\\([0-9]+\\) *(\\([0-9]+\\) new)" nil t) - (message "Found %s (%s new)" (setq total (match-string 1)) - (match-string 2)) - (if (re-search-forward "\\([0-9]+\\) new" nil t) - (message "Found %s new" (setq total (match-string 1))) - (webmail-error "list@0")))) - (unless (equal total "0") - (goto-char (point-min)) - (if (re-search-forward - "https?://\\([^/]+hotmail\\.msn\\.com\\)/cgi-bin/" nil t) - (setq site (match-string 1)) - (webmail-error "list@1")) - (goto-char (point-min)) - (if (re-search-forward "disk=\\([^&]*\\)&" nil t) - (setq webmail-aux - (concat "http://" site "/cgi-bin/HoTMaiL?disk=" - (match-string 1))) - (webmail-error "list@2")) - (goto-char (point-max)) - (while (re-search-backward - "newmail\\.gif\\|href=\"\\(/cgi-bin/getmsg\\?[^\"]+\\)\"" - nil t) - (if (setq url (match-string 1)) - (progn - (if (or newp (not webmail-newmail-only)) - (let (id) - (if (string-match "msg=\\([^&]+\\)" url) - (setq id (match-string 1 url))) - (push (cons id (concat "http://" site url "&raw=0")) - webmail-articles))) - (setq newp nil)) - (setq newp t)))))) - -;; Thank victor@idaccr.org (Victor S. Miller) for raw=0 - -(defun webmail-hotmail-article (file id) - (goto-char (point-min)) - (skip-chars-forward " \t\n\r") - (unless (eobp) - (if (not (search-forward "
" nil t))
-	(webmail-error "article@3"))
-    (skip-chars-forward "\n\r\t ")
-    (delete-region (point-min) (point))
-    (if (not (search-forward "
" nil t)) - (webmail-error "article@3.1")) - (delete-region (match-beginning 0) (point-max)) - (mm-url-remove-markup) - (mm-url-decode-entities-nbsp) - (goto-char (point-min)) - (while (re-search-forward "\r\n?" nil t) - (replace-match "\n")) - (goto-char (point-min)) - (insert "\n\n") - (if (not (looking-at "\n*From ")) - (insert "From nobody " (current-time-string) "\n") - (forward-line)) - (insert "X-Gnus-Webmail: " (symbol-value 'user) - "@" (symbol-name webmail-type) "\n") - (mm-append-to-file (point-min) (point-max) file))) - -(defun webmail-hotmail-article-old (file id) - (let (p attachment count mime hotmail-direct) - (save-restriction - (webmail-encode-8bit) - (goto-char (point-min)) - (if (not (search-forward "
" nil t)) - (if (not (search-forward "Reply All" nil t)) - (webmail-error "article@1") - (setq hotmail-direct t)) - (goto-char (match-beginning 0))) - (narrow-to-region (point-min) (point)) - (if (not (search-backward "" nil t) - (delete-region p (match-end 0))) - (mm-url-remove-markup) - (mm-url-decode-entities-nbsp) - (goto-char (point-min)) - (delete-blank-lines) - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - (backward-char) - (delete-region (point) (point-max))) - (goto-char (point-max)) - (widen) - (insert "\n") - (setq p (point)) - (while (re-search-forward - "\\|
\\|\\(http://[^/]+/cgi-bin/getmsg/\\([^\?]+\\)\?[^\"]*\\)\"" - nil t) - (if (setq attachment (match-string 1)) - (let ((filename (match-string 2)) - bufname);; Attachment - (delete-region p (match-end 0)) - (save-excursion - (set-buffer (generate-new-buffer " *webmail-att*")) - (mm-url-insert attachment) - (push (current-buffer) webmail-buffer-list) - (setq bufname (buffer-name))) - (setq mime t) - (insert "<#part type=" - (or (and filename - (string-match "\\.[^\\.]+$" filename) - (mailcap-extension-to-mime - (match-string 0 filename))) - "application/octet-stream")) - (insert " buffer=\"" bufname "\"") - (insert " filename=\"" filename "\"") - (insert " disposition=\"inline\"") - (insert "><#/part>\n") - (setq p (point))) - (delete-region p (match-end 0)) - (if hotmail-direct - (if (not (search-forward "" nil t)) - (webmail-error "article@1.2") - (delete-region (match-beginning 0) (match-end 0))) - (setq count 1) - (while (and (> count 0) - (re-search-forward "
\\|\\(
\\)" nil t)) - (if (match-string 1) - (setq count (1+ count)) - (if (= (setq count (1- count)) 0) - (delete-region (match-beginning 0) - (match-end 0)))))) - (narrow-to-region p (point)) - (goto-char (point-min)) - (cond - ((looking-at "
")
-	    (goto-char (match-end 0))
-	    (if (looking-at "$") (forward-char))
-	    (delete-region (point-min) (point))
-	    (mm-url-remove-markup)
-	    (mm-url-decode-entities-nbsp)
-	    nil)
-	   (t
-	    (setq mime t)
-	    (insert "<#part type=\"text/html\" disposition=inline>")
-	    (goto-char (point-max))
-	    (insert "<#/part>")))
-	  (goto-char (point-max))
-	  (setq p (point))
-	  (widen)))
-      (delete-region p (point-max))
-      (goto-char (point-min))
-      ;; Some blank line to separate mails.
-      (insert "\n\nFrom nobody " (current-time-string) "\n")
-      (insert "X-Gnus-Webmail: " (symbol-value 'user)
-	      "@" (symbol-name webmail-type) "\n")
-      (if id
-	  (insert (format "X-Message-ID: <%s@hotmail.com>\n" id)))
-      (unless (looking-at "$")
-	(if (search-forward "\n\n" nil t)
-	    (forward-line -1)
-	  (webmail-error "article@2")))
-      (narrow-to-region (point) (point-max))
-      (if mime
-	  (insert "MIME-Version: 1.0\n"
-		  (prog1
-		      (mml-generate-mime)
-		    (delete-region (point-min) (point-max)))))
-      (goto-char (point-min))
-      (widen)
-      (let (case-fold-search)
-	(while (re-search-forward "^From " nil t)
-	  (beginning-of-line)
-	  (insert ">"))))
-    (mm-append-to-file (point-min) (point-max) file)))
-
-;;; yahoo
-
-(defun webmail-yahoo-open ()
-  (goto-char (point-min))
-  (if (re-search-forward "action=\"\\([^\"]+\\)\"" nil t)
-      (setq webmail-aux (match-string 1))
-    (webmail-error "open@1")))
-
-(defun webmail-yahoo-login ()
-  (goto-char (point-min))
-  (if (re-search-forward "http://[^/]+[0-9]\\.mail\\.yahoo\\.com/" nil t)
-      (setq webmail-aux (match-string 0))
-    (webmail-error "login@1"))
-  (if (re-search-forward "YY=[0-9]+" nil t)
-      (setq webmail-aux (concat webmail-aux "ym/ShowFolder?"
-				(match-string 0)))
-    (webmail-error "login@2")))
-
-(defun webmail-yahoo-list ()
-  (let (url (newp t) (tofetch 0))
-    (goto-char (point-min))
-    (when (re-search-forward
-	   "showing [0-9]+-\\([0-9]+\\) of \\([0-9]+\\)" nil t)
-      ;;(setq listed (match-string 1))
-      (message "Found %s mail(s)" (match-string 2)))
-    (if (string-match "http://[^/]+" webmail-aux)
-	(setq webmail-aux (match-string 0 webmail-aux))
-      (webmail-error "list@1"))
-    (goto-char (point-min))
-    (while (re-search-forward
-	    "bgcolor=\"#eeeeee\"\\|href=\"\\(/ym/ShowLetter\\?MsgId=\\([^&]+\\)&[^\"]*\\)\""
-	    nil t)
-      (if (setq url (match-string 1))
-	  (progn
-	    (when (or newp (not webmail-newmail-only))
-	      (push (cons (match-string 2) (concat webmail-aux url "&toc=1"))
-		    webmail-articles)
-	      (setq tofetch (1+ tofetch)))
-	    (setq newp t))
-	(setq newp nil)))
-    (setq webmail-articles (nreverse webmail-articles))
-    (message "Fetching %d mail(s)" tofetch)))
-
-(defun webmail-yahoo-article (file id)
-  (let (p attachment)
-    (save-restriction
-      (goto-char (point-min))
-      (if (not (search-forward "value=\"Done\"" nil t))
-	  (webmail-error "article@1"))
-      (if (not (search-forward "" nil t))
-	  (webmail-error "article@3"))
-      (narrow-to-region (point-min) (match-end 0))
-      (while (search-forward "" nil t)
-	(delete-region p (match-end 0)))
-      (mm-url-remove-markup)
-      (mm-url-decode-entities-nbsp)
-      (goto-char (point-min))
-      (delete-blank-lines)
-      (goto-char (point-max))
-      (widen)
-      (insert "\n")
-      (setq p (point))
-      (while (re-search-forward "[^\"]*/ShowLetter/[^\?]+\?[^\"]*" nil t)
-	(setq attachment (match-string 0))
-	(let (bufname ct ctl cd description)
-	  (if (not (search-forward "" nil t))
-	      (webmail-error "article@5"))
-	  (narrow-to-region p (match-end 0))
-	  (mm-url-remove-markup)
-	  (mm-url-decode-entities-nbsp)
-	  (goto-char (point-min))
-	  (delete-blank-lines)
-	  (setq ct (mail-fetch-field "content-type")
-		ctl (and ct (mail-header-parse-content-type ct))
-		;;cte (mail-fetch-field "content-transfer-encoding")
-		cd (mail-fetch-field "content-disposition")
-		description (mail-fetch-field "content-description")
-		id (mail-fetch-field "content-id"))
-	  (delete-region (point-min) (point-max))
-	  (widen)
-	  (save-excursion
-	    (set-buffer (generate-new-buffer " *webmail-att*"))
-	    (mm-url-insert (concat webmail-aux attachment))
-	    (push (current-buffer) webmail-buffer-list)
-	    (setq bufname (buffer-name)))
-	  (insert "<#part")
-	  (if (and ctl (not (equal (car ctl) "text/")))
-	      (insert " type=\"" (car ctl) "\""))
-	  (insert " buffer=\"" bufname "\"")
-	  (if cd
-	      (insert " disposition=\"" cd "\""))
-	  (if description
-	      (insert " description=\"" description "\""))
-	  (insert "><#/part>\n")
-	  (setq p (point))))
-      (delete-region p (point-max))
-      (goto-char (point-min))
-      ;; Some blank line to separate mails.
-      (insert "\n\nFrom nobody " (current-time-string) "\n")
-      (insert "X-Gnus-Webmail: " (symbol-value 'user)
-	      "@" (symbol-name webmail-type) "\n")
-      (if id
-	  (insert (format "X-Message-ID: <%s@yahoo.com>\n" id)))
-      (unless (looking-at "$")
-	(if (search-forward "\n\n" nil t)
-	    (forward-line -1)
-	  (webmail-error "article@2")))
-      (narrow-to-region (point) (point-max))
-      (insert "MIME-Version: 1.0\n"
-	      (prog1
-		  (mml-generate-mime)
-		(delete-region (point-min) (point-max))))
-      (goto-char (point-min))
-      (widen)
-      (let (case-fold-search)
-	(while (re-search-forward "^From " nil t)
-	  (beginning-of-line)
-	  (insert ">"))))
-    (mm-append-to-file (point-min) (point-max) file)))
-
-;;; netaddress
-
-(defun webmail-netaddress-open ()
-  (goto-char (point-min))
-  (if (re-search-forward "action=\"\\([^\"]+\\)\"" nil t)
-      (setq webmail-aux (concat (car webmail-open-url) (match-string 1)))
-    (webmail-error "open@1")))
-
-(defun webmail-netaddress-login ()
-  (webmail-refresh-redirect)
-  (goto-char (point-min))
-  (if (re-search-forward  "tpl/[^/]+/\\([^/]+\\)" nil t)
-      (setq webmail-session (match-string 1))
-    (webmail-error "login@1")))
-
-(defun webmail-netaddress-list ()
-  (webmail-refresh-redirect)
-  (let (item id)
-    (goto-char (point-min))
-    (when (re-search-forward
-	   "(\\([0-9]+\\) unread, \\([0-9]+\\) total)" nil t)
-      (message "Found %s mail(s), %s unread"
-	       (match-string 2) (match-string 1)))
-    (goto-char (point-min))
-    (while (re-search-forward
-	    "MR\\[i\\]\\.R='\\([^']*\\)'\\|MR\\[i\\]\\.Q='\\([^']+\\)'" nil t)
-      (if (setq id (match-string 2))
-	  (setq item
-		(cons id
-		      (format "%s/tpl/Message/%s/Read?Q=%s&FolderID=-4&SortUseCase=True&Sort=Date&Headers=True"
-			      (car webmail-article-url)
-			      webmail-session id)))
-	(if (or (not webmail-newmail-only)
-		(equal (match-string 1) "True"))
-	    (push item webmail-articles))))
-    (setq webmail-articles (nreverse webmail-articles))))
-
-(defun webmail-netaddress-single-part ()
-  (goto-char (point-min))
-  (cond
-   ((looking-at "[\t\040\r\n]*]+>[\t\040\r\n]*")
-    ;; text/plain
-    (replace-match "")
-    (while (re-search-forward "[\t\040\r\n]+" nil t)
-      (replace-match " "))
-    (goto-char (point-min))
-    (while (re-search-forward "
" nil t)
-      (replace-match "\n"))
-    (mm-url-remove-markup)
-    (mm-url-decode-entities-nbsp)
-    nil)
-   (t
-    (insert "<#part type=\"text/html\" disposition=inline>")
-    (goto-char (point-max))
-    (insert "<#/part>")
-    t)))
-
-(defun webmail-netaddress-article (file id)
-  (webmail-refresh-redirect)
-  (let (p p1 attachment count mime type)
-    (save-restriction
-      (webmail-encode-8bit)
-      (goto-char (point-min))
-      (if (not (search-forward "Trash" nil t))
-	  (webmail-error "article@1"))
-      (if (not (search-forward "
" nil t))
-	  (webmail-error "article@2"))
-      (delete-region (point-min) (match-beginning 0))
-      (if (not (search-forward "
" nil t))
-	  (webmail-error "article@3"))
-      (narrow-to-region (point-min) (match-end 0))
-      (goto-char (point-min))
-      (while (re-search-forward "[\040\t\r\n]+" nil t)
-	(replace-match " "))
-      (goto-char (point-min))
-      (while (search-forward "" nil t)
-	(replace-match "\n"))
-      (mm-url-remove-markup)
-      (mm-url-decode-entities-nbsp)
-      (goto-char (point-min))
-      (delete-blank-lines)
-      (goto-char (point-min))
-      (while (re-search-forward "^\040+\\|\040+$" nil t)
-	(replace-match ""))
-      (goto-char (point-min))
-      (while (re-search-forward "\040+" nil t)
-	(replace-match " "))
-      (goto-char (point-max))
-      (widen)
-      (insert "\n\n")
-      (setq p (point))
-      (unless (search-forward "" nil t)
-	(webmail-error "article@4"))
-      (forward-line 14)
-      (delete-region p (point))
-      (goto-char (point-max))
-      (unless (re-search-backward
-	       "[\040\t]*
[\040\t\r\n]*
[\040\t\r\n]*"
-	      nil t 2)
-	(setq mime t)
-	(unless (search-forward "" nil t)
-	  (webmail-error "article@6"))
-	(setq p1 (point))
-	(if (search-backward "" nil t)
-		(webmail-error "article@8"))
-	      (delete-region p (point))
-	      (let (bufname);; Attachment
-		(save-excursion
-		  (set-buffer (generate-new-buffer " *webmail-att*"))
-		  (mm-url-insert (concat (car webmail-open-url) attachment))
-		  (push (current-buffer) webmail-buffer-list)
-		  (setq bufname (buffer-name)))
-		(insert "<#part type=" type)
-		(insert " buffer=\"" bufname "\"")
-		(insert " disposition=\"inline\"")
-		(insert "><#/part>\n")
-		(setq p (point))))
-	  (delete-region p p1)
-	  (narrow-to-region
-	   p
-	   (if (search-forward
-		""
-		nil t)
-	       (match-beginning 0)
-	     (point-max)))
-	  (webmail-netaddress-single-part)
-	  (goto-char (point-max))
-	  (setq p (point))
-	  (widen)))
-      (unless mime
-	(narrow-to-region p (point-max))
-	(setq mime (webmail-netaddress-single-part))
-	(widen))
-      (goto-char (point-min))
-      ;; Some blank line to separate mails.
-      (insert "\n\nFrom nobody " (current-time-string) "\n")
-      (insert "X-Gnus-Webmail: " (symbol-value 'user)
-	      "@" (symbol-name webmail-type) "\n")
-      (if id
-	  (insert (format "X-Message-ID: <%s@%s>\n" id webmail-address)))
-      (unless (looking-at "$")
-	(if (search-forward "\n\n" nil t)
-	    (forward-line -1)
-	  (webmail-error "article@2")))
-      (when mime
-	(narrow-to-region (point-min) (point))
-	(goto-char (point-min))
-	(while (not (eobp))
-	  (if (looking-at "MIME-Version\\|Content-Type")
-	      (delete-region (point)
-			     (progn
-			       (forward-line 1)
-			       (if (re-search-forward "^[^ \t]" nil t)
-				   (goto-char (match-beginning 0))
-				 (point-max))))
-	    (forward-line 1)))
-	(goto-char (point-max))
-	(widen)
-	(narrow-to-region (point) (point-max))
-	(insert "MIME-Version: 1.0\n"
-		(prog1
-		    (mml-generate-mime)
-		  (delete-region (point-min) (point-max))))
-	(goto-char (point-min))
-	(widen))
-      (let (case-fold-search)
-	(while (re-search-forward "^From " nil t)
-	  (beginning-of-line)
-	  (insert ">"))))
-    (mm-append-to-file (point-min) (point-max) file)))
-
-(provide 'webmail)
-
-;;; webmail.el ends here
diff -r 49d445615c07 -r 3b9bd3888ee9 lisp/net/netrc.el
--- a/lisp/net/netrc.el	Thu Sep 30 16:26:40 2010 -0700
+++ b/lisp/net/netrc.el	Fri Oct 01 00:25:50 2010 +0000
@@ -131,19 +131,23 @@
       ;; No machine name matches, so we look for default entries.
       (while rest
 	(when (assoc "default" (car rest))
-	  (push (car rest) result))
+	  (let ((elem (car rest)))
+	    (setq elem (delete (assoc "default" elem) elem))
+	    (push elem result)))
 	(pop rest)))
     (when result
       (setq result (nreverse result))
-      (while (and result
-		  (not (netrc-port-equal
-			(or port defaultport "nntp")
-			;; when port is not given in the netrc file,
-			;; it should mean "any port"
-			(or (netrc-get (car result) "port")
-			    defaultport port))))
-	(pop result))
-      (car result))))
+      (if (not port)
+	  (car result)
+	(while (and result
+		    (not (netrc-port-equal
+			  (or port defaultport "nntp")
+			  ;; when port is not given in the netrc file,
+			  ;; it should mean "any port"
+			  (or (netrc-get (car result) "port")
+			      defaultport port))))
+	  (pop result))
+	(car result)))))
 
 (defun netrc-machine-user-or-password (mode authinfo-file-or-list machines ports defaults)
   "Get the user name or password according to MODE from AUTHINFO-FILE-OR-LIST.
@@ -238,9 +242,11 @@
 listed in the PORTS list."
   (let ((list (netrc-parse))
 	found)
-    (while (and ports
-		(not found))
-      (setq found (netrc-machine list machine (pop ports))))
+    (if (not ports)
+	(setq found (netrc-machine list machine))
+      (while (and ports
+		  (not found))
+	(setq found (netrc-machine list machine (pop ports)))))
     (when found
       (list (cdr (assoc "login" found))
 	    (cdr (assoc "password" found))))))
diff -r 49d445615c07 -r 3b9bd3888ee9 lisp/net/tls.el
--- a/lisp/net/tls.el	Thu Sep 30 16:26:40 2010 -0700
+++ b/lisp/net/tls.el	Fri Oct 01 00:25:50 2010 +0000
@@ -75,9 +75,14 @@
   :type 'regexp
   :group 'tls)
 
-(defcustom tls-program '("gnutls-cli -p %p %h"
-			 "gnutls-cli -p %p %h --protocols ssl3"
-			 "openssl s_client -connect %h:%p -no_ssl2 -ign_eof")
+(defvar tls-starttls-switches
+  '(("gnutls-cli" "-s")
+    ("openssl" "-starttls imap"))
+  "Alist of programs and the switches necessary to get starttls behaviour.")
+
+(defcustom tls-program '("gnutls-cli %s -p %p %h"
+			 "gnutls-cli %s -p %p %h --protocols ssl3"
+			 "openssl s_client %s -connect %h:%p -no_ssl2 -ign_eof")
   "List of strings containing commands to start TLS stream to a host.
 Each entry in the list is tried until a connection is successful.
 %h is replaced with server hostname, %p with port to connect to.
@@ -199,7 +204,7 @@
 	    (push (cons (match-string 1) (match-string 2)) vals))
 	  (nreverse vals))))))
 
-(defun open-tls-stream (name buffer host port)
+(defun open-tls-stream (name buffer host port &optional starttlsp)
   "Open a TLS connection for a port to a host.
 Returns a subprocess-object to represent the connection.
 Input and output work as for subprocesses; `delete-process' closes it.
@@ -229,6 +234,9 @@
 	       (format-spec
 		cmd
 		(format-spec-make
+		 ?s (if starttlsp
+			(tls-find-starttls-argument cmd)
+		      "")
 		 ?h host
 		 ?p (if (integerp port)
 			(int-to-string port)
@@ -300,6 +308,11 @@
       (kill-buffer buffer))
     done))
 
+(defun tls-find-starttls-argument (command)
+  (let ((command (car (split-string command))))
+    (or (cadr (assoc command tls-starttls-switches))
+	"")))
+
 (provide 'tls)
 
 ;;; tls.el ends here