Mercurial > emacs
changeset 110666:3b9bd3888ee9
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.
| author | Katsumi Yamaoka <yamaoka@jpl.org> |
|---|---|
| date | Fri, 01 Oct 2010 00:25:50 +0000 |
| parents | 49d445615c07 |
| children | a554263b06d4 |
| files | doc/misc/ChangeLog doc/misc/gnus.texi lisp/ChangeLog lisp/gnus/ChangeLog lisp/gnus/gnus-art.el lisp/gnus/gnus-registry.el lisp/gnus/gnus-sum.el lisp/gnus/gnus.el lisp/gnus/mail-source.el lisp/gnus/message.el lisp/gnus/nnimap.el lisp/gnus/nnir.el lisp/gnus/nnrss.el lisp/gnus/nntp.el lisp/gnus/webmail.el lisp/net/netrc.el lisp/net/tls.el |
| diffstat | 17 files changed, 245 insertions(+), 996 deletions(-) [+] |
line wrap: on
line diff
--- 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 <tzz@lifelogs.com> + + * gnus.texi (Spam Package Configuration Examples, SpamOracle): Remove + nnimap-split-rule from examples. + +2010-09-30 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * 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 <julien@danjou.info> + + * gnus.texi (Gravatars): Fix documentation about + gnu-gravatar-properties. + 2010-09-29 Daiki Ueno <ueno@unixuser.org> * epa.texi (Bug Reports): New section. @@ -6,6 +23,16 @@ * Makefile.in (top_srcdir): Remove unused variable. +2010-09-29 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus.texi (Using IMAP): Remove the @acronyms from the headings. + (Client-Side IMAP Splitting): Document 'default. + +2010-09-27 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus.texi (Customizing the IMAP Connection): Document + nnimap-fetch-partial-articles. + 2010-09-26 Lars Magne Ingebrigtsen <larsi@gnus.org> * gnus-news.texi: Mention nnimap-inbox.
--- 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.
--- 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 <larsi@gnus.org> + + * 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 <eliz@gnu.org> * vc/vc-hooks.el (vc-default-mode-line-string): Doc fix.
--- 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 <tzz@lifelogs.com> + + * 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 <jao@gnu.org> (tiny change) + + * gnus-sum.el (gnus-summary-show-thread): Skip past invisible text when + expanding threads. + +2010-09-30 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * 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 <tlikonen@iki.fi> (tiny change) + + * message.el (message-ignored-supersedes-headers): Strip Injection-* + headers before superseding. + +2010-09-30 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * 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 <julien@danjou.info> * 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 <ludo@gnu.org> + + * nnregistry.el: Added. + 2010-09-29 Stefan Monnier <monnier@iro.umontreal.ca> * nnmail.el (group, group-art-list, group-art):
--- 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)
--- 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)
--- 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))
--- 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.
--- 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
--- 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."
--- 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)
--- 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
--- 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.
--- 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)
--- 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 <zsh@cs.rochester.edu> -;; 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 <http://www.gnu.org/licenses/>. - -;;; 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 - "<meta[ \t\r\n]*http-equiv=\"Refresh\"[^>]*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]+\\) *<b>(\\([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 "<pre>" nil t)) - (webmail-error "article@3")) - (skip-chars-forward "\n\r\t ") - (delete-region (point-min) (point)) - (if (not (search-forward "</pre>" 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 "<DIV>" 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 "<table" nil t 2)) - (webmail-error "article@1.1")) - (delete-region (point-min) (match-beginning 0)) - (while (search-forward "<a href=" nil t) - (setq p (match-beginning 0)) - (search-forward "</a>" 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 - "<tt>\\|<div>\\|\\(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 "</tt>" 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 "</div>\\|\\(<div>\\)" 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 "<pre>") - (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 "<table" nil t)) - (webmail-error "article@2")) - (delete-region (point-min) (match-beginning 0)) - (if (not (search-forward "</table>" nil t)) - (webmail-error "article@3")) - (narrow-to-region (point-min) (match-end 0)) - (while (search-forward "<a href=" nil t) - (setq p (match-beginning 0)) - (search-forward "</a>" 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 "<table" nil t)) - (webmail-error "article@4")) - (delete-region p (match-beginning 0)) - (if (not (search-forward "</table>" 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]*<font face=[^>]+>[\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 "<br>" 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 "<form>" nil t)) - (webmail-error "article@2")) - (delete-region (point-min) (match-beginning 0)) - (if (not (search-forward "</form>" 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 "<b>" 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 "<!-- Data -->" nil t) - (webmail-error "article@4")) - (forward-line 14) - (delete-region p (point)) - (goto-char (point-max)) - (unless (re-search-backward - "[\040\t]*<br>[\040\t\r\n]*<br>[\040\t\r\n]*<form" p t) - (webmail-error "article@5")) - (delete-region (point) (point-max)) - (goto-char p) - (while (search-forward - "<TABLE border=\"0\" WIDTH=\"98%\" cellpadding=0 cellspacing=0>" - nil t 2) - (setq mime t) - (unless (search-forward "</TABLE>" nil t) - (webmail-error "article@6")) - (setq p1 (point)) - (if (search-backward "<IMG " p t) - (progn - (unless (re-search-forward "HREF=\"\\(/tpl/Attachment/[^/]+/\\([^/]+/[^\?]+\\)[^\"]+\\)\"" p1 t) - (webmail-error "article@7")) - (setq attachment (match-string 1)) - (setq type (match-string 2)) - (unless (search-forward "</TABLE>" 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 - "<TABLE border=\"0\" WIDTH=\"98%\" cellpadding=0 cellspacing=0>" - 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
--- 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))))))
--- 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