Mercurial > emacs
changeset 87097:781256628613
Merge from gnus--devo--0
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-941
author | Miles Bader <miles@gnu.org> |
---|---|
date | Thu, 06 Dec 2007 00:21:00 +0000 |
parents | a99a2e8bc21e |
children | ec0ef12211d9 |
files | doc/misc/ChangeLog doc/misc/emacs-mime.texi doc/misc/gnus.texi lisp/ChangeLog lisp/gnus/ChangeLog lisp/gnus/gnus-agent.el lisp/gnus/gnus-art.el lisp/gnus/gnus-cache.el lisp/gnus/gnus-dired.el lisp/gnus/gnus-group.el lisp/gnus/gnus-int.el lisp/gnus/gnus-kill.el lisp/gnus/gnus-move.el lisp/gnus/gnus-msg.el lisp/gnus/gnus-srvr.el lisp/gnus/gnus-start.el lisp/gnus/gnus-sum.el lisp/gnus/gnus-uu.el lisp/gnus/gnus.el lisp/gnus/mail-source.el lisp/gnus/mailcap.el lisp/gnus/message.el lisp/gnus/mm-uu.el lisp/gnus/nnkiboze.el lisp/gnus/nnmail.el lisp/gnus/rfc2047.el lisp/gnus/yenc.el lisp/net/imap.el lisp/net/tls.el |
diffstat | 29 files changed, 712 insertions(+), 212 deletions(-) [+] |
line wrap: on
line diff
--- a/doc/misc/ChangeLog Thu Dec 06 00:17:56 2007 +0000 +++ b/doc/misc/ChangeLog Thu Dec 06 00:21:00 2007 +0000 @@ -1,3 +1,27 @@ +2007-12-03 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus.texi (Other Files): Add the yenc command. + +2007-11-30 Reiner Steib <Reiner.Steib@gmx.de> + + * gnus.texi (MIME Commands): Default of gnus-article-loose-mime is t + since 2004-08-06. + +2007-11-28 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus.texi (Fancy Mail Splitting): Fix description of splitting based + on body. + +2007-11-27 Katsumi Yamaoka <yamaoka@jpl.org> + + * emacs-mime.texi (rfc2047): Mention rfc2047-encoded-word-regexp-loose + and rfc2047-allow-irregular-q-encoded-words; fix description of + rfc2047-encode-encoded-words. + +2007-11-24 Reiner Steib <Reiner.Steib@gmx.de> + + * gnus.texi (Fetching Mail): Remove obsoleted `nnmail-spool-file'. + 2007-12-05 Michael Olson <mwolson@gnu.org> * remember.texi (Diary): Remove "require" line for remember-diary.el.
--- a/doc/misc/emacs-mime.texi Thu Dec 06 00:17:56 2007 +0000 +++ b/doc/misc/emacs-mime.texi Thu Dec 06 00:21:00 2007 +0000 @@ -1417,10 +1417,23 @@ @vindex rfc2047-encoded-word-regexp When decoding words, this library looks for matches to this regexp. +@item rfc2047-encoded-word-regexp-loose +@vindex rfc2047-encoded-word-regexp-loose +This is a version from which the regexp for the Q encoding pattern of +@code{rfc2047-encoded-word-regexp} is made loose. + @item rfc2047-encode-encoded-words @vindex rfc2047-encode-encoded-words The boolean variable specifies whether encoded words -(e.g. @samp{=?hello?=}) should be encoded again. +(e.g. @samp{=?us-ascii?q?hello?=}) should be encoded again. +@code{rfc2047-encoded-word-regexp} is used to look for such words. + +@item rfc2047-allow-irregular-q-encoded-words +@vindex rfc2047-allow-irregular-q-encoded-words +The boolean variable specifies whether irregular Q encoded words +(e.g. @samp{=?us-ascii?q?hello??=}) should be decoded. If it is +non-@code{nil}, @code{rfc2047-encoded-word-regexp-loose} is used instead +of @code{rfc2047-encoded-word-regexp} to look for encoded words. @end table
--- a/doc/misc/gnus.texi Thu Dec 06 00:17:56 2007 +0000 +++ b/doc/misc/gnus.texi Thu Dec 06 00:21:00 2007 +0000 @@ -8175,6 +8175,11 @@ @findex gnus-uu-decode-binhex Unbinhex the current series (@code{gnus-uu-decode-binhex}). This doesn't really work yet. + +@item X Y +@kindex X Y (Summary) +@findex gnus-uu-decode-yenc +yEnc-decode the current series and save it (@code{gnus-uu-decode-yenc}). @end table @@ -9740,7 +9745,7 @@ If non-@code{nil}, Gnus won't require the @samp{MIME-Version} header before interpreting the message as a @acronym{MIME} message. This helps when reading messages from certain broken mail user agents. The -default is @code{nil}. +default is @code{t}. @item gnus-article-emulate-mime @vindex gnus-article-emulate-mime @@ -14649,14 +14654,12 @@ @subsubsection Fetching Mail @vindex mail-sources -@vindex nnmail-spool-file The way to actually tell Gnus where to get new mail from is to set @code{mail-sources} to a list of mail source specifiers (@pxref{Mail Source Specifiers}). -If this variable (and the obsolescent @code{nnmail-spool-file}) is -@code{nil}, the mail back ends will never attempt to fetch mail by -themselves. +If this variable is @code{nil}, the mail back ends will never attempt to +fetch mail by themselves. If you want to fetch mail both from your local spool as well as a @acronym{POP} mail server, you'd say something like: @@ -14865,9 +14868,9 @@ "string.group")))) @end lisp -The buffer is narrowed to the message in question when @var{function} -is run. That's why @code{(widen)} needs to be called after -@code{save-excursion} and @code{save-restriction} in the example +The buffer is narrowed to the header of the message in question when +@var{function} is run. That's why @code{(widen)} needs to be called +after @code{save-excursion} and @code{save-restriction} in the example above. Also note that with the nnimap back end, message bodies will not be downloaded by default. You need to set @code{nnimap-split-download-body} to @code{t} to do that
--- a/lisp/ChangeLog Thu Dec 06 00:17:56 2007 +0000 +++ b/lisp/ChangeLog Thu Dec 06 00:21:00 2007 +0000 @@ -1,3 +1,37 @@ +2007-12-05 Reiner Steib <Reiner.Steib@gmx.de> + + * net/tls.el (tls-hostmismatch, open-tls-stream): Checkdoc cleanup. + +2007-12-05 Elias Oltmanns <eo@nebensachen.de> + + * net/tls.el (open-tls-stream): Actually consult tls-checktrust to + see if certs should be verified and what is to be done in the + event of a verification failure. + +2007-12-05 Reiner Steib <Reiner.Steib@gmx.de> + + * net/tls.el (tls-program): Provide more custom choices from + `tls-checktrust'. Refer to `tls-checktrust' in doc string. + (tls-process-connection-type, tls-success): Remove "*" in doc string. + (tls-checktrust, tls-hostmismatch, tls-untrusted): Add custom + version. Minor improvement to doc strings. + (tls-program): Add comment. + +2007-12-05 Elias Oltmanns <eo@nebensachen.de> + + * net/tls.el (tls-certtool-program, tls-hostmismatch): New variables. + (tls-checktrust): New variable. Check if GNU TLS complained about a + mismatch between the hostname provided in the certificate and the name + of the host connnecting to. + (open-tls-stream): Use them. Check certificates against trusted root + certificates. + +2007-12-05 Nathan J. Williams <nathanw@MIT.EDU> (tiny change) + + * net/imap.el (imap-mailbox-status-asynch): Upcase STATUS items. + (imap-parse-status): Upcase status-att for broken servers that sends + them lower-case (e.g., MS Exchange 2007). + 2007-12-05 D. Goel <deego3@gmail.com> * simple.el (undo): Ditto.
--- a/lisp/gnus/ChangeLog Thu Dec 06 00:17:56 2007 +0000 +++ b/lisp/gnus/ChangeLog Thu Dec 06 00:21:00 2007 +0000 @@ -1,3 +1,31 @@ +2007-12-04 Reiner Steib <Reiner.Steib@gmx.de> + + * gnus-group.el (gnus-group-highlight-line): Add FIXME. + + * gnus-dired.el: Reduce Gnus dependencies. + (gnus-ems, gnus-msg, gnus-util, message, mm-decode, mml): Don't + require. Use autoloads instead. + (mml-attach-file, mm-default-file-encoding, mailcap-extension-to-mime) + (mailcap-mime-info, mm-mailcap-command, ps-print-preprint) + (message-buffers, gnus-setup-message, gnus-print-buffer): Autoload. + (gnus-dired-mode): Adjust doc string. + (gnus-dired-mail-mode): New variable. + (gnus-dired-mode-map): Avoid using `gnus-define-keys'. + (gnus-dired-mode): Avoid using `gnus-run-hooks'. + (gnus-dired-mail-buffers): New function. Return mail or message + composition buffers. + (gnus-dired-attach): Use it. + (gnus-dired-find-file-mailcap): Call `mailcap-mime-info' with + NO-DECODE. + (gnus-dired-print): Use `gnus-print-buffer' depending on + `gnus-dired-mail-mode'. + +2007-12-04 Katsumi Yamaoka <yamaoka@jpl.org> + + * rfc2047.el (rfc2047-encoded-word-regexp) + (rfc2047-encoded-word-regexp-loose): Move forward; add comments + explaining what regexp patterns are for. + 2007-12-04 Glenn Morris <rgm@gnu.org> * password.el: Move to ../password-cache.el. @@ -15,6 +43,29 @@ * mml-sec.el, sieve-manage.el, smime.el: Require password-cache or password. +2007-12-03 Reiner Steib <Reiner.Steib@gmx.de> + + * mailcap.el: Reduce dependencies. + (mail-header-parse-content-type): Autoload. + (mailcap-delete-duplicates): New alias. + (mailcap-mime-info): Add optional argument NO-DECODE. + (mailcap-mime-types): Use mailcap-delete-duplicates. + + * message.el (message-ignored-supersedes-headers): Add "X-ID". + +2007-12-03 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-sum.el (gnus-uu-extract-map): Add a command for the yenc + function. + + * gnus-uu.el (gnus-uu-decode-yenc): New command. + (gnus-uu-yenc-article): New function. + + * yenc.el (yenc-first-part-p, yenc-last-part-p): New functions. + + * mm-uu.el (mm-uu-yenc-extract): Get the data from the original + buffer. + 2007-12-02 Glenn Morris <rgm@gnu.org> * sasl-cram.el, sasl-digest.el, sasl-ntlm.el, sasl.el: @@ -24,6 +75,20 @@ * encrypt.el: Remove file. +2007-12-01 Reiner Steib <Reiner.Steib@gmx.de> + + * message.el (message-cite-prefix-regexp): Remove `-' and `+' to avoid + matches on patches. + + * gnus-art.el (gnus-article-browse-html-article): Mention + `mm-text-html-renderer' in the doc string. + + * rfc2047.el (rfc2047-encode-max-chars): Refer to RFC 2047 in doc + string. Add comments. + + * message.el (message-idna-to-ascii-rhs-1): Don't call `idna-to-ascii' + if rhs is ASCII. + 2007-12-01 Glenn Morris <rgm@gnu.org> * dig.el, dns.el: Move to ../net. @@ -36,15 +101,91 @@ * encrypt.el: Require password, rather than autoloading password-read. +2007-11-28 Elias Oltmanns <eo@nebensachen.de> + + * gnus.el (gnus-method-to-server): Add an optional parameter so the + caller can indicate whether the cache should be disregarded for this + call. This way the result of the call is reproducible at all times and + can be considered a canonical server name for the supplied method. + (gnus-agent-method-p): Canonicalize server names by pushing their + method through `gnus-method-to-server' using the no-cache argument. + + * gnus-srvr.el (gnus-server-insert-server-line): Call + `gnus-method-to-server' with `no-cache' argument. + + * gnus-agent.el (gnus-agent-toggle-plugged): Don't call + gnus-agent-possibly-synchronize-flags as this should be called when the + server is actually being opened. + (gnus-agent-possibly-synchronize-flags) + (gnus-agent-possibly-synchronize-flags-server): Move check for the + flags file of an agentized server to the latter function. + + * gnus-int.el (gnus-agent-possibly-synchronize-flags-server): Autoload. + (gnus-open-server): Call gnus-agent-possibly-synchronize-flags-server + after a connection has been established successfully. + +2007-11-28 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (article-display-face): Force to display face if called + interactively; check if gnus-article-x-face-too-ugly matches author. + (article-display-x-face): Display face even if From header is missing + as article-display-face does. + 2007-11-28 Richard Stallman <rms@gnu.org> * md4.el: Move to ../. * hmac-def.el, hmac-md5.el, ntlm.el: Move to ../net. +2007-11-27 Reiner Steib <Reiner.Steib@gmx.de> + + * mail-source.el (mail-sources): Default to fetch from file for + compatibility with default of nnmail-spool-file. + +2007-11-27 Katsumi Yamaoka <yamaoka@jpl.org> + + * rfc2047.el (rfc2047-allow-irregular-q-encoded-words): New variable. + (rfc2047-encodable-p): Use rfc2047-encoded-word-regexp instead of "=?" + to look for encoded word that should be encoded again. + (rfc2047-encoded-word-regexp): Make B encoding pattern strict. + (rfc2047-encoded-word-regexp-loose): New constant that has loose Q + encoding pattern. + (rfc2047-decode-region): Switch strict regexp and loose one according + to rfc2047-allow-irregular-q-encoded-words. + 2007-11-26 Simon Josefsson <simon@josefsson.org> * imap.el: Move to ../net directory. +2007-11-25 Romain Francoise <romain@orebokech.com> + + * gnus-msg.el (gnus-summary-reply): Delete extra paren. + +2007-11-24 Reiner Steib <Reiner.Steib@gmx.de> + + * nnmail.el (nnmail-spool-file): Remove obsolete variable. + (nnmail-get-new-mail): Remove code using `nnmail-spool-file'. + + * gnus-start.el (defvar, gnus-get-unread-articles): Remove code using + `nnmail-spool-file'. + + * nnkiboze.el (nnkiboze-generate-groups): Don't bind obsolete + `nnmail-spool-file'. + + * gnus-move.el (gnus-change-server): Ditto. + + * gnus-kill.el (gnus-batch-score): Ditto. + + * gnus-cache.el (gnus-jog-cache): Ditto. + + * gnus-msg.el (gnus-summary-reply): Ignore + gnus-confirm-mail-reply-to-news for wide and very wide replies. + +2007-11-24 Reiner Steib <Reiner.Steib@gmx.de> + + * gnus-cache.el (gnus-cache-generate-nov-databases): Use + nnml-generate-nov-databases-directory instead of + nnml-generate-nov-databases-1. + 2007-11-24 Glenn Morris <rgm@gnu.org> * message.el (message-tool-bar-retro): Update for rename @@ -52,6 +193,11 @@ 2007-11-22 Reiner Steib <Reiner.Steib@gmx.de> + * smime.el (smime-cert-by-ldap-1): Use `ldap-search' instead of + `smime-ldap-search' for Emacs 22 and up. + +2007-11-22 Reiner Steib <Reiner.Steib@gmx.de> + * hashcash.el: Move to ../mail directory. * smime-ldap.el: Remove. Not used in Emacs 22 and up. @@ -87,6 +233,18 @@ (spam-check-crm114, spam-initialize, spam-unload-hook): Fix typos in docstrings. +2007-11-21 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-start.el (gnus-get-unread-articles): Mark groups as having never + been checked if they have never been read and those group levels are + higher than the one that a user specified. + +2007-11-21 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-start.el (gnus-get-unread-articles): Don't prevent from checking + foreign groups unless a group level is specified by a user. + Reported by Dan Nicolaescu <dann@ics.uci.edu>. + 2007-11-21 Reiner Steib <Reiner.Steib@gmx.de> * message.el (message-send-mail-function): Require sendmail.
--- a/lisp/gnus/gnus-agent.el Thu Dec 06 00:17:56 2007 +0000 +++ b/lisp/gnus/gnus-agent.el Thu Dec 06 00:21:00 2007 +0000 @@ -636,8 +636,7 @@ (gnus-agent-make-mode-line-string " Plugged" 'mouse-2 'gnus-agent-toggle-plugged)) - (gnus-agent-go-online gnus-agent-go-online) - (gnus-agent-possibly-synchronize-flags)) + (gnus-agent-go-online gnus-agent-go-online)) (t (gnus-agent-close-connections) (setq gnus-plugged set-to) @@ -868,8 +867,7 @@ (interactive) (save-excursion (dolist (gnus-command-method (gnus-agent-covered-methods)) - (when (and (file-exists-p (gnus-agent-lib-file "flags")) - (eq (gnus-server-status gnus-command-method) 'ok)) + (when (eq (gnus-server-status gnus-command-method) 'ok) (gnus-agent-possibly-synchronize-flags-server gnus-command-method))))) (defun gnus-agent-synchronize-flags-server (method) @@ -905,11 +903,13 @@ (defun gnus-agent-possibly-synchronize-flags-server (method) "Synchronize flags for server according to `gnus-agent-synchronize-flags'." - (when (or (and gnus-agent-synchronize-flags - (not (eq gnus-agent-synchronize-flags 'ask))) - (and (eq gnus-agent-synchronize-flags 'ask) - (gnus-y-or-n-p (format "Synchronize flags on server `%s'? " - (cadr method))))) + (when (and (file-exists-p (gnus-agent-lib-file "flags")) + (or (and gnus-agent-synchronize-flags + (not (eq gnus-agent-synchronize-flags 'ask))) + (and (eq gnus-agent-synchronize-flags 'ask) + (gnus-y-or-n-p + (format "Synchronize flags on server `%s'? " + (cadr method)))))) (gnus-agent-synchronize-flags-server method))) ;;;###autoload
--- a/lisp/gnus/gnus-art.el Thu Dec 06 00:17:56 2007 +0000 +++ b/lisp/gnus/gnus-art.el Thu Dec 06 00:21:00 2007 +0000 @@ -2334,9 +2334,9 @@ (defvar gnus-face-properties-alist) -(defun article-display-face () +(defun article-display-face (&optional force) "Display any Face headers in the header." - (interactive) + (interactive (list 'force)) (let ((wash-face-p buffer-read-only)) (gnus-with-article-headers ;; When displaying parts, this function can be called several times on @@ -2346,7 +2346,8 @@ ;; read-only. (if (and wash-face-p (memq 'face gnus-article-wash-types)) (gnus-delete-images 'face) - (let (face faces from) + (let ((from (message-fetch-field "from")) + face faces) (save-current-buffer (when (and wash-face-p (gnus-buffer-live-p gnus-original-article-buffer) @@ -2354,16 +2355,22 @@ (set-buffer gnus-original-article-buffer)) (save-restriction (mail-narrow-to-head) - (while (gnus-article-goto-header "Face") - (push (mail-header-field-value) faces)))) + (when (or force + ;; Check whether this face is censored. + (not (and gnus-article-x-face-too-ugly + (or from + (setq from (message-fetch-field "from"))) + (string-match gnus-article-x-face-too-ugly + from)))) + (while (gnus-article-goto-header "Face") + (push (mail-header-field-value) faces))))) (when faces (goto-char (point-min)) - (let ((from (gnus-article-goto-header "from")) - png image) - (unless from + (let (png image) + (unless (setq from (gnus-article-goto-header "from")) (insert "From:") (setq from (point)) - (insert "[no `from' set]\n")) + (insert " [no `from' set]\n")) (while faces (when (setq png (gnus-convert-face-to-png (pop faces))) (setq image @@ -2388,7 +2395,8 @@ ;; instead. (gnus-delete-images 'xface) ;; Display X-Faces. - (let (x-faces from face) + (let ((from (message-fetch-field "from")) + x-faces face) (save-current-buffer (when (and wash-face-p (gnus-buffer-live-p gnus-original-article-buffer) @@ -2399,43 +2407,41 @@ (set-buffer gnus-original-article-buffer)) (save-restriction (mail-narrow-to-head) - (while (gnus-article-goto-header "X-Face") - (push (mail-header-field-value) x-faces)) - (setq from (message-fetch-field "from")))) - ;; Sending multiple EOFs to xv doesn't work, so we only do a - ;; single external face. - (when (stringp gnus-article-x-face-command) - (setq x-faces (list (car x-faces)))) - (when (and x-faces - gnus-article-x-face-command - (or force - ;; Check whether this face is censored. - (not gnus-article-x-face-too-ugly) - (and from - (not (string-match gnus-article-x-face-too-ugly - from))))) - (while (setq face (pop x-faces)) - ;; We display the face. - (cond ((stringp gnus-article-x-face-command) - ;; The command is a string, so we interpret the command - ;; as a, well, command, and fork it off. - (let ((process-connection-type nil)) - (gnus-set-process-query-on-exit-flag - (start-process - "article-x-face" nil shell-file-name - shell-command-switch gnus-article-x-face-command) - nil) - (with-temp-buffer - (insert face) - (process-send-region "article-x-face" - (point-min) (point-max))) - (process-send-eof "article-x-face"))) - ((functionp gnus-article-x-face-command) - ;; The command is a lisp function, so we call it. - (funcall gnus-article-x-face-command face)) - (t - (error "%s is not a function" - gnus-article-x-face-command)))))))))) + (and gnus-article-x-face-command + (or force + ;; Check whether this face is censored. + (not (and gnus-article-x-face-too-ugly + (or from + (setq from (message-fetch-field "from"))) + (string-match gnus-article-x-face-too-ugly + from)))) + (while (gnus-article-goto-header "X-Face") + (push (mail-header-field-value) x-faces))))) + (when x-faces + ;; We display the face. + (cond ((functionp gnus-article-x-face-command) + ;; The command is a lisp function, so we call it. + (mapc gnus-article-x-face-command x-faces)) + ((stringp gnus-article-x-face-command) + ;; The command is a string, so we interpret the command + ;; as a, well, command, and fork it off. + (let ((process-connection-type nil)) + (gnus-set-process-query-on-exit-flag + (start-process + "article-x-face" nil shell-file-name + shell-command-switch gnus-article-x-face-command) + nil) + ;; Sending multiple EOFs to xv doesn't work, + ;; so we only do a single external face. + (with-temp-buffer + (insert (car x-faces)) + (process-send-region "article-x-face" + (point-min) (point-max))) + (process-send-eof "article-x-face"))) + (t + (error "`%s' set to `%s' is not a function" + gnus-article-x-face-command + 'gnus-article-x-face-command))))))))) (defun article-decode-mime-words () "Decode all MIME-encoded words in the article." @@ -2823,7 +2829,10 @@ whether you have read the message. As `gnus-article-browse-html-article' passes the unmodified HTML content to the browser without eliminating these \"web bugs\" you -should only use it for mails from trusted senders." +should only use it for mails from trusted senders. + +If you alwasy want to display HTML part in the browser, set +`mm-text-html-renderer' to nil." ;; Cf. `mm-w3m-safe-url-regexp' (interactive) (save-window-excursion
--- a/lisp/gnus/gnus-cache.el Thu Dec 06 00:17:56 2007 +0000 +++ b/lisp/gnus/gnus-cache.el Thu Dec 06 00:21:00 2007 +0000 @@ -92,7 +92,7 @@ (defvar gnus-cache-total-fetched-hashtb nil) (eval-and-compile - (autoload 'nnml-generate-nov-databases-1 "nnml") + (autoload 'nnml-generate-nov-databases-directory "nnml") (autoload 'nnvirtual-find-group-art "nnvirtual")) @@ -620,7 +620,6 @@ (interactive) (let ((gnus-mark-article-hook nil) (gnus-expert-user t) - (nnmail-spool-file nil) (mail-sources nil) (gnus-use-dribble-file nil) (gnus-novice-user nil) @@ -756,7 +755,7 @@ (interactive (list gnus-cache-directory)) (gnus-cache-close) (let ((nnml-generate-active-function 'identity)) - (nnml-generate-nov-databases-1 dir)) + (nnml-generate-nov-databases-directory dir)) (setq gnus-cache-total-fetched-hashtb nil)
--- a/lisp/gnus/gnus-dired.el Thu Dec 06 00:17:56 2007 +0000 +++ b/lisp/gnus/gnus-dired.el Thu Dec 06 00:21:00 2007 +0000 @@ -42,25 +42,55 @@ ;;; Code: (require 'dired) -(require 'gnus-ems) -(require 'gnus-msg) -(require 'gnus-util) -(require 'message) -(require 'mm-encode) -(require 'mml) +(autoload 'mml-attach-file "mml") +(autoload 'mm-default-file-encoding "mm-decode");; Shift this to `mailcap.el'? +(autoload 'mailcap-extension-to-mime "mailcap") +(autoload 'mailcap-mime-info "mailcap") + +;; Maybe shift this function to `mailcap.el'? +(autoload 'mm-mailcap-command "mm-decode") + +(autoload 'ps-print-preprint "ps-print") + +;; Autoloads to avoid byte-compiler warnings. These are used only if the user +;; customizes `gnus-dired-mail-mode' to use Message and/or Gnus. +(autoload 'message-buffers "message") +(autoload 'gnus-setup-message "gnus-msg") +(autoload 'gnus-print-buffer "gnus-sum") (defvar gnus-dired-mode nil - "Minor mode for intersections of gnus and dired.") + "Minor mode for intersections of MIME mail composition and dired.") (defvar gnus-dired-mode-map nil) (unless gnus-dired-mode-map (setq gnus-dired-mode-map (make-sparse-keymap)) - (gnus-define-keys gnus-dired-mode-map - "\C-c\C-m\C-a" gnus-dired-attach - "\C-c\C-m\C-l" gnus-dired-find-file-mailcap - "\C-c\C-m\C-p" gnus-dired-print)) + (define-key gnus-dired-mode-map "\C-c\C-m\C-a" 'gnus-dired-attach) + (define-key gnus-dired-mode-map "\C-c\C-m\C-l" 'gnus-dired-find-file-mailcap) + (define-key gnus-dired-mode-map "\C-c\C-m\C-p" 'gnus-dired-print)) + +;; FIXME: Make it customizable, change the default to `mail-user-agent' when +;; this file if renamed (e.g. to `dired-mime.el'). + +(defcustom gnus-dired-mail-mode 'gnus-user-agent ;; mail-user-agent + "Your preference for a mail composition package. +See `mail-user-agent' for more information." + :group 'mail ;; dired? + :version "23.0" ;; No Gnus + :type '(radio (function-item :tag "Default Emacs mail" + :format "%t\n" + sendmail-user-agent) + (function-item :tag "Emacs interface to MH" + :format "%t\n" + mh-e-user-agent) + (function-item :tag "Gnus Message package" + :format "%t\n" + message-user-agent) + (function-item :tag "Gnus Message with full Gnus features" + :format "%t\n" + gnus-user-agent) + (function :tag "Other"))) (defun gnus-dired-mode (&optional arg) "Minor mode for intersections of gnus and dired. @@ -73,14 +103,31 @@ (> (prefix-numeric-value arg) 0))) (when gnus-dired-mode (add-minor-mode 'gnus-dired-mode "" gnus-dired-mode-map) - (gnus-run-hooks 'gnus-dired-mode-hook)))) + (save-current-buffer + (run-hooks 'gnus-dired-mode-hook))))) ;;;###autoload (defun turn-on-gnus-dired-mode () "Convenience method to turn on gnus-dired-mode." + (interactive) (gnus-dired-mode 1)) -;; Method to attach files to a gnus composition. +(defun gnus-dired-mail-buffers () + "Return a list of active mail composition buffers." + (if (and (memq gnus-dired-mail-mode '(message-user-agent gnus-user-agent)) + (require 'message) + (fboundp 'message-buffers)) + (message-buffers) + ;; Cf. `message-buffers' in `message.el': + (let (buffers) + (save-excursion + (dolist (buffer (buffer-list t)) + (set-buffer buffer) + (when (eq major-mode 'mail-mode) + (push (buffer-name buffer) buffers)))) + (nreverse buffers)))) + +;; Method to attach files to a mail composition. (defun gnus-dired-attach (files-to-attach) "Attach dired's marked files to a gnus message composition. If called non-interactively, FILES-TO-ATTACH should be a list of @@ -102,22 +149,25 @@ (mapconcat (lambda (f) (file-name-nondirectory f)) files-to-attach ", ")) - (setq bufs (message-buffers)) + (setq bufs (gnus-dired-mail-buffers)) - ;; set up destination message buffer + ;; set up destination mail composition buffer (if (and bufs - (y-or-n-p "Attach files to existing message buffer? ")) + (y-or-n-p "Attach files to existing mail composition buffer? ")) (setq destination (if (= (length bufs) 1) (get-buffer (car bufs)) - (completing-read "Attach to which message buffer: " + (completing-read "Attach to which mail composition buffer: " (mapcar (lambda (b) (cons b (get-buffer b))) bufs) nil t))) - ;; setup a new gnus message buffer - (gnus-setup-message 'message (message-mail)) + ;; setup a new mail composition buffer + (if (eq gnus-dired-mail-mode 'gnus-user-agent) + (gnus-setup-message 'message (message-mail)) + ;; FIXME: Is this the right thing? + (compose-mail)) (setq destination (current-buffer))) ;; set buffer to destination buffer, and attach files @@ -151,7 +201,8 @@ (setq method (cdr (assoc 'viewer (car (mailcap-mime-info mime-type - 'all))))))) + 'all + 'no-decode))))))) (let ((view-command (mm-mailcap-command method file-name nil))) (message "viewing via %s" view-command) (start-process "*display*" @@ -186,7 +237,8 @@ (mailcap-extension-to-mime (match-string 0 file-name))) (stringp - (setq method (mailcap-mime-info mime-type "print")))) + (setq method (mailcap-mime-info mime-type "print" + 'no-decode)))) (call-process shell-file-name nil (generate-new-buffer " *mm*") nil @@ -194,7 +246,10 @@ (mm-mailcap-command method file-name mime-type)) (with-temp-buffer (insert-file-contents file-name) - (gnus-print-buffer)) + (if (eq gnus-dired-mail-mode 'gnus-user-agent) + (gnus-print-buffer) + ;; FIXME: + (error "MIME print only implemeted via Gnus"))) (ps-despool print-to)))) ((file-symlink-p file-name) (error "File is a symlink to a nonexistent target"))
--- a/lisp/gnus/gnus-group.el Thu Dec 06 00:17:56 2007 +0000 +++ b/lisp/gnus/gnus-group.el Thu Dec 06 00:21:00 2007 +0000 @@ -1655,6 +1655,24 @@ (ticked (gnus-range-length (cdr (assq 'tick marked)))) (group-age (gnus-group-timestamp-delta group)) (inhibit-read-only t)) + ;; FIXME: http://thread.gmane.org/gmane.emacs.gnus.general/65451/focus=65465 + ;; ====================================================================== + ;; From: Richard Stallman + ;; Subject: Re: Rewriting gnus-group-highlight-line (was: [...]) + ;; Cc: ding@gnus.org + ;; Date: Sat, 27 Oct 2007 19:41:20 -0400 + ;; Message-ID: <E1IlvHM-0006TS-7t@fencepost.gnu.org> + ;; + ;; [...] + ;; The kludge is that the alist elements contain expressions that refer + ;; to local variables with short names. Perhaps write your own tiny + ;; evaluator that handles just `and', `or', and numeric comparisons + ;; and just a few specific variables. + ;; ====================================================================== + ;; + ;; Similar for other evaluated variables. Grep for risky-local-variable + ;; to find them! -- rsteib + ;; ;; Eval the cars of the lists until we find a match. (while (and list (not (eval (caar list))))
--- a/lisp/gnus/gnus-int.el Thu Dec 06 00:17:56 2007 +0000 +++ b/lisp/gnus/gnus-int.el Thu Dec 06 00:21:00 2007 +0000 @@ -36,6 +36,7 @@ (autoload 'gnus-agent-expire "gnus-agent") (autoload 'gnus-agent-regenerate-group "gnus-agent") (autoload 'gnus-agent-read-servers-validate-native "gnus-agent") +(autoload 'gnus-agent-possibly-synchronize-flags-server "gnus-agent") (defcustom gnus-open-server-hook nil "Hook called just before opening connection to the news server." @@ -278,6 +279,11 @@ ;; prompting with "go offline?". This is only a concern ;; when the agent's backend fails to open the server. (gnus-open-server gnus-command-method)) + (when (and (eq (cadr elem) 'ok) gnus-agent + (gnus-agent-method-p gnus-command-method)) + (save-excursion + (gnus-agent-possibly-synchronize-flags-server + gnus-command-method))) result))))) (defun gnus-close-server (gnus-command-method)
--- a/lisp/gnus/gnus-kill.el Thu Dec 06 00:17:56 2007 +0000 +++ b/lisp/gnus/gnus-kill.el Thu Dec 06 00:21:00 2007 +0000 @@ -687,7 +687,6 @@ (concat "options -n " (mapconcat 'identity command-line-args-left " ")))) (gnus-expert-user t) - (nnmail-spool-file nil) (mail-sources nil) (gnus-use-dribble-file nil) (gnus-batch-mode t)
--- a/lisp/gnus/gnus-move.el Thu Dec 06 00:17:56 2007 +0000 +++ b/lisp/gnus/gnus-move.el Thu Dec 06 00:21:00 2007 +0000 @@ -47,8 +47,7 @@ ;; First start Gnus. (let ((gnus-activate-level 0) - (mail-sources nil) - (nnmail-spool-file nil)) + (mail-sources nil)) (gnus)) (save-excursion
--- a/lisp/gnus/gnus-msg.el Thu Dec 06 00:17:56 2007 +0000 +++ b/lisp/gnus/gnus-msg.el Thu Dec 06 00:21:00 2007 +0000 @@ -1101,7 +1101,10 @@ ((functionp gnus-confirm-mail-reply-to-news) (funcall gnus-confirm-mail-reply-to-news gnus-newsgroup-name)) (t gnus-confirm-mail-reply-to-news))) - (y-or-n-p "Really reply by mail to article author? ")) + (if (or wide very-wide) + t ;; Ignore gnus-confirm-mail-reply-to-news for wide and very + ;; wide replies. + (y-or-n-p "Really reply by mail to article author? "))) (let* ((article (if (listp (car yank)) (caar yank)
--- a/lisp/gnus/gnus-srvr.el Thu Dec 06 00:17:56 2007 +0000 +++ b/lisp/gnus/gnus-srvr.el Thu Dec 06 00:21:00 2007 +0000 @@ -280,7 +280,7 @@ ;; Insert the text. (eval gnus-server-line-format-spec)) (list 'gnus-server (intern gnus-tmp-name) - 'gnus-named-server (intern (gnus-method-to-server method)))))) + 'gnus-named-server (intern (gnus-method-to-server method t)))))) (defun gnus-enter-server-buffer () "Set up the server buffer."
--- a/lisp/gnus/gnus-start.el Thu Dec 06 00:17:56 2007 +0000 +++ b/lisp/gnus/gnus-start.el Thu Dec 06 00:21:00 2007 +0000 @@ -1669,7 +1669,7 @@ (defun gnus-get-unread-articles (&optional level) (setq gnus-server-method-cache nil) (let* ((newsrc (cdr gnus-newsrc-alist)) - (level (or level gnus-activate-level (1+ gnus-level-subscribed))) + (alevel (or level gnus-activate-level (1+ gnus-level-subscribed))) (foreign-level (min (cond ((and gnus-activate-foreign-newsgroups @@ -1678,11 +1678,11 @@ ((numberp gnus-activate-foreign-newsgroups) gnus-activate-foreign-newsgroups) (t 0)) - level)) + alevel)) (methods-cache nil) (type-cache nil) scanned-methods info group active method retrieve-groups cmethod - method-type ignore) + method-type) (gnus-message 6 "Checking new news...") (while newsrc @@ -1719,7 +1719,6 @@ 'foreign))) (push (cons method method-type) type-cache)) - (setq ignore nil) (cond ((and method (eq method-type 'foreign)) ;; These groups are foreign. Check the level. (if (<= (gnus-info-level info) foreign-level) @@ -1733,9 +1732,17 @@ (when (fboundp (intern (concat (symbol-name (car method)) "-request-update-info"))) (inline (gnus-request-update-info info method)))) - (setq ignore t))) + (if (and level + ;; If `active' is nil that means the group has + ;; never been read, the group should be marked + ;; as having never been checked (see below). + active + (> (gnus-info-level info) level)) + ;; Don't check groups of which levels are higher + ;; than the one that a user specified. + (setq active 'ignore)))) ;; These groups are native or secondary. - ((> (gnus-info-level info) level) + ((> (gnus-info-level info) alevel) ;; We don't want these groups. (setq active 'ignore)) ;; Activate groups. @@ -1755,11 +1762,7 @@ ;; not required. (if (and (or nnmail-scan-directory-mail-source-once - (null (assq 'directory - (or mail-sources - (if (listp nnmail-spool-file) - nnmail-spool-file - (list nnmail-spool-file)))))) + (null (assq 'directory mail-sources))) (member method scanned-methods)) (setq active (gnus-activate-group group)) (setq active (gnus-activate-group group 'scan)) @@ -1772,10 +1775,6 @@ ((eq active 'ignore) ;; Don't do anything. ) - ((and active ignore) - ;; The level of the foreign group is higher than the specified - ;; value. - ) (active (inline (gnus-get-unread-articles-in-group info active t))) (t
--- a/lisp/gnus/gnus-sum.el Thu Dec 06 00:17:56 2007 +0000 +++ b/lisp/gnus/gnus-sum.el Thu Dec 06 00:21:00 2007 +0000 @@ -2195,6 +2195,7 @@ "O" gnus-uu-decode-save "b" gnus-uu-decode-binhex "B" gnus-uu-decode-binhex + "Y" gnus-uu-decode-yenc "p" gnus-uu-decode-postscript "P" gnus-uu-decode-postscript-and-save)
--- a/lisp/gnus/gnus-uu.el Thu Dec 06 00:17:56 2007 +0000 +++ b/lisp/gnus/gnus-uu.el Thu Dec 06 00:21:00 2007 +0000 @@ -35,6 +35,7 @@ (require 'message) (require 'gnus-msg) (require 'mm-decode) +(require 'yenc) (defgroup gnus-extract nil "Extracting encoded files." @@ -346,6 +347,7 @@ (defvar gnus-uu-file-name nil) (defvar gnus-uu-uudecode-process nil) (defvar gnus-uu-binhex-article-name nil) +(defvar gnus-uu-yenc-article-name nil) (defvar gnus-uu-work-dir nil) @@ -412,6 +414,17 @@ (mm-make-temp-file (expand-file-name "binhex" gnus-uu-work-dir))) (gnus-uu-decode-with-method 'gnus-uu-binhex-article n dir)) +(defun gnus-uu-decode-yenc (n dir) + "Decode the yEnc-encoded current article." + (interactive + (list current-prefix-arg + (file-name-as-directory + (read-file-name "yEnc decode and save in dir: " + gnus-uu-default-dir + gnus-uu-default-dir)))) + (setq gnus-uu-yenc-article-name nil) + (gnus-uu-decode-with-method 'gnus-uu-yenc-article n dir nil t)) + (defun gnus-uu-decode-uu-view (&optional n) "Uudecodes and views the current article." (interactive "P") @@ -1016,6 +1029,39 @@ (cons gnus-uu-binhex-article-name state) state))) +;; yEnc + +(defun gnus-uu-yenc-article (buffer in-state) + (save-excursion + (set-buffer gnus-original-article-buffer) + (widen) + (let ((file-name (yenc-extract-filename)) + state start-char) + (when (not file-name) + (setq state (list 'wrong-type))) + + (if (memq 'wrong-type state) + () + (when (yenc-first-part-p) + (setq gnus-uu-yenc-article-name + (expand-file-name file-name gnus-uu-work-dir)) + (push 'begin state)) + (when (yenc-last-part-p) + (push 'end state)) + (unless state + (push 'middle state)) + (mm-with-unibyte-buffer + (insert-buffer gnus-original-article-buffer) + (yenc-decode-region (point-min) (point-max)) + (when (and (member 'begin state) + (file-exists-p gnus-uu-yenc-article-name)) + (delete-file gnus-uu-yenc-article-name)) + (mm-append-to-file (point-min) (point-max) + gnus-uu-yenc-article-name))) + (if (memq 'begin state) + (cons file-name state) + state)))) + ;; PostScript (defun gnus-uu-decode-postscript-article (process-buffer in-state)
--- a/lisp/gnus/gnus.el Thu Dec 06 00:17:56 2007 +0000 +++ b/lisp/gnus/gnus.el Thu Dec 06 00:21:00 2007 +0000 @@ -3521,15 +3521,16 @@ (nth 1 method)))) method))) -(defsubst gnus-method-to-server (method) +(defsubst gnus-method-to-server (method &optional nocache) (catch 'server-name (setq method (or method gnus-select-method)) ;; Perhaps it is already in the cache. - (mapc (lambda (name-method) - (if (equal (cdr name-method) method) - (throw 'server-name (car name-method)))) - gnus-server-method-cache) + (unless nocache + (mapc (lambda (name-method) + (if (equal (cdr name-method) method) + (throw 'server-name (car name-method)))) + gnus-server-method-cache)) (mapc (lambda (server-alist) @@ -4254,14 +4255,16 @@ ;;; Agent functions -(defun gnus-agent-method-p (method) +(defun gnus-agent-method-p (method-or-server) "Say whether METHOD is covered by the agent." - (or (eq (car gnus-agent-method-p-cache) method) - (setq gnus-agent-method-p-cache - (cons method - (member (if (stringp method) - method - (gnus-method-to-server method)) gnus-agent-covered-methods)))) + (or (eq (car gnus-agent-method-p-cache) method-or-server) + (let* ((method (if (stringp method-or-server) + (gnus-server-to-method method-or-server) + method-or-server)) + (server (gnus-method-to-server method t))) + (setq gnus-agent-method-p-cache + (cons method-or-server + (member server gnus-agent-covered-methods))))) (cdr gnus-agent-method-p-cache)) (defun gnus-online (method)
--- a/lisp/gnus/mail-source.el Thu Dec 06 00:17:56 2007 +0000 +++ b/lisp/gnus/mail-source.el Thu Dec 06 00:21:00 2007 +0000 @@ -58,15 +58,16 @@ (list 'const (car a))) imap-stream-alist))) -(defcustom mail-sources nil - "*Where the mail backends will look for incoming mail. +(defcustom mail-sources '((file)) + "Where the mail backends will look for incoming mail. This variable is a list of mail source specifiers. See Info node `(gnus)Mail Source Specifiers'." :group 'mail-source + :version "23.0" ;; No Gnus :link '(custom-manual "(gnus)Mail Source Specifiers") :type `(choice - (const nil) - (repeat + (const :tag "None" nil) + (repeat :tag "List" (choice :format "%[Value Menu%] %v" :value (file) (cons :tag "Spool file"
--- a/lisp/gnus/mailcap.el Thu Dec 06 00:17:56 2007 +0000 +++ b/lisp/gnus/mailcap.el Thu Dec 06 00:21:00 2007 +0000 @@ -33,8 +33,14 @@ ;;; Code: (eval-when-compile (require 'cl)) -(require 'mail-parse) -(require 'mm-util) +(autoload 'mail-header-parse-content-type "mail-parse") + +;; `mm-delete-duplicates' is an alias for `delete-dups' in Emacs 22. +(defalias 'mailcap-delete-duplicates + (if (fboundp 'delete-dups) + 'delete-dups + (autoload 'mm-delete-duplicates "mm-util") + 'mm-delete-duplicates)) (defgroup mailcap nil "Definition of viewers for MIME types." @@ -722,7 +728,7 @@ t) (t nil)))) -(defun mailcap-mime-info (string &optional request) +(defun mailcap-mime-info (string &optional request no-decode) "Get the MIME viewer command for STRING, return nil if none found. Expects a complete content-type header line as its argument. @@ -732,7 +738,11 @@ corresponding to that string will be returned (print, description, whatever). If a number, then all the information for this specific viewer is returned. If `all', then all possible viewers for -this type is returned." +this type is returned. + +If NO-DECODE is non-nil, don't decode STRING." + ;; NO-DECODE avoids calling `mail-header-parse-content-type' from + ;; `mail-parse.el' (let ( major ; Major encoding (text, etc) minor ; Minor encoding (html, etc) @@ -746,7 +756,10 @@ viewer ; The one and only viewer ctl) (save-excursion - (setq ctl (mail-header-parse-content-type (or string "text/plain"))) + (setq ctl + (if no-decode + (list (or string "text/plain")) + (mail-header-parse-content-type (or string "text/plain")))) (setq major (split-string (car ctl) "/")) (setq minor (cadr major) major (car major)) @@ -766,7 +779,7 @@ (setq viewer (car passed))) (cond ((and (null viewer) (not (equal major "default")) request) - (mailcap-mime-info "default" request)) + (mailcap-mime-info "default" request no-decode)) ((or (null request) (equal request "")) (mailcap-unescape-mime-test (cdr (assq 'viewer viewer)) info)) ((stringp request) @@ -976,7 +989,7 @@ (defun mailcap-mime-types () "Return a list of MIME media types." (mailcap-parse-mimetypes) - (mm-delete-duplicates + (mailcap-delete-duplicates (nconc (mapcar 'cdr mailcap-mime-extensions) (apply
--- a/lisp/gnus/message.el Thu Dec 06 00:17:56 2007 +0000 +++ b/lisp/gnus/message.el Thu Dec 06 00:21:00 2007 +0000 @@ -273,7 +273,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-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:" "*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." @@ -588,21 +588,21 @@ :type 'regexp) (defcustom message-cite-prefix-regexp - (if (string-match "[[:digit:]]" "1") ;; support POSIX? - "\\([ \t]*[-_.[:word:]]+>+\\|[ \t]*[]>|}+]\\)+" + (if (string-match "[[:digit:]]" "1") + ;; Support POSIX? XEmacs 21.5.27 doesn't. + "\\([ \t]*[_.[:word:]]+>+\\|[ \t]*[]>|}]\\)+" ;; ?-, ?_ or ?. MUST NOT be in syntax entry w. (let (non-word-constituents) (with-syntax-table text-mode-syntax-table (setq non-word-constituents (concat - (if (string-match "\\w" "-") "" "-") (if (string-match "\\w" "_") "" "_") (if (string-match "\\w" ".") "" ".")))) (if (equal non-word-constituents "") - "\\([ \t]*\\(\\w\\)+>+\\|[ \t]*[]>|}+]\\)+" + "\\([ \t]*\\(\\w\\)+>+\\|[ \t]*[]>|}]\\)+" (concat "\\([ \t]*\\(\\w\\|[" non-word-constituents - "]\\)+>+\\|[ \t]*[]>|}+]\\)+")))) + "]\\)+>+\\|[ \t]*[]>|}]\\)+")))) "*Regexp matching the longest possible citation prefix on a line." :version "22.1" :group 'message-insertion @@ -5559,7 +5559,9 @@ (mapcar 'downcase (mapcar 'car (mail-header-parse-addresses field)))))) - (setq ace (downcase (idna-to-ascii rhs))) + (setq ace (if (string-match "\\`[[:ascii:]]+\\'" rhs) + rhs + (downcase (idna-to-ascii rhs)))) (when (and (not (equal rhs ace)) (or (not (eq message-use-idna 'ask)) (y-or-n-p (format "Replace %s with %s in %s:? "
--- a/lisp/gnus/mm-uu.el Thu Dec 06 00:17:56 2007 +0000 +++ b/lisp/gnus/mm-uu.el Thu Dec 06 00:21:00 2007 +0000 @@ -272,7 +272,7 @@ see `set-text-properties'. If PROPERTIES equals t, this means to apply the face `mm-uu-extract'." (let ((obuf (current-buffer)) - (coding-system + (coding-system ;; Might not exist in non-MULE XEmacs (when (boundp 'buffer-file-coding-system) buffer-file-coding-system))) @@ -428,7 +428,12 @@ (cons 'filename file-name))))) (defun mm-uu-yenc-extract () - (mm-make-handle (mm-uu-copy-to-buffer start-point end-point) + ;; This might not be exactly correct, but we sure can't get the + ;; binary data from the article buffer, since that's already in a + ;; non-binary charset. So get it from the original article buffer. + (mm-make-handle (save-excursion + (set-buffer gnus-original-article-buffer) + (mm-uu-copy-to-buffer start-point end-point)) (list (or (and file-name (string-match "\\.[^\\.]+$" file-name) (mailcap-extension-to-mime
--- a/lisp/gnus/nnkiboze.el Thu Dec 06 00:17:56 2007 +0000 +++ b/lisp/gnus/nnkiboze.el Thu Dec 06 00:21:00 2007 +0000 @@ -198,8 +198,7 @@ "\"Usage: emacs -batch -l nnkiboze -f nnkiboze-generate-groups\". Finds out what articles are to be part of the nnkiboze groups." (interactive) - (let ((nnmail-spool-file nil) - (mail-sources nil) + (let ((mail-sources nil) (gnus-use-dribble-file nil) (gnus-read-active-file t) (gnus-expert-user t))
--- a/lisp/gnus/nnmail.el Thu Dec 06 00:17:56 2007 +0000 +++ b/lisp/gnus/nnmail.el Thu Dec 06 00:21:00 2007 +0000 @@ -240,16 +240,11 @@ :group 'nnmail :type 'boolean) -(defcustom nnmail-spool-file '((file)) - "*Where the mail backends will look for incoming mail. -This variable is a list of mail source specifiers. -This variable is obsolete; `mail-sources' should be used instead." - :group 'nnmail-files - :type 'sexp) (make-obsolete-variable 'nnmail-spool-file "This option is obsolete in Gnus 5.9. \ Use `mail-sources' instead.") ;; revision 5.29 / p0-85 / Gnus 5.9 +;; Variable removed in No Gnus v0.7 (defcustom nnmail-resplit-incoming nil "*If non-nil, re-split incoming procmail sorted mail." @@ -1765,10 +1760,7 @@ (defun nnmail-get-new-mail (method exit-func temp &optional group spool-func) "Read new incoming mail." - (let* ((sources (or mail-sources - (if (listp nnmail-spool-file) - nnmail-spool-file - (list nnmail-spool-file)))) + (let* ((sources mail-sources) fetching-sources (group-in group) (i 0) @@ -1778,20 +1770,6 @@ (when (and (nnmail-get-value "%s-get-new-mail" method) sources) (while (setq source (pop sources)) - ;; Be compatible with old values. - (cond - ((stringp source) - (setq source - (cond - ((string-match "^po:" source) - (list 'pop :user (substring source (match-end 0)))) - ((file-directory-p source) - (list 'directory :path source)) - (t - (list 'file :path source))))) - ((eq source 'procmail) - (message "Invalid value for nnmail-spool-file: `procmail'") - nil)) ;; Hack to only fetch the contents of a single group's spool file. (when (and (eq (car source) 'directory) (null nnmail-scan-directory-mail-source-once)
--- a/lisp/gnus/rfc2047.el Thu Dec 06 00:17:56 2007 +0000 +++ b/lisp/gnus/rfc2047.el Thu Dec 06 00:21:00 2007 +0000 @@ -99,6 +99,40 @@ (defvar rfc2047-encode-encoded-words t "Whether encoded words should be encoded again.") +(defvar rfc2047-allow-irregular-q-encoded-words t + "*Whether to decode irregular Q-encoded words.") + +(eval-and-compile ;; Necessary to hard code them in `rfc2047-decode-region'. + (defconst rfc2047-encoded-word-regexp + "=\\?\\([^][\000-\040()<>@,\;:*\\\"/?.=]+\\)\\(?:\\*[^?]+\\)?\\?\ +\\(B\\?[+/0-9A-Za-z]*=*\ +\\|Q\\?[ ->@-~]*\ +\\)\\?=" + "Regexp that matches encoded word." + ;; The patterns for the B encoding and the Q encoding, i.e. the ones + ;; beginning with "B" and "Q" respectively, are restricted into only + ;; the characters that those encodings may generally use. + ) + (defconst rfc2047-encoded-word-regexp-loose + "=\\?\\([^][\000-\040()<>@,\;:*\\\"/?.=]+\\)\\(?:\\*[^?]+\\)?\\?\ +\\(B\\?[+/0-9A-Za-z]*=*\ +\\|Q\\?\\(?:\\?+[ -<>@-~]\\)?\\(?:[ ->@-~]+\\?+[ -<>@-~]\\)*[ ->@-~]*\\?*\ +\\)\\?=" + "Regexp that matches encoded word allowing loose Q encoding." + ;; The pattern for the Q encoding, i.e. the one beginning with "Q", + ;; is similar to: + ;; "Q\\?\\(\\?+[^\n=?]\\)?\\([^\n?]+\\?+[^\n=?]\\)*[^\n?]*\\?*" + ;; <--------1-------><----------2,3----------><--4--><-5-> + ;; They mean: + ;; 1. After "Q?", allow "?"s that follow a character other than "=". + ;; 2. Allow "=" after "Q?"; it isn't regarded as the terminator. + ;; 3. In the middle of an encoded word, allow "?"s that follow a + ;; character other than "=". + ;; 4. Allow any characters other than "?" in the middle of an + ;; encoded word. + ;; 5. At the end, allow "?"s. + )) + ;;; ;;; Functions for encoding RFC2047 messages ;;; @@ -295,7 +329,7 @@ (goto-char (point-min)) (or (and rfc2047-encode-encoded-words (prog1 - (search-forward "=?" nil t) + (re-search-forward rfc2047-encoded-word-regexp nil t) (goto-char (point-min)))) (and charsets (not (equal charsets (list (car message-posting-charset)))))))) @@ -530,10 +564,19 @@ (rfc2047-encode-region (point-min) (point-max)) (buffer-string))) +;; From RFC 2047: +;; 2. Syntax of encoded-words +;; [...] +;; While there is no limit to the length of a multiple-line header +;; field, each line of a header field that contains one or more +;; 'encoded-word's is limited to 76 characters. +;; +;; In `rfc2047-encode-parameter' it is bound to nil, so don't defconst it. (defvar rfc2047-encode-max-chars 76 "Maximum characters of each header line that contain encoded-words. -If it is nil, encoded-words will not be folded. Too small value may -cause an error. Don't change this for no particular reason.") +According to RFC 2047, it is 76. If it is nil, encoded-words +will not be folded. Too small value may cause an error. You +should not change this value.") (defun rfc2047-encode-1 (column string cs encoder start crest tail &optional eword) @@ -824,11 +867,6 @@ ;;; Functions for decoding RFC2047 messages ;;; -(eval-and-compile - (defconst rfc2047-encoded-word-regexp - "=\\?\\([^][\000-\040()<>@,\;:*\\\"/?.=]+\\)\\(?:\\*[^?]+\\)?\ -\\?\\(B\\|Q\\)\\?\\([!->@-~ ]*\\)\\?=")) - (defvar rfc2047-quote-decoded-words-containing-tspecials nil "If non-nil, quote decoded words containing special characters.") @@ -947,10 +985,12 @@ other than `\"' and `\\' in quoted strings." (interactive "r") (let ((case-fold-search t) - (eword-regexp (eval-when-compile - ;; Ignore whitespace between encoded-words. - (concat "[\n\t ]*\\(" rfc2047-encoded-word-regexp - "\\)"))) + (eword-regexp + (if rfc2047-allow-irregular-q-encoded-words + (eval-when-compile + (concat "[\n\t ]*\\(" rfc2047-encoded-word-regexp-loose "\\)")) + (eval-when-compile + (concat "[\n\t ]*\\(" rfc2047-encoded-word-regexp "\\)")))) b e match words) (save-excursion (save-restriction @@ -966,7 +1006,7 @@ (while match (push (list (match-string 2) ;; charset (char-after (match-beginning 3)) ;; encoding - (match-string 4) ;; encoded-text + (substring (match-string 3) 2) ;; encoded-text (match-string 1)) ;; encoded-word words) ;; Look for the subsequent encoded-words.
--- a/lisp/gnus/yenc.el Thu Dec 06 00:17:56 2007 +0000 +++ b/lisp/gnus/yenc.el Thu Dec 06 00:21:00 2007 +0000 @@ -55,6 +55,25 @@ 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213]) +(defun yenc-first-part-p () + "Say whether the buffer contains the first part of a yEnc file." + (save-excursion + (goto-char (point-min)) + (re-search-forward "^=ybegin part=1 " nil t))) + +(defun yenc-last-part-p () + "Say whether the buffer contains the last part of a yEnc file." + (save-excursion + (goto-char (point-min)) + (let (total-size end-size) + (when (re-search-forward "^=ybegin.*size=\\([0-9]+\\)" nil t) + (setq total-size (match-string 1))) + (when (re-search-forward "^=ypart.*end=\\([0-9]+\\)" nil t) + (setq end-size (match-string 1))) + (and total-size + end-size + (string= total-size end-size))))) + ;;;###autoload (defun yenc-decode-region (start end) "Yenc decode region between START and END using an internal decoder."
--- a/lisp/net/imap.el Thu Dec 06 00:17:56 2007 +0000 +++ b/lisp/net/imap.el Thu Dec 06 00:21:00 2007 +0000 @@ -1533,10 +1533,11 @@ (imap-send-command (list "STATUS \"" (imap-utf7-encode mailbox) "\" " - (format "%s" - (if (listp items) - items - (list items))))))) + (upcase + (format "%s" + (if (listp items) + items + (list items)))))))) (defun imap-mailbox-acl-get (&optional mailbox buffer) "Get ACL on mailbox from server in BUFFER." @@ -2524,7 +2525,7 @@ (while (and (not (eq (char-after) ?\))) (or (forward-char) t) (looking-at "\\([A-Za-z]+\\) ")) - (let ((token (match-string 1))) + (let ((token (upcase (match-string 1)))) (goto-char (match-end 0)) (cond ((string= token "MESSAGES") (imap-mailbox-put 'messages (read (current-buffer)) mailbox))
--- a/lisp/net/tls.el Thu Dec 06 00:17:56 2007 +0000 +++ b/lisp/net/tls.el Thu Dec 06 00:21:00 2007 +0000 @@ -85,26 +85,93 @@ Each entry in the list is tried until a connection is successful. %h is replaced with server hostname, %p with port to connect to. The program should read input on stdin and write output to -stdout. Also see `tls-success' for what the program should output -after successful negotiation." - :type '(repeat string) +stdout. + +See `tls-checktrust' on how to check trusted root certs. + +Also see `tls-success' for what the program should output after +successful negotiation." + :type + '(choice + (list :tag "Choose commands" + :value + ("gnutls-cli -p %p %h" + "gnutls-cli -p %p %h --protocols ssl3" + "openssl s_client -connect %h:%p -no_ssl2") + (set :inline t + ;; FIXME: add brief `:tag "..."' descriptions. + ;; (repeat :inline t :tag "Other" (string)) + ;; See `tls-checktrust': + (const "gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt -p %p %h") + (const "gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt -p %p %h --protocols ssl3") + (const "openssl s_client -connect %h:%p -CAfile /etc/ssl/certs/ca-certificates.crt -no_ssl2") + ;; No trust check: + (const "gnutls-cli -p %p %h") + (const "gnutls-cli -p %p %h --protocols ssl3") + (const "openssl s_client -connect %h:%p -no_ssl2")) + (repeat :inline t :tag "Other" (string))) + (const :tag "Default list of commands" + ("gnutls-cli -p %p %h" + "gnutls-cli -p %p %h --protocols ssl3" + "openssl s_client -connect %h:%p -no_ssl2")) + (list :tag "List of commands" + (repeat :tag "Command" (string)))) :version "22.1" :group 'tls) (defcustom tls-process-connection-type nil - "*Value for `process-connection-type' to use when starting TLS process." + "Value for `process-connection-type' to use when starting TLS process." :version "22.1" :type 'boolean :group 'tls) (defcustom tls-success "- Handshake was completed\\|SSL handshake has read " - "*Regular expression indicating completed TLS handshakes. + "Regular expression indicating completed TLS handshakes. The default is what GNUTLS's \"gnutls-cli\" or OpenSSL's \"openssl s_client\" outputs." :version "22.1" :type 'regexp :group 'tls) +(defcustom tls-checktrust nil + "Indicate if certificates should be checked against trusted root certs. +If this is `ask', the user can decide whether to accept an +untrusted certificate. You may have to adapt `tls-program' in +order to make this feature work properly, i.e., to ensure that +the external program knows about the root certificates you +consider trustworthy, e.g.: + +\(setq tls-program + '(\"gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt -p %p %h\" + \"gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt -p %p %h --protocols ssl3\" + \"openssl s_client -connect %h:%p -CAfile /etc/ssl/certs/ca-certificates.crt -no_ssl2\"))" + :type '(choice (const :tag "Always" t) + (const :tag "Never" nil) + (const :tag "Ask" ask)) + :version "23.0" ;; No Gnus + :group 'tls) + +(defcustom tls-untrusted + "- Peer's certificate is NOT trusted\\|Verify return code: \\([^0] \\|.[^ ]\\)" + "Regular expression indicating failure of TLS certificate verification. +The default is what GNUTLS's \"gnutls-cli\" or OpenSSL's +\"openssl s_client\" return in the event of unsuccessful +verification." + :type 'regexp + :version "23.0" ;; No Gnus + :group 'tls) + +(defcustom tls-hostmismatch + "# The hostname in the certificate does NOT match" + "Regular expression indicating a host name mismatch in certificate. +When the host name specified in the certificate doesn't match the +name of the host you are connecting to, gnutls-cli issues a +warning to this effect. There is no such feature in openssl. Set +this to nil if you want to ignore host name mismatches." + :type 'regexp + :version "23.0" ;; No Gnus + :group 'tls) + (defcustom tls-certtool-program (executable-find "certtool") "Name of GnuTLS certtool. Used by `tls-certificate-information'." @@ -141,7 +208,7 @@ Input and output work as for subprocesses; `delete-process' closes it. Args are NAME BUFFER HOST PORT. NAME is name for process. It is modified if necessary to make it unique. -BUFFER is the buffer (or buffer-name) to associate with the process. +BUFFER is the buffer (or buffer name) to associate with the process. Process output goes at end of that buffer, unless you specify an output stream or filter function to handle the output. BUFFER may be also nil, meaning that this process is not associated @@ -177,25 +244,31 @@ (sit-for 1))) (message "Opening TLS connection with `%s'...%s" cmd (if done "done" "failed")) - (if (not done) - (delete-process process) - ;; advance point to after all informational messages that - ;; `openssl s_client' and `gnutls' print - (let ((start-of-data nil)) - (while - (not (setq start-of-data - ;; the string matching `tls-end-of-info' - ;; might come in separate chunks from - ;; `accept-process-output', so start the - ;; search where `tls-success' ended - (save-excursion - (if (re-search-forward tls-end-of-info nil t) - (match-end 0))))) - (accept-process-output process 1)) - (if start-of-data - ;; move point to start of client data - (goto-char start-of-data))) - (setq done process)))) + (if done + (setq done process) + (delete-process process)))) + (when done + (save-excursion + (set-buffer buffer) + (when + (or + (and tls-checktrust + (progn + (goto-char (point-min)) + (re-search-forward tls-untrusted nil t)) + (or + (and (not (eq tls-checktrust 'ask)) + (message "The certificate presented by `%s' is NOT trusted." host)) + (not (yes-or-no-p + (format "The certificate presented by `%s' is NOT trusted. Accept anyway? " host))))) + (and tls-hostmismatch + (progn + (goto-char (point-min)) + (re-search-forward tls-hostmismatch nil t)) + (not (yes-or-no-p + (format "Host name in certificate doesn't match `%s'. Connect anyway? " host))))) + (setq done nil) + (delete-process process)))) (message "Opening TLS connection to `%s'...%s" host (if done "done" "failed"))) (when use-temp-buffer