Merge from emacs--devo--0

Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-294

80 files changed, 1314 insertions, 8357 deletions

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 7ac757f24e2..bb92d478277 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,422 @@
+2007-12-05  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+	* gnus-art.el (gnus-use-idna)
+	* gnus-start.el (gnus-site-init-file)
+	* message.el (message-use-idna)
+	* mm-uu.el (mm-uu-hide-markers)
+	* smiley.el (smiley-style): Revert changes that suppress warnings.
+
+2007-12-05  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+	* gnus-art.el (gnus-article-browse-html-parts): Add meta html tag to
+	specify charset to html source.  Reported by Christoph Conrad
+	<christoph.conrad@gmx.de>.
+
+2007-12-05  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+	* gnus-art.el (gnus-use-idna): Don't directly refer to the value of
+	idna-program in order to suppress byte compile warning issued by XEmacs
+	that came to byte compile the default value section of defcustom forms
+	recently.
+
+	* gnus-start.el (gnus-site-init-file): Don't directly refer to the
+	value of installation-directory.
+
+	* message.el (message-use-idna): Don't directly refer to the value of
+	idna-program.
+
+	* mm-uu.el (mm-uu-hide-markers): Don't directly call defined-colors.
+
+	* smiley.el (smiley-style): Don't directly call face-attribute.
+
+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.
+
+	* mml1991.el (password-read, password-cache-add, password-cache-remove):
+	* mml2015.el (password-read, password-cache-add, password-cache-remove):
+	* mml-smime.el (password-read, password-cache-add)
+	(password-cache-remove):
+	No need to autoload, since mml-sec requires password.
+
+	* gnus.el (gnus-spam-resend-to, gnus-ham-resend-to):
+	* message.el (gnus-extract-address-components):
+	* mml-smime.el (gnus-extract-address-components): Define for compiler.
+
+	* 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:
+	Move to ../net.
+
+	* binhex.el, uudecode.el: Move to ../mail.
+
+	* 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.
+	* format-spec.el, hex-util.el, sha1.el: Move to ../.
+
+	* mail-source.el (top-level): Require format-spec before
+	eval-when-compile.
+
+2007-11-30  Glenn Morris  <rgm@gnu.org>
+
+	* 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
+	mail_send.xpm->mail-send.xpm.
+
+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.
+
+	* smime.el (smime-cert-by-ldap-1): Use `ldap-search' instead of
+	`smime-ldap-search' for Emacs 22 and up.
+
+2007-11-22  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+	* gnus-art.el (gnus-article-truncate-lines): Use `truncate-lines'.
+
+	* message.el (message-send-mail-function): Fix error convention.
+	(message-mailer-swallows-blank-line, message-send-mail-with-sendmail)
+	(message-widen-reply, message-send-mail, message-talkative-question)
+	(message-with-reply-buffer, message-generate-new-buffer-clone-locals)
+	(message-clone-locals, message-send-news): Use with-current-buffer.
+	(message-insert-or-toggle-importance): Remove unused var `valid'.
+	(message-make-references): Remove unused var `new-references'.
+	(message-make-mail-followup-to): Remove unused var `subscribed-lists'.
+
+2007-11-22  Juanma Barranquero  <lekktu@gmail.com>
+
+	* spam.el (spam-find-spam, spam-enter-list): Doc fixes.
+	(spam-split-symbolic-return-positive): Reflow docstring.
+	(spam-backends, spam-summary-exit-behavior)
+	(spam-mark-ham-unread-before-move-from-spam-group)
+	(spam-summary-score-preferred-header, spam-sa-learn-spam-switch)
+	(spam-sa-learn-ham-switch, spam-sa-learn-unregister-switch)
+	(spam-clear-cache, spam-backend-check, spam-install-backend)
+	(spam-install-statistical-backend, spam-list-of-processors)
+	(spam-group-processor-p, spam-split, spam-bogofilter-score)
+	(spam-bsfilter-score, spam-check-bsfilter, spam-crm114-score)
+	(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.
+
+2007-11-20  Reiner Steib  <Reiner.Steib@gmx.de>
+
+	* message.el (message-send-mail-function): Check for smtpmail too.
+
+	* utf7.el (utf7-encode, utf7-decode): Use coding system
+	`utf-7'/`utf-7-imap' from utf-7.el' if available.
+
+	* message.el (message-send-mail-function): New function.
+	(message-send-mail-function): Set default using
+	message-send-mail-function.  Adjust doc string.
+	(message-send-mail-with-mailclient): New function.
+
+2007-11-17  Richard Stallman  <rms@gnu.org>
+
+	* assistant.el: Remove file.
+
+2007-11-16  Dan Nicolaescu  <dann@ics.uci.edu>
+
+	* smime.el (from):
+	* rfc2047.el (message-posting-charset):
+	* qp.el (mm-use-ultra-safe-encoding):
+	* pop3.el (parse-time-months):
+	* nnrss.el (mm-text-html-renderer, mm-text-html-washer-alist):
+	* nnml.el (files):
+	* nnheader.el (gnus-newsgroup-name, nnheader-file-coding-system)
+	(jka-compr-compression-info-list, ange-ftp-path-format)
+	(efs-path-regexp):
+	* nndiary.el (files):
+	* mml2015.el (mc-default-scheme, mc-schemes, pgg-default-user-id)
+	(pgg-errors-buffer, pgg-output-buffer, epg-user-id-alist)
+	(epg-digest-algorithm-alist, inhibit-redisplay)
+	(password-cache-expiry):
+	* mml1991.el (pgg-default-user-id, pgg-errors-buffer)
+	(pgg-output-buffer, password-cache-expiry):
+	* mml.el (mml-dnd-protocol-alist, ange-ftp-name-format)
+	(efs-path-regexp):
+	* mml-smime.el (epg-user-id-alist, epg-digest-algorithm-alist)
+	(inhibit-redisplay):
+	* mm-uu.el (file-name, start-point, end-point, entry)
+	(gnus-newsgroup-name, gnus-newsgroup-charset):
+	* mm-util.el (mm-mime-mule-charset-alist, latin-unity-coding-systems)
+	(latin-unity-ucs-list):
+	* mm-bodies.el (mm-uu-yenc-decode-function, mm-uu-decode-function)
+	(mm-uu-binhex-decode-function):
+	* message.el (gnus-message-group-art, gnus-list-identifiers, )
+	(rmail-enable-mime-composing, gnus-local-organization)
+	(gnus-post-method, gnus-select-method, gnus-active-hashtb)
+	(gnus-read-active-file, facemenu-add-face-function)
+	(facemenu-remove-face-function, gnus-article-decoded-p)
+	(tool-bar-mode):
+	* mail-source.el (display-time-mail-function):
+	* gnus-util.el (nnmail-pathname-coding-system)
+	(nnmail-active-file-coding-system, gnus-emphasize-whitespace-regexp)
+	(gnus-original-article-buffer, gnus-user-agent)
+	(rmail-default-rmail-file, mm-text-coding-system, tool-bar-mode)
+	(xemacs-codename, sxemacs-codename, emacs-program-version):
+	* gnus-sum.el (tool-bar-mode, gnus-tmp-header, number):
+	* gnus-start.el (gnus-agent-covered-methods)
+	(gnus-agent-file-loading-local, gnus-agent-file-loading-cache)
+	(gnus-current-headers, gnus-thread-indent-array, gnus-newsgroup-name)
+	(gnus-newsgroup-headers, gnus-group-list-mode)
+	(gnus-group-mark-positions, gnus-newsgroup-data)
+	(gnus-newsgroup-unreads, nnoo-state-alist)
+	(gnus-current-select-method, mail-sources)
+	(nnmail-scan-directory-mail-source-once, nnmail-split-history)
+	(nnmail-spool-file, gnus-cache-active-hashtb):
+	* gnus-mh.el (mh-lib-progs):
+	* gnus-ems.el (gnus-tmp-unread, gnus-tmp-replied)
+	(gnus-tmp-score-char, gnus-tmp-indentation, gnus-tmp-opening-bracket)
+	(gnus-tmp-lines, gnus-tmp-name, gnus-tmp-closing-bracket)
+	(gnus-tmp-subject-or-nil, gnus-check-before-posting, gnus-mouse-face)
+	(gnus-group-buffer):
+	* gnus-cite.el (font-lock-defaults-computed, font-lock-keywords)
+	(font-lock-set-defaults):
+	* gnus-art.el (tool-bar-map, w3m-minor-mode-map)
+	(gnus-face-properties-alist, charset, gnus-summary-article-menu)
+	(gnus-summary-post-menu, total-parts, type, condition, length):
+	* gnus-agent.el (gnus-agent-read-agentview):
+	* flow-fill.el (show-trailing-whitespace):
+	* gnus-group.el (tool-bar-mode, nnrss-group-alist): Remove unnecessary
+	eval-and-compile wrappers for byte compiler pacifiers.
+
+	* mm-view.el (mm-inline-image-xemacs): Only do something for XEmacs.
+	(mm-display-inline-fontify): Check for featurep 'xemacs not
+	extent-list.
+
+	* mm-decode.el (mm-display-external): Check for featurep 'xemacs not
+	itimer-list.
+	(mm-create-image-xemacs): Only do something for XEmacs.
+	(mm-image-fit-p): Check for featurep 'xemacs not glyph-width.
+
+	* mm-util.el (mm-find-buffer-file-coding-system): Add check for XEmacs.
+
+	* gnus-registry.el (gnus-adaptive-word-syntax-table):
+	* gnus-fun.el (gnus-face-properties-alist): Pacify byte compiler.
+
+2007-11-15  Juanma Barranquero  <lekktu@gmail.com>
+
+	* nnimap.el (nnimap-split-download-body):
+	* gnus-demon.el (gnus-demon):
+	* gnus-uu.el (gnus-uu-default-view-rules): Fix typos in docstrings.
+
+2007-11-15  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+	* nntp.el (nntp-insert-buffer-substring, nntp-copy-to-buffer): New
+	macros.
+	(nntp-wait-for, nntp-retrieve-articles, nntp-async-trigger)
+	(nntp-retrieve-headers-with-xover): Use nntp-insert-buffer-substring to
+	copy data from unibyte buffer to multibyte current buffer.
+	(nntp-retrieve-headers, nntp-retrieve-groups); Use nntp-copy-to-buffer
+	to copy data from unibyte current buffer to multibyte buffer.
+	(nntp-make-process-buffer): Make process buffer unibyte.
+
+	* pop3.el (pop3-open-server): Fix typo in Lisp code.
+
+2007-11-14  Denys Duchier  <denys.duchier@univ-orleans.fr>  (tiny change)
+
+	* pop3.el (pop3-open-server): Accept and process data more robustly at
+	connexion start to avoid spurious "POP SSL connexion failed" errors.
+
+2007-11-14  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+	* gnus-start.el (gnus-active-to-gnus-format): Use unibyte buffer to
+	read group names.
+
+2007-11-12  Reiner Steib  <Reiner.Steib@gmx.de>
+
+	* gnus-msg.el (gnus-confirm-mail-reply-to-news): Adjust :version.
+
+2007-11-12  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+	* nnmail.el (nnmail-parse-active): Make group names unibyte.
+	(nnmail-save-active): Use a unibyte buffer when saving active file,
+	which may contain non-ASCII group names.
+
+	* nnml.el (nnml-request-group): Decode group names in messages.
+
 2007-11-05  Reiner Steib  <Reiner.Steib@gmx.de>
 
 	* message.el (message-citation-line-function)
@@ -265,7 +684,7 @@
 
 2007-10-04  Reiner Steib  <Reiner.Steib@gmx.de>
 
-        * Relicense "GPLv2 or later" files to "GPLv3 or later".
+	* Relicense "GPLv2 or later" files to "GPLv3 or later".
 
 2007-09-27  Teodor Zlatanov  <tzz@lifelogs.com>
 
@@ -10350,7 +10769,7 @@
 	eval-when-compile, to define gnus-agent-set-cat-groups as the setf
 	method of gnus-agent-cat-groups even when the buffer has been
 	evaled.
-	(gnus-agent-save-active,gnus-agent-save-active-1): Merged to
+	(gnus-agent-save-active, gnus-agent-save-active-1): Merged to
 	delete gnus-agent-save-active-1.
 	(gnus-agent-save-groups): Deleted. Identical to
 	gnus-agent-save-active.
@@ -10361,12 +10780,12 @@
 	servers.  Add use of min/max range limits from server's local
 	file.
 	(gnus-agent-save-alist): Removed unused optional argument.
-	(gnus-agent-load-local,gnus-agent-read-and-cache-local),
-	(gnus-agent-read-local,gnus-agent-save-local,gnus-agent-get-local),
+	(gnus-agent-load-local, gnus-agent-read-and-cache-local),
+	(gnus-agent-read-local, gnus-agent-save-local, gnus-agent-get-local),
 	(gnus-agent-set-local): A per-server file that keeps min/max range
-	limits for articles known to the agent.	 Provides a fast mechanism
+	limits for articles known to the agent.  Provides a fast mechanism
 	for altering many active ranges.
-	(gnus-agent-expire-group,gnus-agent-expire): No longer save the
+	(gnus-agent-expire-group, gnus-agent-expire): No longer save the
 	active file (local makes it unnecessary).
 	(gnus-agent-regenerate-group): Fixed XEmacs compatibility.
 
diff --git a/lisp/gnus/assistant.el b/lisp/gnus/assistant.el
deleted file mode 100644
index 25ff1732f8f..00000000000
--- a/lisp/gnus/assistant.el
+++ /dev/null
@@ -1,487 +0,0 @@
-;;; assistant.el --- guiding users through Emacs setup
-;; Copyright (C) 2004, 2005 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Keywords: util
-
-;; 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, 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; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile
-  (require 'cl))
-
-(require 'widget)
-(require 'wid-edit)
-
-(autoload 'gnus-error "gnus-util")
-(autoload 'netrc-get "netrc")
-(autoload 'netrc-machine "netrc")
-(autoload 'netrc-parse "netrc")
-
-(defvar assistant-readers
-  '(("variable" assistant-variable-reader)
-    ("validate" assistant-sexp-reader)
-    ("result" assistant-list-reader)
-    ("next" assistant-list-reader)
-    ("text" assistant-text-reader)))
-
-(defface assistant-field '((t (:bold t)))
-  "Face used for editable fields."
-  :group 'gnus-article-emphasis)
-;; backward-compatibility alias
-(put 'assistant-field-face 'face-alias 'assistant-field)
-
-;;; Internal variables
-
-(defvar assistant-data nil)
-(defvar assistant-current-node nil)
-(defvar assistant-previous-nodes nil)
-(defvar assistant-widgets nil)
-
-(defun assistant-parse-buffer ()
-  (let (results command value)
-    (goto-char (point-min))
-    (while (search-forward "@" nil t)
-      (if (not (looking-at "[^ \t\n]+"))
-	  (error "Dangling @")
-	(setq command (downcase (match-string 0)))
-	(goto-char (match-end 0)))
-      (setq value
-	    (if (looking-at "[ \t]*\n")
-		(let (start)
-		  (forward-line 1)
-		  (setq start (point))
-		  (unless (re-search-forward (concat "^@end " command) nil t)
-		    (error "No @end %s found" command))
-		  (beginning-of-line)
-		  (prog1
-		      (buffer-substring start (point))
-		    (forward-line 1)))
-	      (skip-chars-forward " \t")
-	      (prog1
-		  (buffer-substring (point) (point-at-eol))
-		(forward-line 1))))
-      (push (list command (assistant-reader command value))
-	    results))
-    (assistant-segment (nreverse results))))
-
-(defun assistant-text-reader (text)
-  (with-temp-buffer
-    (insert text)
-    (goto-char (point-min))
-    (let ((start (point))
-	  (sections nil))
-      (while (re-search-forward "@\\([^{]+\\){\\([^}]+\\)}" nil t)
-	(push (buffer-substring start (match-beginning 0))
-	      sections)
-	(push (list (match-string 1) (match-string 2))
-	      sections)
-	(setq start (point)))
-      (push (buffer-substring start (point-max))
-	    sections)
-      (nreverse sections))))
-
-;; Segment the raw assistant data into a list of nodes.
-(defun assistant-segment (list)
-  (let ((ast nil)
-	(node nil)
-	(title (pop list)))
-    (dolist (elem list)
-      (when (and (equal (car elem) "node")
-		 node)
-	(push (list "save" nil) node)
-	(push (nreverse node) ast)
-	(setq node nil))
-      (push elem node))
-    (when node
-      (push (list "save" nil) node)
-      (push (nreverse node) ast))
-    (cons title (nreverse ast))))
-
-(defun assistant-reader (command value)
-  (let ((formatter (cadr (assoc command assistant-readers))))
-    (if (not formatter)
-	value
-      (funcall formatter value))))
-
-(defun assistant-list-reader (value)
-  (car (read-from-string (concat "(" value ")"))))
-
-(defun assistant-variable-reader (value)
-  (let ((section (car (read-from-string (concat "(" value ")")))))
-    (append section (list 'default))))
-
-(defun assistant-sexp-reader (value)
-  (if (zerop (length value))
-      nil
-    (car (read-from-string value))))
-
-(defun assistant-buffer-name (title)
-  (format "*Assistant %s*" title))
-
-(defun assistant-get (ast command)
-  (cadr (assoc command ast)))
-
-(defun assistant-set (ast command value)
-  (let ((elem (assoc command ast)))
-    (when elem
-      (setcar (cdr elem) value))))
-
-(defun assistant-get-list (ast command)
-  (let ((result nil))
-    (dolist (elem ast)
-      (when (equal (car elem) command)
-	(push elem result)))
-    (nreverse result)))
-
-;;;###autoload
-(defun assistant (file)
-  "Assist setting up Emacs based on FILE."
-  (interactive "fAssistant file name: ")
-  (let ((ast
-	 (with-temp-buffer
-	   (insert-file-contents file)
-	   (assistant-parse-buffer))))
-    (pop-to-buffer (assistant-buffer-name (assistant-get ast "title")))
-    (assistant-render ast)))
-
-(defun assistant-render (ast)
-  (let ((first-node (assistant-get (nth 1 ast) "node")))
-    (set (make-local-variable 'assistant-data) ast)
-    (set (make-local-variable 'assistant-current-node) nil)
-    (set (make-local-variable 'assistant-previous-nodes) nil)
-    (assistant-render-node first-node)))
-
-(defun assistant-find-node (node-name)
-  (let ((ast (cdr assistant-data)))
-    (while (and ast
-		(not (string= node-name (assistant-get (car ast) "node"))))
-      (pop ast))
-    (car ast)))
-
-(defun assistant-node-name (node)
-  (assistant-get node "node"))
-
-(defun assistant-previous-node-text (node)
-  (format "<< Go back to %s" node))
-
-(defun assistant-next-node-text (node)
-  (if (and node
-	   (not (eq node 'finish)))
-      (format "Proceed to %s >>" node)
-    "Finish"))
-
-(defun assistant-set-defaults (node &optional forcep)
-  (dolist (variable (assistant-get-list node "variable"))
-    (setq variable (cadr variable))
-    (when (or (eq (nth 3 variable) 'default)
-	      forcep)
-      (setcar (nthcdr 3 variable)
-	      (assistant-eval (nth 2 variable))))))
-
-(defun assistant-get-variable (node variable &optional type raw)
-  (let ((variables (assistant-get-list node "variable"))
-	(result nil)
-	elem)
-    (while (and (setq elem (pop variables))
-		(not result))
-      (setq elem (cadr elem))
-      (when (eq (intern variable) (car elem))
-	(if type
-	    (setq result (nth 1 elem))
-	  (setq result (if raw (nth 3 elem)
-			 (format "%s" (nth 3 elem)))))))
-    result))
-    
-(defun assistant-set-variable (node variable value)
-  (let ((variables (assistant-get-list node "variable"))
-	elem)
-    (while (setq elem (pop variables))
-      (setq elem (cadr elem))
-      (when (eq (intern variable) (car elem))
-	(setcar (nthcdr 3 elem) value)))))
-    
-(defun assistant-render-text (text node)
-  (unless (and text node)
-    (gnus-error 
-     5 
-     "The assistant was asked to render invalid text or node data"))
-  (dolist (elem text)
-    (if (stringp elem)
-	;; Ordinary text
-	(insert elem)
-      ;; A variable to be inserted as a widget.
-      (let* ((start (point))
-	     (variable (cadr elem))
-	     (type (assistant-get-variable node variable 'type)))
-	(cond
-	 ((eq (car-safe type) :radio)
-	  (push
-	   (apply
-	    #'widget-create
-	    'radio-button-choice
-	    :assistant-variable variable
-	    :assistant-node node
-	    :value (assistant-get-variable node variable)
-	    :notify (lambda (widget &rest ignore)
-		      (assistant-set-variable
-		       (widget-get widget :assistant-node)
-		       (widget-get widget :assistant-variable)
-		       (widget-value widget))
-		      (assistant-render-node
-		       (assistant-get
-			(widget-get widget :assistant-node)
-			"node")))
-	    (cadr type))
-	   assistant-widgets))
-	 ((eq (car-safe type) :set)
-	  (push
-	   (apply
-	    #'widget-create
-	    'set
-	    :assistant-variable variable
-	    :assistant-node node
-	    :value (assistant-get-variable node variable nil t)
-	    :notify (lambda (widget &rest ignore)
-		      (assistant-set-variable
-		       (widget-get widget :assistant-node)
-		       (widget-get widget :assistant-variable)
-		       (widget-value widget))
-		      (assistant-render-node
-		       (assistant-get
-			(widget-get widget :assistant-node)
-			"node")))
-	    (cadr type))
-	   assistant-widgets))
-	 (t
-	  (push 
-	   (widget-create
-	    'editable-field
-	    :value-face 'assistant-field
-	    :assistant-variable variable
-	    (assistant-get-variable node variable))
-	   assistant-widgets)
-	  ;; The editable-field widget apparently inserts a newline;
-	  ;; remove it.
-	  (delete-char -1)
-	  (add-text-properties start (point)
-			       (list
-				'bold t
-				'face 'assistant-field
-				'not-read-only t))))))))
-
-(defun assistant-render-node (node-name)
-  (let ((node (assistant-find-node node-name))
-	(inhibit-read-only t)
-	(previous assistant-current-node)
-	(buffer-read-only nil))
-    (unless node
-      (gnus-error 5 "The node for %s could not be found" node-name))
-    (set (make-local-variable 'assistant-widgets) nil)
-    (assistant-set-defaults node)
-    (if (equal (assistant-get node "type") "interstitial")
-	(assistant-render-node (nth 0 (assistant-find-next-nodes node-name)))
-      (setq assistant-current-node node-name)
-      (when previous
-	(push previous assistant-previous-nodes))
-      (erase-buffer)
-      (insert (cadar assistant-data) "\n\n")
-      (insert node-name "\n\n")
-      (assistant-render-text (assistant-get node "text") node)
-      (insert "\n\n")
-      (when assistant-previous-nodes
-	(assistant-node-button 'previous (car assistant-previous-nodes)))
-      (widget-create
-       'push-button
-       :assistant-node node-name
-       :notify (lambda (widget &rest ignore)
-		 (let* ((node (widget-get widget :assistant-node)))
-		   (assistant-set-defaults (assistant-find-node node) 'force)
-		   (assistant-render-node node)))
-       "Reset")
-      (insert "\n")
-      (dolist (nnode (assistant-find-next-nodes))
-	(assistant-node-button 'next nnode)
-	(insert "\n"))
-
-      (goto-char (point-min))
-      (assistant-make-read-only))))
-
-(defun assistant-make-read-only ()
-  (let ((start (point-min))
-	end)
-    (while (setq end (text-property-any start (point-max) 'not-read-only t))
-      (put-text-property start end 'read-only t)
-      (put-text-property start end 'rear-nonsticky t)
-      (while (get-text-property end 'not-read-only)
-	(incf end))
-      (setq start end))
-    (put-text-property start (point-max) 'read-only t)))
-
-(defun assistant-node-button (type node)
-  (let ((text (if (eq type 'next)
-		  (assistant-next-node-text node)
-		(assistant-previous-node-text node))))
-    (widget-create
-     'push-button
-     :assistant-node node
-     :assistant-type type
-     :notify (lambda (widget &rest ignore)
-	       (let* ((node (widget-get widget :assistant-node))
-		      (type (widget-get widget :assistant-type)))
-		 (if (eq type 'previous)
-		     (progn
-		       (setq assistant-current-node nil)
-		       (pop assistant-previous-nodes))
-		   (assistant-get-widget-values)
-		   (assistant-validate))
-		 (if (null node)
-		     (assistant-finish)
-		   (assistant-render-node node))))
-     text)
-    (use-local-map widget-keymap)))
-
-(defun assistant-validate-types (node)
-  (dolist (variable (assistant-get-list node "variable"))
-    (setq variable (cadr variable))
-    (let ((type (nth 1 variable))
-	  (value (nth 3 variable)))
-      (when 
-	  (cond
-	   ((eq type :number)
-	    (string-match "[^0-9]" value))
-	   (t
-	    nil))
-	(error "%s is not of type %s: %s"
-	       (car variable) type value)))))
-
-(defun assistant-get-widget-values ()
-  (let ((node (assistant-find-node assistant-current-node)))
-    (dolist (widget assistant-widgets)
-      (assistant-set-variable
-       node (widget-get widget :assistant-variable)
-       (widget-value widget)))))
-
-(defun assistant-validate ()
-  (let* ((node (assistant-find-node assistant-current-node))
-	 (validation (assistant-get node "validate"))
-	 result)
-    (assistant-validate-types node)
-    (when validation
-      (when (setq result (assistant-eval validation))
-	(unless (y-or-n-p (format "Error: %s.  Continue? " result))
-	  (error "%s" result))))
-    (assistant-set node "save" t)))
-
-;; (defun assistant-find-next-node (&optional node)
-;;   (let* ((node (assistant-find-node (or node assistant-current-node)))
-;; 	 (node-name (assistant-node-name node))
-;; 	 (nexts (assistant-get-list node "next"))
-;; 	 next elem applicable)
-
-;;     (while (setq elem (pop nexts))
-;;       (when (assistant-eval (car (cadr elem)))
-;; 	(setq applicable (cons elem applicable))))
-
-;;     ;; return the first thing we can
-;;     (cadr (cadr (pop applicable)))))
-
-(defun assistant-find-next-nodes (&optional node)
-  (let* ((node (assistant-find-node (or node assistant-current-node)))
-	 (nexts (assistant-get-list node "next"))
-	 next elem applicable return)
-
-    (while (setq elem (pop nexts))
-      (when (assistant-eval (car (cadr elem)))
-	(setq applicable (cons elem applicable))))
-
-    ;; return the first thing we can
-    
-    (while (setq elem (pop applicable))
-      (push (cadr (cadr elem)) return))
-
-    return))
-
-(defun assistant-get-all-variables ()
-  (let ((variables nil))
-    (dolist (node (cdr assistant-data))
-      (setq variables
-	    (append (assistant-get-list node "variable")
-		    variables)))
-    variables))
-  
-(defun assistant-eval (form)
-  (let ((bindings nil))
-    (dolist (variable (assistant-get-all-variables))
-      (setq variable (cadr variable))
-      (push (list (car variable) 
-		  (if (eq (nth 3 variable) 'default)
-		      nil
-		    (if (listp (nth 3 variable))
-			`(list ,@(nth 3 variable))
-		      (nth 3 variable))))
-	    bindings))
-    (eval
-     `(let ,bindings
-	,form))))
-
-(defun assistant-finish ()
-  (let ((results nil)
-	result)
-    (dolist (node (cdr assistant-data))
-      (when (assistant-get node "save")
-	(setq result (assistant-get node "result"))
-	(push (list (car result)
-		    (assistant-eval (cadr result)))
-	      results)))
-    (message "Results: %s"
-	     (nreverse results))))
-
-;;; Validation functions.
-
-(defun assistant-validate-connect-to-server (server port)
-  (let* ((error nil)
-	 (stream
-	  (condition-case err
-	      (open-network-stream "nntpd" nil server port)
-	    (error (setq error err)))))
-    (if (and (processp stream)
-	     (memq (process-status stream) '(open run)))
-	(progn
-	  (delete-process stream)
-	  nil)
-      error)))
-
-(defun assistant-authinfo-data (server port type)
-  (when (file-exists-p "~/.authinfo")
-    (netrc-get (netrc-machine (netrc-parse "~/.authinfo")
-			      server port)
-	       (if (eq type 'user)
-		   "login"
-		 "password"))))
-
-(defun assistant-password-required-p ()
-  nil)
-
-(provide 'assistant)
-
-;;; arch-tag: 0404bfa2-9226-4611-8d3f-335c2416175b
-;;; assistant.el ends here
diff --git a/lisp/gnus/binhex.el b/lisp/gnus/binhex.el
deleted file mode 100644
index 88f0e20f17c..00000000000
--- a/lisp/gnus/binhex.el
+++ /dev/null
@@ -1,328 +0,0 @@
-;;; binhex.el --- elisp native binhex decode
-
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007 Free Software Foundation, Inc.
-
-;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
-;; Keywords: binhex news
-
-;; 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, 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; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(eval-and-compile
-  (defalias 'binhex-char-int
-    (if (fboundp 'char-int)
-	'char-int
-      'identity)))
-
-(defcustom binhex-decoder-program "hexbin"
-  "*Non-nil value should be a string that names a binhex decoder.
-The program should expect to read binhex data on its standard
-input and write the converted data to its standard output."
-  :type 'string
-  :group 'gnus-extract)
-
-(defcustom binhex-decoder-switches '("-d")
-  "*List of command line flags passed to the command `binhex-decoder-program'."
-  :group 'gnus-extract
-  :type '(repeat string))
-
-(defcustom binhex-use-external
-  (executable-find binhex-decoder-program)
-  "*Use external binhex program."
-  :version "22.1"
-  :group 'gnus-extract
-  :type 'boolean)
-
-(defconst binhex-alphabet-decoding-alist
-  '(( ?\! . 0) ( ?\" . 1) ( ?\# . 2) ( ?\$ . 3) ( ?\% . 4) ( ?\& . 5)
-    ( ?\' . 6) ( ?\( . 7) ( ?\) . 8) ( ?\* . 9) ( ?\+ . 10) ( ?\, . 11)
-    ( ?\- . 12) ( ?0 . 13) ( ?1 . 14) ( ?2 . 15) ( ?3 . 16) ( ?4 . 17)
-    ( ?5 . 18) ( ?6 . 19) ( ?8 . 20) ( ?9 . 21) ( ?@ . 22) ( ?A . 23)
-    ( ?B . 24) ( ?C . 25) ( ?D . 26) ( ?E . 27) ( ?F . 28) ( ?G . 29)
-    ( ?H . 30) ( ?I . 31) ( ?J . 32) ( ?K . 33) ( ?L . 34) ( ?M . 35)
-    ( ?N . 36) ( ?P . 37) ( ?Q . 38) ( ?R . 39) ( ?S . 40) ( ?T . 41)
-    ( ?U . 42) ( ?V . 43) ( ?X . 44) ( ?Y . 45) ( ?Z . 46) ( ?\[ . 47)
-    ( ?\` . 48) ( ?a . 49) ( ?b . 50) ( ?c . 51) ( ?d . 52) ( ?e . 53)
-    ( ?f . 54) ( ?h . 55) ( ?i . 56) ( ?j . 57) ( ?k . 58) ( ?l . 59)
-    ( ?m . 60) ( ?p . 61) ( ?q . 62) ( ?r . 63)))
-
-(defun binhex-char-map (char)
-  (cdr (assq char binhex-alphabet-decoding-alist)))
-
-;;;###autoload
-(defconst binhex-begin-line
-  "^:...............................................................$")
-(defconst binhex-body-line
-  "^[^:]...............................................................$")
-(defconst binhex-end-line ":$")
-
-(defvar binhex-temporary-file-directory
-  (cond ((fboundp 'temp-directory) (temp-directory))
-	((boundp 'temporary-file-directory) temporary-file-directory)
-	("/tmp/")))
-
-(eval-and-compile
-  (defalias 'binhex-insert-char
-    (if (featurep 'xemacs)
-	'insert-char
-      (lambda (char &optional count ignored buffer)
-	"Insert COUNT copies of CHARACTER into BUFFER."
-	(if (or (null buffer) (eq buffer (current-buffer)))
-	    (insert-char char count)
-	  (with-current-buffer buffer
-	    (insert-char char count)))))))
-
-(defvar binhex-crc-table
-  [0  4129  8258  12387  16516  20645  24774  28903
-      33032  37161  41290  45419  49548  53677  57806  61935
-      4657  528  12915  8786  21173  17044  29431  25302
-      37689  33560  45947  41818  54205  50076  62463  58334
-      9314  13379  1056  5121  25830  29895  17572  21637
-      42346  46411  34088  38153  58862  62927  50604  54669
-      13907  9842  5649  1584  30423  26358  22165  18100
-      46939  42874  38681  34616  63455  59390  55197  51132
-      18628  22757  26758  30887  2112  6241  10242  14371
-      51660  55789  59790  63919  35144  39273  43274  47403
-      23285  19156  31415  27286  6769  2640  14899  10770
-      56317  52188  64447  60318  39801  35672  47931  43802
-      27814  31879  19684  23749  11298  15363  3168  7233
-      60846  64911  52716  56781  44330  48395  36200  40265
-      32407  28342  24277  20212  15891  11826  7761  3696
-      65439  61374  57309  53244  48923  44858  40793  36728
-      37256  33193  45514  41451  53516  49453  61774  57711
-      4224  161  12482  8419  20484  16421  28742  24679
-      33721  37784  41979  46042  49981  54044  58239  62302
-      689  4752  8947  13010  16949  21012  25207  29270
-      46570  42443  38312  34185  62830  58703  54572  50445
-      13538  9411  5280  1153  29798  25671  21540  17413
-      42971  47098  34713  38840  59231  63358  50973  55100
-      9939  14066  1681  5808  26199  30326  17941  22068
-      55628  51565  63758  59695  39368  35305  47498  43435
-      22596  18533  30726  26663  6336  2273  14466  10403
-      52093  56156  60223  64286  35833  39896  43963  48026
-      19061  23124  27191  31254  2801  6864  10931  14994
-      64814  60687  56684  52557  48554  44427  40424  36297
-      31782  27655  23652  19525  15522  11395  7392  3265
-      61215  65342  53085  57212  44955  49082  36825  40952
-      28183  32310  20053  24180  11923  16050  3793  7920])
-
-(defun binhex-update-crc (crc char &optional count)
-  (if (null count) (setq count 1))
-  (while (> count 0)
-    (setq crc (logxor (logand (lsh crc 8) 65280)
-		      (aref binhex-crc-table
-			    (logxor (logand (lsh crc -8) 255)
-				    char)))
-	  count (1- count)))
-  crc)
-
-(defun binhex-verify-crc (buffer start end)
-  (with-current-buffer buffer
-    (let ((pos start) (crc 0) (last (- end 2)))
-      (while (< pos last)
-	(setq crc (binhex-update-crc crc (char-after pos))
-	      pos (1+ pos)))
-      (if (= crc (binhex-string-big-endian (buffer-substring last end)))
-	  nil
-	(error "CRC error")))))
-
-(defun binhex-string-big-endian (string)
-  (let ((ret 0) (i 0) (len (length string)))
-    (while (< i len)
-      (setq ret (+ (lsh ret 8) (binhex-char-int (aref string i)))
-	    i (1+ i)))
-    ret))
-
-(defun binhex-string-little-endian (string)
-  (let ((ret 0) (i 0) (shift 0) (len (length string)))
-    (while (< i len)
-      (setq ret (+ ret (lsh (binhex-char-int (aref string i)) shift))
-	    i (1+ i)
-	    shift (+ shift 8)))
-    ret))
-
-(defun binhex-header (buffer)
-  (with-current-buffer buffer
-    (let ((pos (point-min)) len)
-      (vector
-       (prog1
-	   (setq len (binhex-char-int (char-after pos)))
-	 (setq pos (1+ pos)))
-       (buffer-substring pos (setq pos (+ pos len)))
-       (prog1
-	   (setq len (binhex-char-int (char-after pos)))
-	 (setq pos (1+ pos)))
-       (buffer-substring pos (setq pos (+ pos 4)))
-       (buffer-substring pos (setq pos (+ pos 4)))
-       (binhex-string-big-endian
-	(buffer-substring pos (setq pos (+ pos 2))))
-       (binhex-string-big-endian
-	(buffer-substring pos (setq pos (+ pos 4))))
-       (binhex-string-big-endian
-	(buffer-substring pos (setq pos (+ pos 4))))))))
-
-(defvar binhex-last-char)
-(defvar binhex-repeat)
-
-(defun binhex-push-char (char &optional count ignored buffer)
-  (cond
-   (binhex-repeat
-    (if (eq char 0)
-	(binhex-insert-char (setq binhex-last-char 144) 1
-			    ignored buffer)
-      (binhex-insert-char binhex-last-char (- char 1)
-			  ignored buffer)
-      (setq binhex-last-char nil))
-    (setq binhex-repeat nil))
-   ((= char 144)
-    (setq binhex-repeat t))
-   (t
-    (binhex-insert-char (setq binhex-last-char char) 1 ignored buffer))))
-
-;;;###autoload
-(defun binhex-decode-region-internal (start end &optional header-only)
-  "Binhex decode region between START and END without using an external program.
-If HEADER-ONLY is non-nil only decode header and return filename."
-  (interactive "r")
-  (let ((work-buffer nil)
-	(counter 0)
-	(bits 0) (tmp t)
-	(lim 0) inputpos
-	(non-data-chars " \t\n\r:")
-	file-name-length data-fork-start
-	header
-	binhex-last-char binhex-repeat)
-    (unwind-protect
-	(save-excursion
-	  (goto-char start)
-	  (when (re-search-forward binhex-begin-line end t)
-	    (let (default-enable-multibyte-characters)
-	      (setq work-buffer (generate-new-buffer " *binhex-work*")))
-	    (beginning-of-line)
-	    (setq bits 0 counter 0)
-	    (while tmp
-	      (skip-chars-forward non-data-chars end)
-	      (setq inputpos (point))
-	      (end-of-line)
-	      (setq lim (point))
-	      (while (and (< inputpos lim)
-			  (setq tmp (binhex-char-map (char-after inputpos))))
-		(setq bits (+ bits tmp)
-		      counter (1+ counter)
-		      inputpos (1+ inputpos))
-		(cond ((= counter 4)
-		       (binhex-push-char (lsh bits -16) 1 nil work-buffer)
-		       (binhex-push-char (logand (lsh bits -8) 255) 1 nil
-					 work-buffer)
-		       (binhex-push-char (logand bits 255) 1 nil
-					 work-buffer)
-		       (setq bits 0 counter 0))
-		      (t (setq bits (lsh bits 6)))))
-	      (if (null file-name-length)
-		  (with-current-buffer work-buffer
-		    (setq file-name-length (char-after (point-min))
-			  data-fork-start (+ (point-min)
-					     file-name-length 22))))
-	      (when (and (null header)
-			 (with-current-buffer work-buffer
-			   (>= (buffer-size) data-fork-start)))
-		(binhex-verify-crc work-buffer
-				   (point-min) data-fork-start)
-		(setq header (binhex-header work-buffer))
-		(when header-only (setq tmp nil counter 0)))
-	      (setq tmp (and tmp (not (eq inputpos end)))))
-	    (cond
-	     ((= counter 3)
-	      (binhex-push-char (logand (lsh bits -16) 255) 1 nil
-				work-buffer)
-	      (binhex-push-char (logand (lsh bits -8) 255) 1 nil
-				work-buffer))
-	     ((= counter 2)
-	      (binhex-push-char (logand (lsh bits -10) 255) 1 nil
-				work-buffer))))
-	  (if header-only nil
-	    (binhex-verify-crc work-buffer
-			       data-fork-start
-			       (+ data-fork-start (aref header 6) 2))
-	    (or (markerp end) (setq end (set-marker (make-marker) end)))
-	    (goto-char start)
-	    (insert-buffer-substring work-buffer
-				     data-fork-start (+ data-fork-start
-							(aref header 6)))
-	    (delete-region (point) end)))
-      (and work-buffer (kill-buffer work-buffer)))
-    (if header (aref header 1))))
-
-;;;###autoload
-(defun binhex-decode-region-external (start end)
-  "Binhex decode region between START and END using external decoder."
-  (interactive "r")
-  (let ((cbuf (current-buffer)) firstline work-buffer status
-	(file-name (expand-file-name
-		    (concat (binhex-decode-region-internal start end t)
-			    ".data")
-		    binhex-temporary-file-directory)))
-    (save-excursion
-      (goto-char start)
-      (when (re-search-forward binhex-begin-line nil t)
-	(let ((cdir default-directory) default-process-coding-system)
-	  (unwind-protect
-	      (progn
-		(set-buffer (setq work-buffer
-				  (generate-new-buffer " *binhex-work*")))
-		(buffer-disable-undo work-buffer)
-		(insert-buffer-substring cbuf firstline end)
-		(cd binhex-temporary-file-directory)
-		(apply 'call-process-region
-		       (point-min)
-		       (point-max)
-		       binhex-decoder-program
-		       nil
-		       nil
-		       nil
-		       binhex-decoder-switches))
-	    (cd cdir) (set-buffer cbuf)))
-	(if (and file-name (file-exists-p file-name))
-	    (progn
-	      (goto-char start)
-	      (delete-region start end)
-	      (let (format-alist)
-		(insert-file-contents-literally file-name)))
-	  (error "Can not binhex")))
-      (and work-buffer (kill-buffer work-buffer))
-      (ignore-errors
-	(if file-name (delete-file file-name))))))
-
-;;;###autoload
-(defun binhex-decode-region (start end)
-  "Binhex decode region between START and END."
-  (interactive "r")
-  (if binhex-use-external
-      (binhex-decode-region-external start end)
-    (binhex-decode-region-internal start end)))
-
-(provide 'binhex)
-
-;;; arch-tag: 8476badd-1e76-4f1d-a640-f9a38c72eed8
-;;; binhex.el ends here
diff --git a/lisp/gnus/canlock.el b/lisp/gnus/canlock.el
index fed5598104d..145a2e518d2 100644
--- a/lisp/gnus/canlock.el
+++ b/lisp/gnus/canlock.el
@@ -6,18 +6,20 @@
 ;; Author: Katsumi Yamaoka <yamaoka@jpl.org>
 ;; Keywords: news, cancel-lock, hmac, sha1, rfc2104
 
-;; This program is free software; you can redistribute it and/or modify
+;; 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, or (at your option)
 ;; any later version.
 
-;; This program is distributed in the hope that it will be useful,
+;; 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 this program; see the file COPYING.  If not, write to the
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
 ;; Boston, MA 02110-1301, USA.
 
diff --git a/lisp/gnus/dig.el b/lisp/gnus/dig.el
deleted file mode 100644
index 9d62fdc9919..00000000000
--- a/lisp/gnus/dig.el
+++ /dev/null
@@ -1,193 +0,0 @@
-;;; dig.el --- Domain Name System dig interface
-
-;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007 Free Software Foundation, Inc.
-
-;; Author: Simon Josefsson <simon@josefsson.org>
-;; Keywords: DNS BIND dig
-
-;; 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, 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; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; This provide an interface for "dig".
-;;
-;; For interactive use, try M-x dig and type a hostname.  Use `q' to quit
-;; dig buffer.
-;;
-;; For use in elisp programs, call `dig-invoke' and use
-;; `dig-extract-rr' to extract resource records.
-
-;;; Release history:
-
-;; 2000-10-28  posted on gnu.emacs.sources
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(defgroup dig nil
-  "Dig configuration."
-  :group 'comm)
-
-(defcustom dig-program "dig"
-  "Name of dig (domain information groper) binary."
-  :type 'file
-  :group 'dig)
-
-(defcustom dig-dns-server nil
-  "DNS server to query.
-If nil, use system defaults."
-  :type '(choice (const :tag "System defaults")
-		 string)
-  :group 'dig)
-
-(defcustom dig-font-lock-keywords
-  '(("^;; [A-Z]+ SECTION:" 0 font-lock-keyword-face)
-    ("^;;.*" 0 font-lock-comment-face)
-    ("^; <<>>.*" 0 font-lock-type-face)
-    ("^;.*" 0 font-lock-function-name-face))
-  "Default expressions to highlight in dig mode."
-  :type 'sexp
-  :group 'dig)
-
-(defun dig-invoke (domain &optional
-			  query-type query-class query-option
-			  dig-option server)
-  "Call dig with given arguments and return buffer containing output.
-DOMAIN is a string with a DNS domain. QUERY-TYPE is an optional string
-with a DNS type. QUERY-CLASS is an optional string with a DNS class.
-QUERY-OPTION is an optional string with dig \"query options\".
-DIG-OPTIONS is an optional string with parameters for the dig program.
-SERVER is an optional string with a domain name server to query.
-
-Dig is an external program found in the BIND name server distribution,
-and is a commonly available debugging tool."
-  (let (buf cmdline)
-    (setq buf (generate-new-buffer "*dig output*"))
-    (if dig-option (push dig-option cmdline))
-    (if query-option (push query-option cmdline))
-    (if query-class (push query-class cmdline))
-    (if query-type (push query-type cmdline))
-    (push domain cmdline)
-    (if server (push (concat "@" server) cmdline)
-      (if dig-dns-server (push (concat "@" dig-dns-server) cmdline)))
-    (apply 'call-process dig-program nil buf nil cmdline)
-    buf))
-
-(defun dig-extract-rr (domain &optional type class)
-  "Extract resource records for DOMAIN, TYPE and CLASS from buffer.
-Buffer should contain output generated by `dig-invoke'."
-  (save-excursion
-    (goto-char (point-min))
-    (if (re-search-forward
-	 (concat domain "\\.?[\t ]+[0-9wWdDhHmMsS]+[\t ]+"
-		 (upcase (or class "IN")) "[\t ]+" (upcase (or type "A")))
-	 nil t)
-	(let (b e)
-	  (end-of-line)
-	  (setq e (point))
-	  (beginning-of-line)
-	  (setq b (point))
-	  (when (search-forward " (" e t)
-	    (search-forward " )"))
-	  (end-of-line)
-	  (setq e (point))
-	  (buffer-substring b e))
-      (and (re-search-forward (concat domain "\\.?[\t ]+[0-9wWdDhHmMsS]+[\t ]+"
-				      (upcase (or class "IN"))
-				      "[\t ]+CNAME[\t ]+\\(.*\\)$") nil t)
-	   (dig-extract-rr (match-string 1) type class)))))
-
-(defun dig-rr-get-pkix-cert (rr)
-  (let (b e str)
-    (string-match "[^\t ]+[\t ]+[0-9wWdDhHmMsS]+[\t ]+IN[\t ]+CERT[\t ]+\\(1\\|PKIX\\)[\t ]+[0-9]+[\t ]+[0-9]+[\t ]+(?" rr)
-    (setq b (match-end 0))
-    (string-match ")" rr)
-    (setq e (match-beginning 0))
-    (setq str (substring rr b e))
-    (while (string-match "[\t \n\r]" str)
-      (setq str (replace-match "" nil nil str)))
-    str))
-
-;; XEmacs does it like this.  For Emacs, we have to set the
-;; `font-lock-defaults' buffer-local variable.
-(put 'dig-mode 'font-lock-defaults '(dig-font-lock-keywords t))
-
-(put 'dig-mode 'mode-class 'special)
-
-(defvar dig-mode-map nil)
-(unless dig-mode-map
-  (setq dig-mode-map (make-sparse-keymap))
-  (suppress-keymap dig-mode-map)
-
-  (define-key dig-mode-map "q" 'dig-exit))
-
-(defun dig-mode ()
-  "Major mode for displaying dig output."
-  (interactive)
-  (kill-all-local-variables)
-  (setq mode-name "dig")
-  (setq major-mode 'dig-mode)
-  (use-local-map dig-mode-map)
-  (buffer-disable-undo)
-  (unless (featurep 'xemacs)
-    (set (make-local-variable 'font-lock-defaults)
-	 '(dig-font-lock-keywords t)))
-  (when (featurep 'font-lock)
-    (font-lock-set-defaults))
-  (gnus-run-mode-hooks 'dig-mode-hook))
-
-(defun dig-exit ()
-  "Quit dig output buffer."
-  (interactive)
-  (kill-buffer (current-buffer)))
-
-(defun dig (domain &optional
-		   query-type query-class query-option dig-option server)
-  "Query addresses of a DOMAIN using dig, by calling `dig-invoke'.
-Optional arguments are passed to `dig-invoke'."
-  (interactive "sHost: ")
-  (switch-to-buffer
-   (dig-invoke domain query-type query-class query-option dig-option server))
-  (goto-char (point-min))
-  (and (search-forward ";; ANSWER SECTION:" nil t)
-       (forward-line))
-  (dig-mode)
-  (setq buffer-read-only t)
-  (set-buffer-modified-p nil))
-
-;; named for consistency with query-dns in dns.el
-(defun query-dig (domain &optional
-			 query-type query-class query-option dig-option server)
-  "Query addresses of a DOMAIN using dig.
-It works by calling `dig-invoke' and `dig-extract-rr'.  Optional
-arguments are passed to `dig-invoke' and `dig-extract-rr'.  Returns
-nil for domain/class/type queries that results in no data."
-(let ((buffer (dig-invoke domain query-type query-class
-			  query-option dig-option server)))
-  (when buffer
-    (switch-to-buffer buffer)
-    (let ((digger (dig-extract-rr domain query-type query-class)))
-      (kill-buffer buffer)
-      digger))))
-
-(provide 'dig)
-
-;;; arch-tag: 1d61726e-9400-4013-9ae7-4035e0c7f7d6
-;;; dig.el ends here
diff --git a/lisp/gnus/dns.el b/lisp/gnus/dns.el
deleted file mode 100644
index 7910261125a..00000000000
--- a/lisp/gnus/dns.el
+++ /dev/null
@@ -1,426 +0,0 @@
-;;; dns.el --- Domain Name Service lookups
-
-;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Keywords: network
-
-;; 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, 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; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'mm-util)
-
-(defvar dns-timeout 5
-  "How many seconds to wait when doing DNS queries.")
-
-(defvar dns-servers nil
-  "Which DNS servers to query.
-If nil, /etc/resolv.conf will be consulted.")
-
-;;; Internal code:
-
-(defvar dns-query-types
-  '((A 1)
-    (NS 2)
-    (MD 3)
-    (MF 4)
-    (CNAME 5)
-    (SOA 6)
-    (MB 7)
-    (MG 8)
-    (MR 9)
-    (NULL 10)
-    (WKS 11)
-    (PTR 12)
-    (HINFO 13)
-    (MINFO 14)
-    (MX 15)
-    (TXT 16)
-    (AAAA 28) ; RFC3596
-    (SRV 33) ; RFC2782
-    (AXFR 252)
-    (MAILB 253)
-    (MAILA 254)
-    (* 255))
-  "Names of query types and their values.")
-
-(defvar dns-classes
-  '((IN 1)
-    (CS 2)
-    (CH 3)
-    (HS 4))
-  "Classes of queries.")
-
-(defun dns-write-bytes (value &optional length)
-  (let (bytes)
-    (dotimes (i (or length 1))
-      (push (% value 256) bytes)
-      (setq value (/ value 256)))
-    (dolist (byte bytes)
-      (insert byte))))
-
-(defun dns-read-bytes (length)
-  (let ((value 0))
-    (dotimes (i length)
-      (setq value (logior (* value 256) (following-char)))
-      (forward-char 1))
-    value))
-
-(defun dns-get (type spec)
-  (cadr (assq type spec)))
-
-(defun dns-inverse-get (value spec)
-  (let ((found nil))
-    (while (and (not found)
-		spec)
-      (if (eq value (cadr (car spec)))
-	  (setq found (caar spec))
-	(pop spec)))
-    found))
-
-(defun dns-write-name (name)
-  (dolist (part (split-string name "\\."))
-    (dns-write-bytes (length part))
-    (insert part))
-  (dns-write-bytes 0))
-
-(defun dns-read-string-name (string buffer)
-  (mm-with-unibyte-buffer
-    (insert string)
-    (goto-char (point-min))
-    (dns-read-name buffer)))
-
-(defun dns-read-name (&optional buffer)
-  (let ((ended nil)
-	(name nil)
-	length)
-    (while (not ended)
-      (setq length (dns-read-bytes 1))
-      (if (= 192 (logand length (lsh 3 6)))
-	  (let ((offset (+ (* (logand 63 length) 256)
-			   (dns-read-bytes 1))))
-	    (save-excursion
-	      (when buffer
-		(set-buffer buffer))
-	      (goto-char (1+ offset))
-	      (setq ended (dns-read-name buffer))))
-	(if (zerop length)
-	    (setq ended t)
-	  (push (buffer-substring (point)
-				  (progn (forward-char length) (point)))
-		name))))
-    (if (stringp ended)
-	(if (null name)
-	    ended
-	  (concat (mapconcat 'identity (nreverse name) ".") "." ended))
-      (mapconcat 'identity (nreverse name) "."))))
-
-(defun dns-write (spec &optional tcp-p)
-  "Write a DNS packet according to SPEC.
-If TCP-P, the first two bytes of the package with be the length field."
-  (with-temp-buffer
-    (dns-write-bytes (dns-get 'id spec) 2)
-    (dns-write-bytes
-     (logior
-      (lsh (if (dns-get 'response-p spec) 1 0) -7)
-      (lsh
-       (cond
-	((eq (dns-get 'opcode spec) 'query) 0)
-	((eq (dns-get 'opcode spec) 'inverse-query) 1)
-	((eq (dns-get 'opcode spec) 'status) 2)
-	(t (error "No such opcode: %s" (dns-get 'opcode spec))))
-       -3)
-      (lsh (if (dns-get 'authoritative-p spec) 1 0) -2)
-      (lsh (if (dns-get 'truncated-p spec) 1 0) -1)
-      (lsh (if (dns-get 'recursion-desired-p spec) 1 0) 0)))
-    (dns-write-bytes
-     (cond 
-      ((eq (dns-get 'response-code spec) 'no-error) 0)
-      ((eq (dns-get 'response-code spec) 'format-error) 1)
-      ((eq (dns-get 'response-code spec) 'server-failure) 2)
-      ((eq (dns-get 'response-code spec) 'name-error) 3)
-      ((eq (dns-get 'response-code spec) 'not-implemented) 4)
-      ((eq (dns-get 'response-code spec) 'refused) 5)
-      (t 0)))
-    (dns-write-bytes (length (dns-get 'queries spec)) 2)
-    (dns-write-bytes (length (dns-get 'answers spec)) 2)
-    (dns-write-bytes (length (dns-get 'authorities spec)) 2)
-    (dns-write-bytes (length (dns-get 'additionals spec)) 2)
-    (dolist (query (dns-get 'queries spec))
-      (dns-write-name (car query))
-      (dns-write-bytes (cadr (assq (or (dns-get 'type query) 'A)
-				   dns-query-types)) 2)
-      (dns-write-bytes (cadr (assq (or (dns-get 'class query) 'IN)
-				   dns-classes)) 2))
-    (dolist (slot '(answers authorities additionals))
-      (dolist (resource (dns-get slot spec))
-	(dns-write-name (car resource))
-      (dns-write-bytes (cadr (assq (dns-get 'type resource) dns-query-types))
-		       2)
-      (dns-write-bytes (cadr (assq (dns-get 'class resource) dns-classes))
-		       2)
-      (dns-write-bytes (dns-get 'ttl resource) 4)
-      (dns-write-bytes (length (dns-get 'data resource)) 2)
-      (insert (dns-get 'data resource))))
-    (when tcp-p
-      (goto-char (point-min))
-      (dns-write-bytes (buffer-size) 2))
-    (buffer-string)))
-
-(defun dns-read (packet)
-  (mm-with-unibyte-buffer
-    (let ((spec nil)
-	  queries answers authorities additionals)
-      (insert packet)
-      (goto-char (point-min))
-      (push (list 'id (dns-read-bytes 2)) spec)
-      (let ((byte (dns-read-bytes 1)))
-	(push (list 'response-p (if (zerop (logand byte (lsh 1 7))) nil t))
-	      spec)
-	(let ((opcode (logand byte (lsh 7 3))))
-	  (push (list 'opcode
-		      (cond ((eq opcode 0) 'query)
-			    ((eq opcode 1) 'inverse-query)
-			    ((eq opcode 2) 'status)))
-		spec))
-	(push (list 'authoritative-p (if (zerop (logand byte (lsh 1 2)))
-					 nil t)) spec)
-	(push (list 'truncated-p (if (zerop (logand byte (lsh 1 2))) nil t))
-	      spec)
-	(push (list 'recursion-desired-p
-		    (if (zerop (logand byte (lsh 1 0))) nil t)) spec))
-      (let ((rc (logand (dns-read-bytes 1) 15)))
-	(push (list 'response-code
-		    (cond
-		     ((eq rc 0) 'no-error)
-		     ((eq rc 1) 'format-error)
-		     ((eq rc 2) 'server-failure)
-		     ((eq rc 3) 'name-error)
-		     ((eq rc 4) 'not-implemented)
-		     ((eq rc 5) 'refused)))
-	      spec))
-      (setq queries (dns-read-bytes 2))
-      (setq answers (dns-read-bytes 2))
-      (setq authorities (dns-read-bytes 2))
-      (setq additionals (dns-read-bytes 2))
-      (let ((qs nil))
-	(dotimes (i queries)
-	  (push (list (dns-read-name)
-		      (list 'type (dns-inverse-get (dns-read-bytes 2)
-						   dns-query-types))
-		      (list 'class (dns-inverse-get (dns-read-bytes 2)
-						    dns-classes)))
-		qs))
-	(push (list 'queries qs) spec))
-    (dolist (slot '(answers authorities additionals))
-      (let ((qs nil)
-	    type)
-	(dotimes (i (symbol-value slot))
-	  (push (list (dns-read-name)
-		      (list 'type
-			    (setq type (dns-inverse-get (dns-read-bytes 2)
-							dns-query-types)))
-		      (list 'class (dns-inverse-get (dns-read-bytes 2)
-						    dns-classes))
-		      (list 'ttl (dns-read-bytes 4))
-		      (let ((length (dns-read-bytes 2)))
-			(list 'data
-			      (dns-read-type
-			       (buffer-substring
-				(point)
-				(progn (forward-char length) (point)))
-			       type))))
-		qs))
-	(push (list slot qs) spec)))
-    (nreverse spec))))
-
-(defun dns-read-int32 ()
-  ;; Full 32 bit Integers can't be handled by Emacs.  If we use
-  ;; floats, it works.
-  (format "%.0f" (+ (* (dns-read-bytes 1) 16777216.0)
-		    (dns-read-bytes 3))))
-
-(defun dns-read-type (string type)
-  (let ((buffer (current-buffer))
-	(point (point)))
-    (prog1
-	(mm-with-unibyte-buffer
-	  (insert string)
-	  (goto-char (point-min))
-	  (cond
-	   ((eq type 'A)
-	    (let ((bytes nil))
-	      (dotimes (i 4)
-		(push (dns-read-bytes 1) bytes))
-	      (mapconcat 'number-to-string (nreverse bytes) ".")))
-	   ((eq type 'AAAA)
-	    (let (hextets)
-	      (dotimes (i 8)
-		(push (dns-read-bytes 2) hextets))
-	      (mapconcat (lambda (n) (format "%x" n)) (nreverse hextets) ":")))
-	   ((eq type 'SOA)
-	    (list (list 'mname (dns-read-name buffer))
-		  (list 'rname (dns-read-name buffer))
-		  (list 'serial (dns-read-int32))
-		  (list 'refresh (dns-read-int32))
-		  (list 'retry (dns-read-int32))
-		  (list 'expire (dns-read-int32))
-		  (list 'minimum (dns-read-int32))))
-	   ((eq type 'SRV)
-	    (list (list 'priority (dns-read-bytes 2))
-		  (list 'weight (dns-read-bytes 2))
-		  (list 'port (dns-read-bytes 2))
-		  (list 'target (dns-read-name buffer))))
-	   ((eq type 'MX)
-	    (cons (dns-read-bytes 2) (dns-read-name buffer)))
-	   ((or (eq type 'CNAME) (eq type 'NS) (eq type 'PTR))
-	    (dns-read-string-name string buffer))
-	   (t string)))
-      (goto-char point))))
-
-(defun dns-parse-resolv-conf ()
-  (when (file-exists-p "/etc/resolv.conf")
-    (with-temp-buffer
-      (insert-file-contents "/etc/resolv.conf")
-      (goto-char (point-min))
-      (while (re-search-forward "^nameserver[\t ]+\\([^ \t\n]+\\)" nil t)
-	(push (match-string 1) dns-servers))
-      (setq dns-servers (nreverse dns-servers)))))
-
-(defun dns-read-txt (string)
-  (if (> (length string) 1)
-      (substring string 1)
-    string))
-
-(defun dns-get-txt-answer (answers)
-  (let ((result "")
-	(do-next nil))
-    (dolist (answer answers)
-      (dolist (elem answer)
-	(when (consp elem)
-	  (cond
-	   ((eq (car elem) 'type)
-	    (setq do-next (eq (cadr elem) 'TXT)))
-	   ((eq (car elem) 'data)
-	    (when do-next
-	      (setq result (concat result (dns-read-txt (cadr elem))))))))))
-    result))
-
-;;; Interface functions.
-(defmacro dns-make-network-process (server)
-  (if (featurep 'xemacs)
-      `(let ((coding-system-for-read 'binary)
-	     (coding-system-for-write 'binary))
-	 (open-network-stream "dns" (current-buffer)
-			      ,server "domain" 'udp))
-    `(let ((server ,server)
-	   (coding-system-for-read 'binary)
-	   (coding-system-for-write 'binary))
-       (if (fboundp 'make-network-process)
-	   (make-network-process
-	    :name "dns"
-	    :coding 'binary
-	    :buffer (current-buffer)
-	    :host server
-	    :service "domain"
-	    :type 'datagram)
-	 ;; Older versions of Emacs doesn't have
-	 ;; `make-network-process', so we fall back on opening a TCP
-	 ;; connection to the DNS server.
-	 (open-network-stream "dns" (current-buffer) server "domain")))))
-
-(defvar dns-cache (make-vector 4096 0))
-
-(defun query-dns-cached (name &optional type fullp reversep)
-  (let* ((key (format "%s:%s:%s:%s" name type fullp reversep))
-	 (sym (intern-soft key dns-cache)))
-    (if (and sym
-	     (boundp sym))
-	(symbol-value sym)
-      (let ((result (query-dns name type fullp reversep)))
-	(set (intern key dns-cache) result)
-	result))))
-
-(defun query-dns (name &optional type fullp reversep)
-  "Query a DNS server for NAME of TYPE.
-If FULLP, return the entire record returned.
-If REVERSEP, look up an IP address."
-  (setq type (or type 'A))
-  (unless dns-servers
-    (dns-parse-resolv-conf))
-
-  (when reversep
-    (setq name (concat
-		(mapconcat 'identity (nreverse (split-string name "\\.")) ".")
-		".in-addr.arpa")
-	  type 'PTR))
-
-  (if (not dns-servers)
-      (message "No DNS server configuration found")
-    (mm-with-unibyte-buffer
-      (let ((process (condition-case ()
-			 (dns-make-network-process (car dns-servers))
-		       (error
-			(message "dns: Got an error while trying to talk to %s"
-				 (car dns-servers))
-			nil)))
-	    (tcp-p (and (not (fboundp 'make-network-process))
-			(not (featurep 'xemacs))))
-	    (step 100)
-	    (times (* dns-timeout 1000))
-	    (id (random 65000)))
-	(when process
-	  (process-send-string
-	   process
-	   (dns-write `((id ,id)
-			(opcode query)
-			(queries ((,name (type ,type))))
-			(recursion-desired-p t))
-		      tcp-p))
-	  (while (and (zerop (buffer-size))
-		      (> times 0))
-	    (sit-for (/ step 1000.0))
-	    (accept-process-output process 0 step)
-	    (decf times step))
-	  (ignore-errors
-	    (delete-process process))
-	  (when (and tcp-p
-		     (>= (buffer-size) 2))
-	    (goto-char (point-min))
-	    (delete-region (point) (+ (point) 2)))
-	  (when (and (>= (buffer-size) 2)
-		     ;; We had a time-out.
-		     (> times 0))
-	    (let ((result (dns-read (buffer-string))))
-	      (if fullp
-		  result
-		(let ((answer (car (dns-get 'answers result))))
-		  (when (eq type (dns-get 'type answer))
-		    (if (eq type 'TXT)
-			(dns-get-txt-answer (dns-get 'answers result))
-		      (dns-get 'data answer))))))))))))
-
-(provide 'dns)
-
-;;; arch-tag: d0edd0c4-4cce-4538-ae92-06c3356ee80a
-;;; dns.el ends here
diff --git a/lisp/gnus/ecomplete.el b/lisp/gnus/ecomplete.el
index 1c333fd2e03..42a75916277 100644
--- a/lisp/gnus/ecomplete.el
+++ b/lisp/gnus/ecomplete.el
@@ -1,5 +1,6 @@
 ;;; ecomplete.el --- electric completion of addresses and the like
-;; Copyright (C) 2006 Free Software Foundation, Inc.
+
+;; Copyright (C) 2006, 2007  Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: mail
diff --git a/lisp/gnus/encrypt.el b/lisp/gnus/encrypt.el
deleted file mode 100644
index 1fb54a280eb..00000000000
--- a/lisp/gnus/encrypt.el
+++ /dev/null
@@ -1,296 +0,0 @@
-;;; encrypt.el --- file encryption routines
-;; Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
-
-;; Author: Teodor Zlatanov <tzz@lifelogs.com>
-;; Created: 2003/01/24
-;; Keywords: files
-
-;; 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, 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; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; This module addresses data encryption.  Page breaks are used for
-;;; grouping declarations and documentation relating to each
-;;; particular aspect.
-
-;;; Use in Gnus like this:
-;;; (setq
-;;;   nnimap-authinfo-file "~/.authinfo.enc"
-;;;   nntp-authinfo-file "~/.authinfo.enc"
-;;;   smtpmail-auth-credentials "~/.authinfo.enc"
-;;;   ;; using the AES256 cipher, feel free to use your own favorite
-;;;   encrypt-file-alist (quote (("~/.authinfo.enc" (gpg "AES256"))))
-;;;   password-cache-expiry 600)
-
-;;; Then write ~/.authinfo.enc:
-
-;;; 1) open the old authinfo
-;;; C-x C-f ~/.authinfo
-
-;;; 2) write the new authinfo.enc
-;;; M-x encrypt-write-file-contents RET ~/.authinfo.enc
-
-;;; 3) verify the new authinfo is correct (this will show the contents in the minibuffer)
-;;; M-: (encrypt-get-file-contents "~/.authinfo.enc")
-
-
-;;; Code:
-
-;; autoload password
-(eval-and-compile
-  (autoload 'password-read "password"))
-
-(defgroup encrypt '((password-cache custom-variable)
-		    (password-cache-expiry custom-variable))
-  "File encryption configuration."
-  :group 'applications)
-
-(defcustom encrypt-file-alist nil
-  "List of file names or regexes matched with encryptions.
-Format example:
- '((\"beta\"
-    (gpg \"AES\"))
-   (\"/home/tzz/alpha\"
-    (encrypt-xor \"Semi-Secret\")))"
-
-  :type '(repeat
-	  (list :tag "Encryption entry"
-	   (radio :tag "What to encrypt"
-		  (file :tag "Filename")
-		  (regexp :tag "Regular expression match"))
-	   (radio :tag "How to encrypt it"
-		  (list
-		   :tag "GPG Encryption"
-		   (const :tag "GPG Program" gpg)
-		   (radio :tag "Choose a cipher"
-			  (const :tag "3DES Encryption" "3DES")
-			  (const :tag "CAST5 Encryption" "CAST5")
-			  (const :tag "Blowfish Encryption" "BLOWFISH")
-			  (const :tag "AES Encryption" "AES")
-			  (const :tag "AES192 Encryption" "AES192")
-			  (const :tag "AES256 Encryption" "AES256")
-			  (const :tag "Twofish Encryption" "TWOFISH")
-			  (string :tag "Cipher Name")))
-		  (list
-		   :tag "Built-in simple XOR"
-		   (const :tag "XOR Encryption" encrypt-xor)
-		   (string :tag "XOR Cipher Value (seed value)")))))
-  :group 'encrypt)
-
-;; TODO: now, load gencrypt.el and if successful, modify the
-;; custom-type of encrypt-file-alist to add the gencrypt.el options
-
-;; (plist-get (symbol-plist 'encrypt-file-alist) 'custom-type)
-;; then use plist-put
-
-(defcustom encrypt-gpg-path (executable-find "gpg")
-  "Path to the GPG program."
-  :type '(radio
-	  (file :tag "Location of the GPG executable")
-	  (const :tag "GPG is not installed" nil))
-  :group 'encrypt)
-
-(defvar encrypt-temp-prefix "encrypt"
-  "Prefix for temporary filenames")
-
-;;;###autoload
-(defun encrypt-find-model (filename)
-  "Given a filename, find a encrypt-file-alist entry"
-  (dolist (entry encrypt-file-alist)
-    (let ((match (nth 0 entry))
-	  (model (nth 1 entry)))
-      (when (or (eq match filename)
-		(string-match match filename))
-	(return model)))))
-
-;;;###autoload
-(defun encrypt-insert-file-contents (file &optional model)
-  "Decrypt FILE into the current buffer."
-  (interactive "fFile to insert: ")
-  (let* ((model (or model (encrypt-find-model file)))
-	 (method (nth 0 model))
-	 (cipher (nth 1 model))
-	 (password-key (format "encrypt-password-%s-%s %s"
-			       (symbol-name method) cipher file))
-	 (passphrase
-	  (password-read-and-add
-	   (format "%s password for cipher %s (file %s)? "
-		   file (symbol-name method) cipher)
-	   password-key))
-	  (buffer-file-coding-system 'binary)
-	 (coding-system-for-read 'binary)
-	 outdata)
-
-    ;; note we only insert-file-contents if the method is known to be valid
-    (cond
-     ((eq method 'gpg)
-      (insert-file-contents file)
-      (setq outdata (encrypt-gpg-decode-buffer passphrase cipher)))
-     ((eq method 'encrypt-xor)
-      (insert-file-contents file)
-      (setq outdata (encrypt-xor-decode-buffer passphrase cipher))))
-
-    (if outdata
-	(progn
-	  (message "%s was decrypted with %s (cipher %s)"
-		   file (symbol-name method) cipher)
-	  (delete-region (point-min) (point-max))
-	  (goto-char (point-min))
-	  (insert outdata))
-      ;; the decryption failed, alas
-      (password-cache-remove password-key)
-      (gnus-error 5 "%s was NOT decrypted with %s (cipher %s)"
-		  file (symbol-name method) cipher))))
-
-(defun encrypt-get-file-contents (file &optional model)
-  "Decrypt FILE and return the contents."
-  (interactive "fFile to decrypt: ")
-  (with-temp-buffer
-    (encrypt-insert-file-contents file model)
-    (buffer-string)))
-
-(defun encrypt-put-file-contents (file data &optional model)
-  "Encrypt the DATA to FILE, then continue normally."
-  (with-temp-buffer
-    (insert data)
-    (encrypt-write-file-contents file model)))
-
-(defun encrypt-write-file-contents (file &optional model)
-  "Encrypt the current buffer to FILE, then continue normally."
-  (interactive "sFile to write: ")
-  (setq model (or model (encrypt-find-model file)))
-  (if model
-      (let* ((method (nth 0 model))
-	     (cipher (nth 1 model))
-	     (password-key (format "encrypt-password-%s-%s %s"
-				   (symbol-name method) cipher file))
-	     (passphrase
-	      (password-read
-	       (format "%s password for cipher %s? "
-		       (symbol-name method) cipher)
-	       password-key))
-	     outdata)
-
-	(cond
-	 ((eq method 'gpg)
-	  (setq outdata (encrypt-gpg-encode-buffer passphrase cipher)))
-	 ((eq method 'encrypt-xor)
-	  (setq outdata (encrypt-xor-encode-buffer passphrase cipher))))
-
-	(if outdata
-	    (progn
-	      (message "%s was encrypted with %s (cipher %s)"
-		       file (symbol-name method) cipher)
-	      (delete-region (point-min) (point-max))
-	      (goto-char (point-min))
-	      (insert outdata)
-	      ;; do not confirm overwrites
-	      (write-file file nil))
-	  ;; the decryption failed, alas
-	  (password-cache-remove password-key)
-	  (gnus-error 5 "%s was NOT encrypted with %s (cipher %s)"
-		      file (symbol-name method) cipher)))
-    (gnus-error 1 "%s has no associated encryption model!  See encrypt-file-alist." file)))
-
-(defun encrypt-xor-encode-buffer (passphrase cipher)
-  (encrypt-xor-process-buffer passphrase cipher t))
-
-(defun encrypt-xor-decode-buffer (passphrase cipher)
-  (encrypt-xor-process-buffer passphrase cipher nil))
-
-(defun encrypt-xor-process-buffer (passphrase
-					cipher
-					&optional encode)
-  "Given PASSPHRASE, xor-encode or decode the contents of the current buffer."
-  (let* ((bs (buffer-substring-no-properties (point-min) (point-max)))
-	 ;; passphrase-sum is a simple additive checksum of the
-	 ;; passphrase and the cipher
-	(passphrase-sum
-	 (when (stringp passphrase)
-	   (apply '+ (append cipher passphrase nil))))
-	new-list)
-
-    (with-temp-buffer
-      (if encode
-	  (progn
-	    (dolist (x (append bs nil))
-	      (setq new-list (cons (logxor x passphrase-sum) new-list)))
-
-	    (dolist (x new-list)
-	      (insert (format "%d " x))))
-	(progn
-	  (setq new-list (reverse (split-string bs)))
-	  (dolist (x new-list)
-	    (setq x (string-to-number x))
-	    (insert (format "%c" (logxor x passphrase-sum))))))
-      (buffer-substring-no-properties (point-min) (point-max)))))
-
-(defun encrypt-gpg-encode-buffer (passphrase cipher)
-  (encrypt-gpg-process-buffer passphrase cipher t))
-
-(defun encrypt-gpg-decode-buffer (passphrase cipher)
-  (encrypt-gpg-process-buffer passphrase cipher nil))
-
-(defun encrypt-gpg-process-buffer (passphrase 
-					cipher 
-					&optional encode)
-  "With PASSPHRASE, use GPG to encode or decode the current buffer."
-  (let* ((program encrypt-gpg-path)
-	 (input (buffer-substring-no-properties (point-min) (point-max)))
-	 (temp-maker (if (fboundp 'make-temp-file) 
-			 'make-temp-file 
-		       'make-temp-name))
-	 (temp-file (funcall temp-maker encrypt-temp-prefix))
-	 (default-enable-multibyte-characters nil)
-	 (args `("--cipher-algo" ,cipher
-		 "--status-fd" "2"
-		 "--logger-fd" "2"
-		 "--passphrase-fd" "0"
-		 "--no-tty"))
-	 exit-status exit-data)
-    
-    (when encode
-      (setq args
-	    (append args
-		    '("--symmetric"
-		      "--armor"))))
-
-    (if program
-	(with-temp-buffer
-	  (when passphrase
-	    (insert passphrase "\n"))
-	  (insert input)
-	  (setq exit-status
-		(apply #'call-process-region (point-min) (point-max) program
-		       t `(t ,temp-file) nil args))
-	  (if (equal exit-status 0)
-	      (setq exit-data
-		    (buffer-substring-no-properties (point-min) (point-max)))
-	    (with-temp-buffer
-	      (when (file-exists-p temp-file)
-		(insert-file-contents temp-file))
-	      (gnus-error 5 (format "%s exited abnormally: '%s' [%s]"
-				    program exit-status (buffer-string)))))
-	  (delete-file temp-file))
-      (gnus-error 5 "GPG is not installed."))
-    exit-data))
-
-(provide 'encrypt)
-;;; encrypt.el ends here
-
-;; arch-tag: d907e4f1-71b5-42b1-a180-fc7b84ff0648
diff --git a/lisp/gnus/flow-fill.el b/lisp/gnus/flow-fill.el
index 1644ed0f8f2..a13cd23156d 100644
--- a/lisp/gnus/flow-fill.el
+++ b/lisp/gnus/flow-fill.el
@@ -154,8 +154,7 @@ RFC 2646 suggests 66 characters for readability."
 
 ;; Test vectors.
 
-(eval-when-compile
-  (defvar show-trailing-whitespace))
+(defvar show-trailing-whitespace)
 
 (defvar fill-flowed-encode-tests
   `(
diff --git a/lisp/gnus/format-spec.el b/lisp/gnus/format-spec.el
deleted file mode 100644
index 951f9aecb81..00000000000
--- a/lisp/gnus/format-spec.el
+++ /dev/null
@@ -1,82 +0,0 @@
-;;; format-spec.el --- functions for formatting arbitrary formatting strings
-
-;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Keywords: tools
-
-;; 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, 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; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(defun format-spec (format specification)
-  "Return a string based on FORMAT and SPECIFICATION.
-FORMAT is a string containing `format'-like specs like \"bash %u %k\",
-while SPECIFICATION is an alist mapping from format spec characters
-to values.  Any text properties on a %-spec itself are propagated to
-the text that it generates."
-  (with-temp-buffer
-    (insert format)
-    (goto-char (point-min))
-    (while (search-forward "%" nil t)
-      (cond
-       ;; Quoted percent sign.
-       ((eq (char-after) ?%)
-	(delete-char 1))
-       ;; Valid format spec.
-       ((looking-at "\\([-0-9.]*\\)\\([a-zA-Z]\\)")
-	(let* ((num (match-string 1))
-	       (spec (string-to-char (match-string 2)))
-	       (val (cdr (assq spec specification))))
-	  (unless val
-	    (error "Invalid format character: `%%%c'" spec))
-	  ;; Pad result to desired length.
-          (let ((text (format (concat "%" num "s") val)))
-	    ;; Insert first, to preserve text properties.
-            (insert-and-inherit text)
-            ;; Delete the specifier body.
-            (delete-region (+ (match-beginning 0) (length text))
-                           (+ (match-end 0) (length text)))
-            ;; Delete the percent sign.
-            (delete-region (1- (match-beginning 0)) (match-beginning 0)))))
-       ;; Signal an error on bogus format strings.
-       (t
-	(error "Invalid format string"))))
-    (buffer-string)))
-
-(defun format-spec-make (&rest pairs)
-  "Return an alist suitable for use in `format-spec' based on PAIRS.
-PAIRS is a list where every other element is a character and a value,
-starting with a character."
-  (let (alist)
-    (while pairs
-      (unless (cdr pairs)
-	(error "Invalid list of pairs"))
-      (push (cons (car pairs) (cadr pairs)) alist)
-      (setq pairs (cddr pairs)))
-    (nreverse alist)))
-
-(provide 'format-spec)
-
-;;; arch-tag: c22d49cf-d167-445d-b7f1-2504d4173f53
-;;; format-spec.el ends here
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index 0271186273a..22ffd585973 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -636,8 +636,7 @@ manipulated as follows:
                  (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 @@ be a select method."
   (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 @@ be a select method."
 
 (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
@@ -2104,8 +2104,7 @@ doesn't exist, to valid the overview buffer."
 
 ;; Keeps the compiler from warning about the free variable in
 ;; gnus-agent-read-agentview.
-(eval-when-compile
-  (defvar gnus-agent-read-agentview))
+(defvar gnus-agent-read-agentview)
 
 (defun gnus-agent-load-alist (group)
   "Load the article-state alist for GROUP."
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 0c98babcad5..4bb9ceb97ba 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -28,9 +28,9 @@
 ;;; Code:
 
 (eval-when-compile
-  (require 'cl)
-  (defvar tool-bar-map)
-  (defvar w3m-minor-mode-map))
+  (require 'cl))
+(defvar tool-bar-map)
+(defvar w3m-minor-mode-map)
 
 (require 'gnus)
 ;; Avoid the "Recursive load suspected" error in Emacs 21.1.
@@ -2222,7 +2222,7 @@ unfolded."
 	(mail-header-fold-field)
 	(goto-char (point-max))))))
 
-(defcustom gnus-article-truncate-lines default-truncate-lines
+(defcustom gnus-article-truncate-lines (default-value 'truncate-lines)
   "Value of `truncate-lines' in Gnus Article buffer.
 Valid values are nil, t, `head', `first', `last', an integer or a
 predicate.  See Info node `(gnus)Customizing Articles'."
@@ -2332,12 +2332,11 @@ long lines iff arg is positive."
 	 (forward-line 1)
 	 (point))))))
 
-(eval-when-compile
-  (defvar gnus-face-properties-alist))
+(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
@@ -2347,7 +2346,8 @@ long lines iff arg is positive."
       ;; 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)
@@ -2355,16 +2355,22 @@ long lines iff arg is positive."
 	      (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
@@ -2389,7 +2395,8 @@ long lines iff arg is positive."
 	  ;; 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)
@@ -2400,43 +2407,41 @@ long lines iff arg is positive."
 	      (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."
@@ -2726,7 +2731,7 @@ charset defined in `gnus-summary-show-article-charset-alist' is used."
 	   ;; Put the mark meaning this part was rendered by emacs-w3m.
 	   'mm-inline-text-html-with-w3m t))))
 
-(eval-when-compile (defvar charset)) ;; Bound by `article-wash-html'.
+(defvar charset) ;; Bound by `article-wash-html'.
 
 (defun gnus-article-wash-html-with-w3m-standalone ()
   "Wash the current buffer with w3m."
@@ -2797,8 +2802,37 @@ Recurse into multiparts."
 		    (string-match "text/html" (car (mm-handle-type handle))))
 	       (let ((tmp-file (mm-make-temp-file
 				;; Do we need to care for 8.3 filenames?
-				"mm-" nil ".html")))
-		 (mm-save-part-to-file handle tmp-file)
+				"mm-" nil ".html"))
+		     (charset (mail-content-type-get (mm-handle-type handle)
+						     'charset)))
+		 (if charset
+		     ;; Add a meta html tag to specify charset.
+		     (mm-with-unibyte-buffer
+		       (insert (with-current-buffer (mm-handle-buffer handle)
+				 (if (eq charset 'gnus-decoded)
+				     (mm-encode-coding-string
+				      (buffer-string)
+				      (setq charset 'utf-8))
+				   (buffer-string))))
+		       (setq charset (format "\
+<meta http-equiv=\"Content-Type\" content=\"text/html; charset=%s\">"
+					     charset))
+		       (goto-char (point-min))
+		       (let ((case-fold-search t))
+			 (cond (;; Don't modify existing meta tag.
+				(re-search-forward "\
+<meta[\t\n\r ]+http-equiv=\"content-type\"[^>]+>"
+						   nil t))
+			       ((re-search-forward "<head>[\t\n\r ]*" nil t)
+				(insert charset "\n"))
+			       (t
+				(re-search-forward "\
+<html\\(?:[\t\n\r ]+[^>]+\\|[\t\n\r ]*\\)>[\t\n\r ]*"
+						   nil t)
+				(insert "<head>\n" charset "\n</head>\n"))))
+		       (mm-write-region (point-min) (point-max)
+					tmp-file nil nil nil 'binary t))
+		   (mm-save-part-to-file handle tmp-file))
 		 (add-to-list 'gnus-article-browse-html-temp-list tmp-file)
 		 (add-hook 'gnus-summary-prepare-exit-hook
 			   'gnus-article-browse-delete-temp-files)
@@ -2824,7 +2858,10 @@ Warning: Spammers use links to images in HTML articles to verify
 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
@@ -3529,9 +3566,8 @@ This format is defined by the `gnus-article-time-format' variable."
 				 gnus-newsgroup-name 'highlight-words t)))
 	     gnus-emphasis-alist)))))
 
-(eval-when-compile
-  (defvar gnus-summary-article-menu)
-  (defvar gnus-summary-post-menu))
+(defvar gnus-summary-article-menu)
+(defvar gnus-summary-post-menu)
 
 ;;; Saving functions.
 
@@ -7903,12 +7939,11 @@ For example:
 	  (funcall (cadr elem)))))))
 
 ;; Dynamic variables.
-(eval-when-compile
-  (defvar part-number)
-  (defvar total-parts)
-  (defvar type)
-  (defvar condition)
-  (defvar length))
+(defvar part-number)
+(defvar total-parts)
+(defvar type)
+(defvar condition)
+(defvar length)
 
 (defun gnus-treat-predicate (val)
   (cond
diff --git a/lisp/gnus/gnus-bookmark.el b/lisp/gnus/gnus-bookmark.el
index 1e76e3ac57b..6341c8e48d8 100644
--- a/lisp/gnus/gnus-bookmark.el
+++ b/lisp/gnus/gnus-bookmark.el
@@ -1,6 +1,6 @@
 ;;; gnus-bookmark.el --- Bookmarks in Gnus
 
-;; Copyright (C) 2006 Free Software Foundation, Inc.
+;; Copyright (C) 2006, 2007  Free Software Foundation, Inc.
 
 ;; Author: Bastien Guerry <bzg AT altern DOT org>
 ;; Keywords: news
diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el
index fecb0685858..4f61a0f2759 100644
--- a/lisp/gnus/gnus-cache.el
+++ b/lisp/gnus/gnus-cache.el
@@ -92,7 +92,7 @@ it's not cached."
 (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 @@ $ emacs -batch -l ~/.emacs -l gnus -f gnus-jog-cache"
   (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 @@ If LOW, update the lower bound instead."
   (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)
 
diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el
index 5d1b2b26a8e..908a75513e4 100644
--- a/lisp/gnus/gnus-cite.el
+++ b/lisp/gnus/gnus-cite.el
@@ -1170,10 +1170,9 @@ Returns nil if there is no such line before LIMIT, t otherwise."
 	   (setq count (1+ count)))))) ;;
   "Keywords for highlighting different levels of message citations.")
 
-(eval-when-compile
-  (defvar font-lock-defaults-computed)
-  (defvar font-lock-keywords)
-  (defvar font-lock-set-defaults))
+(defvar font-lock-defaults-computed)
+(defvar font-lock-keywords)
+(defvar font-lock-set-defaults)
 
 (eval-and-compile
   (unless (featurep 'xemacs)
diff --git a/lisp/gnus/gnus-cus.el b/lisp/gnus/gnus-cus.el
index 6d37120bd59..845a467c574 100644
--- a/lisp/gnus/gnus-cus.el
+++ b/lisp/gnus/gnus-cus.el
@@ -949,20 +949,18 @@ articles in the thread.
     (gnus-score-set 'touched '(t) alist))
   (bury-buffer))
 
-(eval-when-compile
-  (defvar category-fields nil)
-  (defvar gnus-agent-cat-name)
-  (defvar gnus-agent-cat-score-file)
-  (defvar gnus-agent-cat-length-when-short)
-  (defvar gnus-agent-cat-length-when-long)
-  (defvar gnus-agent-cat-low-score)
-  (defvar gnus-agent-cat-high-score)
-  (defvar gnus-agent-cat-enable-expiration)
-  (defvar gnus-agent-cat-days-until-old)
-  (defvar gnus-agent-cat-predicate)
-  (defvar gnus-agent-cat-groups)
-  (defvar gnus-agent-cat-enable-undownloaded-faces)
-)
+(defvar category-fields nil)
+(defvar gnus-agent-cat-name)
+(defvar gnus-agent-cat-score-file)
+(defvar gnus-agent-cat-length-when-short)
+(defvar gnus-agent-cat-length-when-long)
+(defvar gnus-agent-cat-low-score)
+(defvar gnus-agent-cat-high-score)
+(defvar gnus-agent-cat-enable-expiration)
+(defvar gnus-agent-cat-days-until-old)
+(defvar gnus-agent-cat-predicate)
+(defvar gnus-agent-cat-groups)
+(defvar gnus-agent-cat-enable-undownloaded-faces)
 
 (defun gnus-trim-whitespace (s)
   (when (string-match "\\`[ \n\t]+" s)
diff --git a/lisp/gnus/gnus-demon.el b/lisp/gnus/gnus-demon.el
index 98d098c51cf..421d4a07ee7 100644
--- a/lisp/gnus/gnus-demon.el
+++ b/lisp/gnus/gnus-demon.el
@@ -39,7 +39,7 @@
 (autoload 'parse-time-string "parse-time" nil nil)
 
 (defgroup gnus-demon nil
-  "Demonic behaviour."
+  "Demonic behavior."
   :group 'gnus)
 
 (defcustom gnus-demon-handlers nil
diff --git a/lisp/gnus/gnus-dired.el b/lisp/gnus/gnus-dired.el
index fa9ef21bd1a..97e61a013c8 100644
--- a/lisp/gnus/gnus-dired.el
+++ b/lisp/gnus/gnus-dired.el
@@ -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 @@ filenames."
 	    (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 @@ If ARG is non-nil, open it in a new buffer."
 		  (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 @@ file to save in."
 		     (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 @@ file to save in."
 			(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"))
diff --git a/lisp/gnus/gnus-ems.el b/lisp/gnus/gnus-ems.el
index f37b1b73416..79e513b5f05 100644
--- a/lisp/gnus/gnus-ems.el
+++ b/lisp/gnus/gnus-ems.el
@@ -74,19 +74,18 @@
     (defvar gnus-mouse-face-prop 'mouse-face
       "Property used for highlighting mouse regions.")))
 
-(eval-when-compile
-  (defvar gnus-tmp-unread)
-  (defvar gnus-tmp-replied)
-  (defvar gnus-tmp-score-char)
-  (defvar gnus-tmp-indentation)
-  (defvar gnus-tmp-opening-bracket)
-  (defvar gnus-tmp-lines)
-  (defvar gnus-tmp-name)
-  (defvar gnus-tmp-closing-bracket)
-  (defvar gnus-tmp-subject-or-nil)
-  (defvar gnus-check-before-posting)
-  (defvar gnus-mouse-face)
-  (defvar gnus-group-buffer))
+(defvar gnus-tmp-unread)
+(defvar gnus-tmp-replied)
+(defvar gnus-tmp-score-char)
+(defvar gnus-tmp-indentation)
+(defvar gnus-tmp-opening-bracket)
+(defvar gnus-tmp-lines)
+(defvar gnus-tmp-name)
+(defvar gnus-tmp-closing-bracket)
+(defvar gnus-tmp-subject-or-nil)
+(defvar gnus-check-before-posting)
+(defvar gnus-mouse-face)
+(defvar gnus-group-buffer)
 
 (defun gnus-ems-redefine ()
   (cond
diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el
index 162cc7e1984..05454960e38 100644
--- a/lisp/gnus/gnus-fun.el
+++ b/lisp/gnus/gnus-fun.el
@@ -34,6 +34,8 @@
 (require 'gnus-util)
 (require 'gnus)
 
+(defvar gnus-face-properties-alist)
+
 (defcustom gnus-x-face-directory (expand-file-name "x-faces" gnus-directory)
   "*Directory where X-Face PBM files are stored."
   :version "22.1"
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index 942a1cf4947..5843214e48a 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -28,8 +28,8 @@
 ;;; Code:
 
 (eval-when-compile
-  (require 'cl)
-  (defvar tool-bar-mode))
+  (require 'cl))
+(defvar tool-bar-mode)
 
 (require 'gnus)
 (require 'gnus-start)
@@ -1655,6 +1655,24 @@ if it is a string, only list groups matching REGEXP."
 	 (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))))
@@ -2875,8 +2893,8 @@ If SOLID (the prefix), create a solid group."
        (cons (current-buffer)
 	     (if (eq major-mode 'gnus-summary-mode) 'summary 'group))))))
 
+(defvar nnrss-group-alist)
 (eval-when-compile
-  (defvar nnrss-group-alist)
   (defun nnrss-discover-feed (arg))
   (defun nnrss-save-server-data (arg)))
 (defun gnus-group-make-rss-group (&optional url)
diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el
index 52b5e350653..ac2b7237866 100644
--- a/lisp/gnus/gnus-int.el
+++ b/lisp/gnus/gnus-int.el
@@ -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 @@ If it is down, start it up (again)."
               ;; 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)
diff --git a/lisp/gnus/gnus-kill.el b/lisp/gnus/gnus-kill.el
index 5778a02e168..2d64a76b6c6 100644
--- a/lisp/gnus/gnus-kill.el
+++ b/lisp/gnus/gnus-kill.el
@@ -687,7 +687,6 @@ Usage: emacs -batch -l ~/.emacs -l gnus -f gnus-batch-score"
 	   (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)
diff --git a/lisp/gnus/gnus-mh.el b/lisp/gnus/gnus-mh.el
index 66321c0d3e8..48a85071e67 100644
--- a/lisp/gnus/gnus-mh.el
+++ b/lisp/gnus/gnus-mh.el
@@ -41,8 +41,7 @@
 (require 'gnus-msg)
 (require 'gnus-sum)
 
-(eval-when-compile
-  (defvar mh-lib-progs))
+(defvar mh-lib-progs)
 
 (defun gnus-summary-save-article-folder (&optional arg)
   "Append the current article to an mh folder.
diff --git a/lisp/gnus/gnus-move.el b/lisp/gnus/gnus-move.el
index 0a97f8d5bd6..cf5cde692ff 100644
--- a/lisp/gnus/gnus-move.el
+++ b/lisp/gnus/gnus-move.el
@@ -47,8 +47,7 @@ Update the .newsrc.eld file to reflect the change of nntp server."
 
   ;; First start Gnus.
   (let ((gnus-activate-level 0)
-	(mail-sources nil)
-	(nnmail-spool-file nil))
+	(mail-sources nil))
     (gnus))
 
   (save-excursion
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index 891ed1bc269..735b9ed629b 100644
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -265,7 +265,7 @@ This can also be a function receiving the group name as the only
 parameter, which should return non-nil if a confirmation is needed; or
 a regexp, in which case a confirmation is asked for if the group name
 matches the regexp."
-  :version "22.1"
+  :version "23.0" ;; No Gnus (default changed)
   :group 'gnus-message
   :type '(choice (const :tag "No" nil)
 		 (const :tag "Yes" t)
@@ -1101,7 +1101,10 @@ If VERY-WIDE, make a very wide reply."
 		       ((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)
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el
index 2ccf70efc46..d45cc6c5d6d 100644
--- a/lisp/gnus/gnus-registry.el
+++ b/lisp/gnus/gnus-registry.el
@@ -63,6 +63,8 @@
 (require 'gnus-util)
 (require 'nnmail)
 
+(defvar gnus-adaptive-word-syntax-table)
+
 (defvar gnus-registry-dirty t
  "Boolean set to t when the registry is modified")
 
diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el
index ca087f9ca4d..77e06ee04f8 100644
--- a/lisp/gnus/gnus-srvr.el
+++ b/lisp/gnus/gnus-srvr.el
@@ -280,7 +280,7 @@ The following commands are available:
        ;; 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."
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index 39de524b156..2c1b6677949 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -39,11 +39,11 @@
 (autoload 'gnus-agent-possibly-alter-active "gnus-agent")
 
 (eval-when-compile
-  (require 'cl)
+  (require 'cl))
 
-  (defvar gnus-agent-covered-methods nil)
-  (defvar gnus-agent-file-loading-local nil)
-  (defvar gnus-agent-file-loading-cache nil))
+(defvar gnus-agent-covered-methods)
+(defvar gnus-agent-file-loading-local)
+(defvar gnus-agent-file-loading-cache)
 
 (defcustom gnus-startup-file (nnheader-concat gnus-home-directory ".newsrc")
   "Your `.newsrc' file.
@@ -652,21 +652,20 @@ the first newsgroup."
 ;;; General various misc type functions.
 
 ;; Silence byte-compiler.
-(eval-when-compile
-  (defvar gnus-current-headers)
-  (defvar gnus-thread-indent-array)
-  (defvar gnus-newsgroup-name)
-  (defvar gnus-newsgroup-headers)
-  (defvar gnus-group-list-mode)
-  (defvar gnus-group-mark-positions)
-  (defvar gnus-newsgroup-data)
-  (defvar gnus-newsgroup-unreads)
-  (defvar nnoo-state-alist)
-  (defvar gnus-current-select-method)
-  (defvar mail-sources)
-  (defvar nnmail-scan-directory-mail-source-once)
-  (defvar nnmail-split-history)
-  (defvar nnmail-spool-file))
+(defvar gnus-current-headers)
+(defvar gnus-thread-indent-array)
+(defvar gnus-newsgroup-name)
+(defvar gnus-newsgroup-headers)
+(defvar gnus-group-list-mode)
+(defvar gnus-group-mark-positions)
+(defvar gnus-newsgroup-data)
+(defvar gnus-newsgroup-unreads)
+(defvar nnoo-state-alist)
+(defvar gnus-current-select-method)
+(defvar mail-sources)
+(defvar nnmail-scan-directory-mail-source-once)
+(defvar nnmail-split-history)
+(defvar nnmail-spool-file)
 
 (defun gnus-close-all-servers ()
   "Close all servers."
@@ -1514,8 +1513,8 @@ newsgroup."
       (setq killed (cdr killed)))))
 
 ;; We want to inline a function from gnus-cache, so we cheat here:
+(defvar gnus-cache-active-hashtb)
 (eval-when-compile
-  (defvar gnus-cache-active-hashtb)
   (defun gnus-cache-possibly-alter-active (group active)
     "Alter the ACTIVE info for GROUP to reflect the articles in the cache."
     (when gnus-cache-active-hashtb
@@ -1672,7 +1671,7 @@ If SCAN, request a scan of that group as well."
 (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
@@ -1681,11 +1680,11 @@ If SCAN, request a scan of that group as well."
 		 ((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
@@ -1722,7 +1721,6 @@ If SCAN, request a scan of that group as well."
 		'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)
@@ -1736,9 +1734,17 @@ If SCAN, request a scan of that group as well."
 		   (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.
@@ -1758,11 +1764,7 @@ If SCAN, request a scan of that group as well."
 	       ;; 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))
@@ -1775,10 +1777,6 @@ If SCAN, request a scan of that group as well."
        ((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
@@ -2106,7 +2104,8 @@ If SCAN, request a scan of that group as well."
 			    (if (equal method gnus-select-method)
 				(gnus-make-hashtable
 				 (count-lines (point-min) (point-max)))
-			      (gnus-make-hashtable 4096)))))))
+			      (gnus-make-hashtable 4096))))))
+	group max min)
     ;; Delete unnecessary lines.
     (goto-char (point-min))
     (cond
@@ -2141,8 +2140,12 @@ If SCAN, request a scan of that group as well."
 		      (insert prefix)
 		      (zerop (forward-line 1)))))))
     ;; Store the active file in a hash table.
-    (goto-char (point-min))
-    (let (group max min)
+    ;; Use a unibyte buffer in order to make `read' read non-ASCII
+    ;; group names (which have been encoded) as unibyte strings.
+    (mm-with-unibyte-buffer
+      (insert-buffer-substring cur)
+      (setq cur (current-buffer))
+      (goto-char (point-min))
       (while (not (eobp))
 	(condition-case ()
 	    (progn
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index bc5ed9f0fb5..b082a8b152e 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -28,8 +28,10 @@
 ;;; Code:
 
 (eval-when-compile
-  (require 'cl)
-  (defvar tool-bar-mode))
+  (require 'cl))
+
+(defvar tool-bar-mode)
+(defvar gnus-tmp-header)
 
 (require 'gnus)
 (require 'gnus-group)
@@ -2193,6 +2195,7 @@ increase the score of each group you read."
   "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)
 
@@ -4954,7 +4957,6 @@ Unscored articles will be counted as having a score of zero."
 (defvar gnus-tmp-root-expunged nil)
 (defvar gnus-tmp-dummy-line nil)
 
-(eval-when-compile (defvar gnus-tmp-header))
 (defun gnus-extra-header (type &optional header)
   "Return the extra header of TYPE."
   (or (cdr (assq type (mail-header-extra (or header gnus-tmp-header))))
@@ -5592,8 +5594,7 @@ If SELECT-ARTICLES, only select those articles from GROUP."
     (gnus-get-predicate display)))
 
 ;; Uses the dynamically bound `number' variable.
-(eval-when-compile
-  (defvar number))
+(defvar number)
 (defun gnus-article-marked-p (type &optional article)
   (let ((article (or article number)))
     (cond
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index cf174d90ac8..de01fb2db11 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -36,16 +36,16 @@
 ;;; Code:
 
 (eval-when-compile
-  (require 'cl)
-  ;; Fixme: this should be a gnus variable, not nnmail-.
-  (defvar nnmail-pathname-coding-system)
-  (defvar nnmail-active-file-coding-system)
-
-  ;; Inappropriate references to other parts of Gnus.
-  (defvar gnus-emphasize-whitespace-regexp)
-  (defvar gnus-original-article-buffer)
-  (defvar gnus-user-agent)
-  )
+  (require 'cl))
+;; Fixme: this should be a gnus variable, not nnmail-.
+(defvar nnmail-pathname-coding-system)
+(defvar nnmail-active-file-coding-system)
+
+;; Inappropriate references to other parts of Gnus.
+(defvar gnus-emphasize-whitespace-regexp)
+(defvar gnus-original-article-buffer)
+(defvar gnus-user-agent)
+
 (require 'time-date)
 (require 'netrc)
 
@@ -982,9 +982,10 @@ with potentially long computations."
      ;; version fails halfway, however it provides the rmail-select-summary
      ;; macro which uses the following functions:
      (autoload 'rmail-summary-displayed "rmail")
-     (autoload 'rmail-maybe-display-summary "rmail")))
-  (defvar rmail-default-rmail-file)
-  (defvar mm-text-coding-system))
+     (autoload 'rmail-maybe-display-summary "rmail"))))
+
+(defvar rmail-default-rmail-file)
+(defvar mm-text-coding-system)
 
 (defun gnus-output-to-rmail (filename &optional ask)
   "Append the current article to an Rmail file named FILENAME."
@@ -1551,8 +1552,7 @@ Return nil otherwise."
 				 display))
 	      display)))))
 
-(eval-when-compile
-  (defvar tool-bar-mode))
+(defvar tool-bar-mode)
 
 (defun gnus-tool-bar-update (&rest ignore)
   "Update the tool bar."
@@ -1621,10 +1621,9 @@ predicate on the elements."
 	  (push (pop list1) res)))
       (nconc (nreverse res) list1 list2))))
 
-(eval-when-compile
-  (defvar xemacs-codename)
-  (defvar sxemacs-codename)
-  (defvar emacs-program-version))
+(defvar xemacs-codename)
+(defvar sxemacs-codename)
+(defvar emacs-program-version)
 
 (defun gnus-emacs-version ()
   "Stringified Emacs version."
diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el
index 20937562096..3a045c2c234 100644
--- a/lisp/gnus/gnus-uu.el
+++ b/lisp/gnus/gnus-uu.el
@@ -35,6 +35,7 @@
 (require 'message)
 (require 'gnus-msg)
 (require 'mm-decode)
+(require 'yenc)
 
 (defgroup gnus-extract nil
   "Extracting encoded files."
@@ -75,7 +76,7 @@
     ("\\.\\(tar\\|arj\\|zip\\|zoo\\|arc\\|gz\\|Z\\|lzh\\|ar\\|lha\\)$"
      "gnus-uu-archive"))
   "*Default actions to be taken when the user asks to view a file.
-To change the behaviour, you can either edit this variable or set
+To change the behavior, you can either edit this variable or set
 `gnus-uu-user-view-rules' to something useful.
 
 For example:
@@ -95,7 +96,7 @@ at that point in the command string.  If there's no \"%s\" in the
 command string, the file name will be appended to the command string
 before executing.
 
-There are several user variables to tailor the behaviour of gnus-uu to
+There are several user variables to tailor the behavior of gnus-uu to
 your needs.  First we have `gnus-uu-user-view-rules', which is the
 variable gnus-uu first consults when trying to decide how to view a
 file.  If this variable contains no matches, gnus-uu examines the
@@ -346,6 +347,7 @@ didn't work, and overwrite existing files.  Otherwise, ask each time."
 (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 @@ didn't work, and overwrite existing files.  Otherwise, ask each time."
 	(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 @@ When called interactively, prompt for REGEXP."
 	(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)
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index b09511ea9c4..bd96e52d65f 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -43,6 +43,8 @@
 (defvar gnus-spam-autodetect-methods)
 (defvar gnus-spam-newsgroup-contents)
 (defvar gnus-spam-process-destinations)
+(defvar gnus-spam-resend-to)
+(defvar gnus-ham-resend-to)
 (defvar gnus-spam-process-newsgroups)
 
 
@@ -3519,15 +3521,16 @@ that that variable is buffer-local to the summary buffers."
 				   (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)
@@ -4252,14 +4255,16 @@ Allow completion over sensible values."
 
 ;;; 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)
diff --git a/lisp/gnus/hashcash.el b/lisp/gnus/hashcash.el
deleted file mode 100644
index 737178b8218..00000000000
--- a/lisp/gnus/hashcash.el
+++ /dev/null
@@ -1,370 +0,0 @@
-;;; hashcash.el --- Add hashcash payments to email
-
-;; Copyright (C) 2003, 2004, 2005, 2007 Free Software Foundation
-
-;; Written by: Paul Foley <mycroft@actrix.gen.nz> (1997-2002)
-;; Maintainer: Paul Foley <mycroft@actrix.gen.nz>
-;; Keywords: mail, hashcash
-
-;; 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, 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; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; The hashcash binary is at http://www.hashcash.org/.
-;;
-;; Call mail-add-payment to add a hashcash payment to a mail message
-;; in the current buffer.
-;;
-;; Call mail-add-payment-async after writing the addresses but before
-;; writing the mail to start calculating the hashcash payment
-;; asynchronously.
-;;
-;; The easiest way to do this automatically for all outgoing mail
-;; is to set `message-generate-hashcash' to t.  If you want more
-;; control, try the following hooks.
-;;
-;; To automatically add payments to all outgoing mail when sending:
-;;    (add-hook 'message-send-hook 'mail-add-payment)
-;;
-;; To start calculations automatically when addresses are prefilled:
-;;    (add-hook 'message-setup-hook 'mail-add-payment-async)
-;;
-;; To check whether calculations are done before sending:
-;;    (add-hook 'message-send-hook 'hashcash-wait-or-cancel)
-
-;;; Code:
-
-(defgroup hashcash nil
-  "Hashcash configuration."
-  :group 'mail)
-
-(defcustom hashcash-default-payment 20
-  "*The default number of bits to pay to unknown users.
-If this is zero, no payment header will be generated.
-See `hashcash-payment-alist'."
-  :type 'integer
-  :group 'hashcash)
-
-(defcustom hashcash-payment-alist '()
-  "*An association list mapping email addresses to payment amounts.
-Elements may consist of (ADDR AMOUNT) or (ADDR STRING AMOUNT), where
-ADDR is the email address of the intended recipient and AMOUNT is
-the value of hashcash payment to be made to that user.  STRING, if
-present, is the string to be hashed; if not present ADDR will be used."
-  :type '(repeat (choice (list :tag "Normal"
-			       (string :name "Address")
-			       (integer :name "Amount"))
-			 (list :tag "Replace hash input"
-			       (string :name "Address")
-			       (string :name "Hash input")
-			       (integer :name "Amount"))))
-  :group 'hashcash)
-
-(defcustom hashcash-default-accept-payment 20
-  "*The default minimum number of bits to accept on incoming payments."
-  :type 'integer
-  :group 'hashcash)
-
-(defcustom hashcash-accept-resources `((,user-mail-address nil))
-  "*An association list mapping hashcash resources to payment amounts.
-Resources named here are to be accepted in incoming payments.  If the
-corresponding AMOUNT is NIL, the value of `hashcash-default-accept-payment'
-is used instead."
-  :group 'hashcash)
-
-(defcustom hashcash-path (executable-find "hashcash")
-  "*The path to the hashcash binary."
-  :group 'hashcash)
-
-(defcustom hashcash-extra-generate-parameters nil
-  "*A list of parameter strings passed to `hashcash-path' when minting.
-For example, you may want to set this to '(\"-Z2\") to reduce header length."
-  :type '(repeat string)
-  :group 'hashcash)
-
-(defcustom hashcash-double-spend-database "hashcash.db"
-  "*The path to the double-spending database."
-  :group 'hashcash)
-
-(defcustom hashcash-in-news nil
-  "*Specifies whether or not hashcash payments should be made to newsgroups."
-  :type 'boolean
-  :group 'hashcash)
-
-(defvar hashcash-process-alist nil
-  "Alist of asynchronous hashcash processes and buffers.")
-
-(require 'mail-utils)
-
-(eval-and-compile
- (if (fboundp 'point-at-bol)
-     (defalias 'hashcash-point-at-bol 'point-at-bol)
-   (defalias 'hashcash-point-at-bol 'line-beginning-position))
-
- (if (fboundp 'point-at-eol)
-     (defalias 'hashcash-point-at-eol 'point-at-eol)
-   (defalias 'hashcash-point-at-eol 'line-end-position)))
-
-(defun hashcash-strip-quoted-names (addr)
-  (setq addr (mail-strip-quoted-names addr))
-  (if (and addr (string-match "\\`\\([^+@]+\\)\\+[^@]*\\(@.+\\)" addr))
-      (concat (match-string 1 addr) (match-string 2 addr))
-    addr))
-
-(defun hashcash-token-substring ()
-  (save-excursion
-    (let ((token ""))
-      (loop
-	(setq token
-	  (concat token (buffer-substring (point) (hashcash-point-at-eol))))
-	(goto-char (hashcash-point-at-eol))
-	(forward-char 1)
-	(unless (looking-at "[ \t]") (return token))
-	(while (looking-at "[ \t]") (forward-char 1))))))
-
-(defun hashcash-payment-required (addr)
-  "Return the hashcash payment value required for the given address."
-  (let ((val (assoc addr hashcash-payment-alist)))
-    (or (nth 2 val) (nth 1 val) hashcash-default-payment)))
-
-(defun hashcash-payment-to (addr)
-  "Return the string with which hashcash payments should collide."
-  (let ((val (assoc addr hashcash-payment-alist)))
-    (or (nth 1 val) (nth 0 val) addr)))
-
-(defun hashcash-generate-payment (str val)
-  "Generate a hashcash payment by finding a VAL-bit collison on STR."
-  (if (and (> val 0)
-	   hashcash-path)
-      (save-excursion
-	(set-buffer (get-buffer-create " *hashcash*"))
-	(erase-buffer)
-	(apply 'call-process hashcash-path nil t nil
-	       "-m" "-q" "-b" (number-to-string val) str
-	       hashcash-extra-generate-parameters)
-	(goto-char (point-min))
-	(hashcash-token-substring))
-    (error "No `hashcash' binary found")))
-
-(defun hashcash-generate-payment-async (str val callback)
-  "Generate a hashcash payment by finding a VAL-bit collison on STR.
-Return immediately.  Call CALLBACK with process and result when ready."
-  (if (and (> val 0)
-	   hashcash-path)
-      (let ((process (apply 'start-process "hashcash" nil
-			    hashcash-path "-m" "-q"
-			    "-b" (number-to-string val) str
-			    hashcash-extra-generate-parameters)))
-	(setq hashcash-process-alist (cons
-				      (cons process (current-buffer))
-				      hashcash-process-alist))
-	(set-process-filter process `(lambda (process output)
-				       (funcall ,callback process output))))
-    (funcall callback nil nil)))
-
-(defun hashcash-check-payment (token str val)
-  "Check the validity of a hashcash payment."
-  (if hashcash-path
-      (zerop (call-process hashcash-path nil nil nil "-c"
-			   "-d" "-f" hashcash-double-spend-database
-			   "-b" (number-to-string val)
-			   "-r" str
-			   token))
-    (progn
-      (message "No hashcash binary found")
-      (sleep-for 1)
-      nil)))
-
-(defun hashcash-version (token)
-  "Find the format version of a hashcash token."
-  ;; Version 1.2 looks like n:yymmdd:rrrrr:xxxxxxxxxxxxxxxx
-  ;;   This carries its own version number embedded in the token,
-  ;;   so no further format number changes should be necessary
-  ;;   in the X-Payment header.
-  ;;
-  ;; Version 1.1 looks like yymmdd:rrrrr:xxxxxxxxxxxxxxxx
-  ;;   You need to upgrade your hashcash binary.
-  ;;
-  ;; Version 1.0 looked like nnnnnrrrrrxxxxxxxxxxxxxxxx
-  ;;   This is no longer supported.
-  (cond ((equal (aref token 1) ?:) 1.2)
-	((equal (aref token 6) ?:) 1.1)
-	(t (error "Unknown hashcash format version"))))
-
-(defun hashcash-already-paid-p (recipient)
-  "Check for hashcash token to RECIPIENT in current buffer."
-  (save-excursion
-    (save-restriction
-      (message-narrow-to-headers-or-head)
-      (let ((token (message-fetch-field "x-hashcash"))
-	    (case-fold-search t))
-	(and (stringp token)
-	     (string-match (regexp-quote recipient) token))))))
-
-;;;###autoload
-(defun hashcash-insert-payment (arg)
-  "Insert X-Payment and X-Hashcash headers with a payment for ARG"
-  (interactive "sPay to: ")
-  (unless (hashcash-already-paid-p arg)
-    (let ((pay (hashcash-generate-payment (hashcash-payment-to arg)
-					  (hashcash-payment-required arg))))
-      (when pay
-	(insert-before-markers "X-Hashcash: " pay "\n")))))
-
-;;;###autoload
-(defun hashcash-insert-payment-async (arg)
-  "Insert X-Payment and X-Hashcash headers with a payment for ARG
-Only start calculation.  Results are inserted when ready."
-  (interactive "sPay to: ")
-  (unless (hashcash-already-paid-p arg)
-    (hashcash-generate-payment-async
-     (hashcash-payment-to arg)
-     (hashcash-payment-required arg)
-     `(lambda (process payment)
-	(hashcash-insert-payment-async-2 ,(current-buffer) process payment)))))
-
-(defun hashcash-insert-payment-async-2 (buffer process pay)
-  (when (buffer-live-p buffer)
-    (with-current-buffer buffer
-      (save-excursion
-	(save-restriction
-	  (setq hashcash-process-alist (delq
-					(assq process hashcash-process-alist)
-					hashcash-process-alist))
-	  (message-goto-eoh)
-	  (when pay
-	    (insert-before-markers "X-Hashcash: " pay)))))))
-
-(defun hashcash-cancel-async (&optional buffer)
-  "Delete any hashcash processes associated with BUFFER.
-BUFFER defaults to the current buffer."
-  (interactive)
-  (unless buffer (setq buffer (current-buffer)))
-  (let (entry)
-    (while (setq entry (rassq buffer hashcash-process-alist))
-      (delete-process (car entry))
-      (setq hashcash-process-alist
-	    (delq entry hashcash-process-alist)))))
-
-(defun hashcash-wait-async (&optional buffer)
-  "Wait for asynchronous hashcash processes in BUFFER to finish.
-BUFFER defaults to the current buffer."
-  (interactive)
-  (unless buffer (setq buffer (current-buffer)))
-  (let (entry)
-    (while (setq entry (rassq buffer hashcash-process-alist))
-      (accept-process-output (car entry)))))
-
-(defun hashcash-processes-running-p (buffer)
-  "Return non-nil if hashcash processes in BUFFER are still running."
-  (rassq buffer hashcash-process-alist))
-
-(defun hashcash-wait-or-cancel ()
-  "Ask user whether to wait for hashcash processes to finish."
-  (interactive)
-  (when (hashcash-processes-running-p (current-buffer))
-    (if (y-or-n-p 
-	  "Hashcash process(es) still running; wait for them to finish? ")
-	(hashcash-wait-async)
-      (hashcash-cancel-async))))
-
-;;;###autoload
-(defun hashcash-verify-payment (token &optional resource amount)
-  "Verify a hashcash payment"
-  (let* ((split (split-string token ":"))
-	 (key (if (< (hashcash-version token) 1.2)
-		  (nth 1 split)
-		  (case (string-to-number (nth 0 split))
-		    (0 (nth 2 split))
-		    (1 (nth 3 split))))))
-    (cond ((null resource)
-	   (let ((elt (assoc key hashcash-accept-resources)))
-	     (and elt (hashcash-check-payment token (car elt)
-			(or (cadr elt) hashcash-default-accept-payment)))))
-	  ((equal token key)
-	   (hashcash-check-payment token resource
-				(or amount hashcash-default-accept-payment)))
-	  (t nil))))
-
-;;;###autoload
-(defun mail-add-payment (&optional arg async)
-  "Add X-Payment: and X-Hashcash: headers with a hashcash payment
-for each recipient address.  Prefix arg sets default payment temporarily.
-Set ASYNC to t to start asynchronous calculation.  (See
-`mail-add-payment-async')."
-  (interactive "P")
-  (let ((hashcash-default-payment (if arg (prefix-numeric-value arg)
-				    hashcash-default-payment))
-	(addrlist nil))
-    (save-excursion
-      (save-restriction
-	(message-narrow-to-headers)
-	(let ((to (hashcash-strip-quoted-names (mail-fetch-field "To" nil t)))
-	      (cc (hashcash-strip-quoted-names (mail-fetch-field "Cc" nil t)))
-	      (ng (hashcash-strip-quoted-names (mail-fetch-field "Newsgroups"
-								 nil t))))
-	  (when to
-	    (setq addrlist (split-string to ",[ \t\n]*")))
-	  (when cc
-	    (setq addrlist (nconc addrlist (split-string cc ",[ \t\n]*"))))
-	  (when (and hashcash-in-news ng)
-	    (setq addrlist (nconc addrlist (split-string ng ",[ \t\n]*")))))
-	(when addrlist
-	  (mapc (if async
-		    #'hashcash-insert-payment-async
-		  #'hashcash-insert-payment)
-		addrlist)))))
-  t)
-
-;;;###autoload
-(defun mail-add-payment-async (&optional arg)
-  "Add X-Payment: and X-Hashcash: headers with a hashcash payment
-for each recipient address.  Prefix arg sets default payment temporarily.
-Calculation is asynchronous."
-  (interactive "P")
-  (mail-add-payment arg t))
-
-;;;###autoload
-(defun mail-check-payment (&optional arg)
-  "Look for a valid X-Payment: or X-Hashcash: header.
-Prefix arg sets default accept amount temporarily."
-  (interactive "P")
-  (let ((hashcash-default-accept-payment (if arg (prefix-numeric-value arg)
-					   hashcash-default-accept-payment))
-	(version (hashcash-version (hashcash-generate-payment "x" 1))))
-    (save-excursion
-      (goto-char (point-min))
-      (search-forward "\n\n")
-      (beginning-of-line)
-      (let ((end (point))
-	    (ok nil))
-	(goto-char (point-min))
-	(while (and (not ok) (search-forward "X-Payment: hashcash " end t))
-	  (let ((value (split-string (hashcash-token-substring) " ")))
-	    (when (equal (car value) (number-to-string version))
-	      (setq ok (hashcash-verify-payment (cadr value))))))
-	(goto-char (point-min))
-	(while (and (not ok) (search-forward "X-Hashcash: " end t))
-	  (setq ok (hashcash-verify-payment (hashcash-token-substring))))
-	(when ok
-	  (message "Payment valid"))
-	ok))))
-
-(provide 'hashcash)
-
-;;; arch-tag: 0e7fe983-a124-4392-9788-0dbcbd2c4d62
diff --git a/lisp/gnus/hex-util.el b/lisp/gnus/hex-util.el
deleted file mode 100644
index 981516e4b2a..00000000000
--- a/lisp/gnus/hex-util.el
+++ /dev/null
@@ -1,75 +0,0 @@
-;;; hex-util.el --- Functions to encode/decode hexadecimal string.
-
-;; Copyright (C) 1999, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007 Free Software Foundation, Inc.
-
-;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
-;; Keywords: data
-
-;; This file is part of FLIM (Faithful Library about Internet Message).
-
-;; This program 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, or
-;; (at your option) any later version.
-
-;; This program 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 this program; see the file COPYING.  If not, write to
-;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile
-  (defmacro hex-char-to-num (chr)
-    `(let ((chr ,chr))
-       (cond
-        ((and (<= ?a chr)(<= chr ?f)) (+ (- chr ?a) 10))
-        ((and (<= ?A chr)(<= chr ?F)) (+ (- chr ?A) 10))
-        ((and (<= ?0 chr)(<= chr ?9)) (- chr ?0))
-        (t (error "Invalid hexadecimal digit `%c'" chr)))))
-  (defmacro num-to-hex-char (num)
-    `(aref "0123456789abcdef" ,num)))
-
-(defun decode-hex-string (string)
-  "Decode hexadecimal STRING to octet string."
-  (let* ((len (length string))
-	 (dst (make-string (/ len 2) 0))
-	 (idx 0)(pos 0))
-    (while (< pos len)
-      ;; logior and lsh are not byte-coded.
-      ;; (aset dst idx (logior (lsh (hex-char-to-num (aref string pos)) 4)
-      ;; 			    (hex-char-to-num (aref string (1+ pos)))))
-      (aset dst idx (+ (* (hex-char-to-num (aref string pos)) 16)
-		       (hex-char-to-num (aref string (1+ pos)))))
-      (setq idx (1+ idx)
-	    pos (+ 2 pos)))
-    dst))
-
-(defun encode-hex-string (string)
-  "Encode octet STRING to hexadecimal string."
-  (let* ((len (length string))
-	 (dst (make-string (* len 2) 0))
-	 (idx 0)(pos 0))
-    (while (< pos len)
-      ;; logand and lsh are not byte-coded.
-      ;; (aset dst idx (num-to-hex-char (logand (lsh (aref string pos) -4) 15)))
-      (aset dst idx (num-to-hex-char (/ (aref string pos) 16)))
-      (setq idx (1+ idx))
-      ;; (aset dst idx (num-to-hex-char (logand (aref string pos) 15)))
-      (aset dst idx (num-to-hex-char (% (aref string pos) 16)))
-      (setq idx (1+ idx)
-	    pos (1+ pos)))
-    dst))
-
-(provide 'hex-util)
-
-;; arch-tag: fe8aaa79-6c86-400e-813f-5a8cc4cb3859
-;;; hex-util.el ends here
diff --git a/lisp/gnus/hmac-def.el b/lisp/gnus/hmac-def.el
deleted file mode 100644
index 58491ec4f4a..00000000000
--- a/lisp/gnus/hmac-def.el
+++ /dev/null
@@ -1,86 +0,0 @@
-;;; hmac-def.el --- A macro for defining HMAC functions.
-
-;; Copyright (C) 1999, 2001  Free Software Foundation, Inc.
-
-;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
-;; Keywords: HMAC, RFC 2104
-
-;; This file is part of FLIM (Faithful Library about Internet Message).
-
-;; This program 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, or
-;; (at your option) any later version.
-
-;; This program 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 this program; see the file COPYING.  If not, write to
-;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; This program is implemented from RFC 2104,
-;; "HMAC: Keyed-Hashing for Message Authentication".
-
-;;; Code:
-
-(defmacro define-hmac-function (name H B L &optional bit)
-  "Define a function NAME(TEXT KEY) which computes HMAC with function H.
-
-HMAC function is H(KEY XOR opad, H(KEY XOR ipad, TEXT)):
-
-H is a cryptographic hash function, such as SHA1 and MD5, which takes
-a string and return a digest of it (in binary form).
-B is a byte-length of a block size of H. (B=64 for both SHA1 and MD5.)
-L is a byte-length of hash outputs. (L=16 for MD5, L=20 for SHA1.)
-If BIT is non-nil, truncate output to specified bits."
-  `(defun ,name (text key)
-     ,(concat "Compute "
-	      (upcase (symbol-name name))
-	      " over TEXT with KEY.")
-     (let ((key-xor-ipad (make-string ,B ?\x36))
-	   (key-xor-opad (make-string ,B ?\x5C))
-	   (len (length key))
-	   (pos 0))
-       (unwind-protect
-	   (progn
-	     ;; if `key' is longer than the block size, apply hash function
-	     ;; to `key' and use the result as a real `key'.
-	     (if (> len ,B)
-		 (setq key (,H key)
-		       len ,L))
-	     (while (< pos len)
-	       (aset key-xor-ipad pos (logxor (aref key pos) ?\x36))
-	       (aset key-xor-opad pos (logxor (aref key pos) ?\x5C))
-	       (setq pos (1+ pos)))
-	     (setq key-xor-ipad (unwind-protect
-				    (concat key-xor-ipad text)
-				  (fillarray key-xor-ipad 0))
-		   key-xor-ipad (unwind-protect
-				    (,H key-xor-ipad)
-				  (fillarray key-xor-ipad 0))
-		   key-xor-opad (unwind-protect
-				    (concat key-xor-opad key-xor-ipad)
-				  (fillarray key-xor-opad 0))
-		   key-xor-opad (unwind-protect
-				    (,H key-xor-opad)
-				  (fillarray key-xor-opad 0)))
-	     ;; now `key-xor-opad' contains
-	     ;; H(KEY XOR opad, H(KEY XOR ipad, TEXT)).
-	     ,(if (and bit (< (/ bit 8) L))
-		  `(substring key-xor-opad 0 ,(/ bit 8))
-		;; return a copy of `key-xor-opad'.
-		`(concat key-xor-opad)))
-	 ;; cleanup.
-	 (fillarray key-xor-ipad 0)
-	 (fillarray key-xor-opad 0)))))
-
-(provide 'hmac-def)
-
-;;; arch-tag: 645adcef-b835-4900-a10a-11f636c982b9
-;;; hmac-def.el ends here
diff --git a/lisp/gnus/hmac-md5.el b/lisp/gnus/hmac-md5.el
deleted file mode 100644
index 21fc91992ad..00000000000
--- a/lisp/gnus/hmac-md5.el
+++ /dev/null
@@ -1,85 +0,0 @@
-;;; hmac-md5.el --- Compute HMAC-MD5.
-
-;; Copyright (C) 1999, 2001  Free Software Foundation, Inc.
-
-;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
-;; Keywords: HMAC, RFC 2104, HMAC-MD5, MD5, KEYED-MD5, CRAM-MD5
-
-;; This file is part of FLIM (Faithful Library about Internet Message).
-
-;; This program 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, or
-;; (at your option) any later version.
-
-;; This program 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 this program; see the file COPYING.  If not, write to
-;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; Test cases from RFC 2202, "Test Cases for HMAC-MD5 and HMAC-SHA-1".
-;;
-;; (encode-hex-string (hmac-md5 "Hi There" (make-string 16 ?\x0b)))
-;;  => "9294727a3638bb1c13f48ef8158bfc9d"
-;;
-;; (encode-hex-string (hmac-md5 "what do ya want for nothing?" "Jefe"))
-;;  => "750c783e6ab0b503eaa86e310a5db738"
-;;
-;; (encode-hex-string (hmac-md5 (make-string 50 ?\xdd) (make-string 16 ?\xaa)))
-;;  => "56be34521d144c88dbb8c733f0e8b3f6"
-;;
-;; (encode-hex-string
-;;  (hmac-md5
-;;   (make-string 50 ?\xcd)
-;;   (decode-hex-string "0102030405060708090a0b0c0d0e0f10111213141516171819")))
-;;  => "697eaf0aca3a3aea3a75164746ffaa79"
-;;
-;; (encode-hex-string
-;;  (hmac-md5 "Test With Truncation" (make-string 16 ?\x0c)))
-;;  => "56461ef2342edc00f9bab995690efd4c"
-;;
-;; (encode-hex-string
-;;  (hmac-md5-96 "Test With Truncation" (make-string 16 ?\x0c)))
-;;  => "56461ef2342edc00f9bab995"
-;;
-;; (encode-hex-string
-;;  (hmac-md5
-;;   "Test Using Larger Than Block-Size Key - Hash Key First"
-;;   (make-string 80 ?\xaa)))
-;;  => "6b1ab7fe4bd7bf8f0b62e6ce61b9d0cd"
-;;
-;; (encode-hex-string
-;;  (hmac-md5
-;;   "Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data"
-;;   (make-string 80 ?\xaa)))
-;;  => "6f630fad67cda0ee1fb1f562db3aa53e"
-
-;;; Code:
-
-(eval-when-compile (require 'hmac-def))
-(require 'hex-util)			; (decode-hex-string STRING)
-(require 'md5)				; expects (md5 STRING)
-
-(defun md5-binary (string)
-  "Return the MD5 of STRING in binary form."
-  (if (condition-case nil
-	  ;; `md5' of v21 takes 4th arg CODING (and 5th arg NOERROR).
-	  (md5 "" nil nil 'binary)	; => "d41d8cd98f00b204e9800998ecf8427e"
-	(wrong-number-of-arguments nil))
-      (decode-hex-string (md5 string nil nil 'binary))
-    (decode-hex-string (md5 string))))
-
-(define-hmac-function hmac-md5 md5-binary 64 16) ; => (hmac-md5 TEXT KEY)
-(define-hmac-function hmac-md5-96 md5-binary 64 16 96)
-
-(provide 'hmac-md5)
-
-;;; arch-tag: 0ab3f4f6-3d4b-4167-a9fa-635b7fed7f27
-;;; hmac-md5.el ends here
diff --git a/lisp/gnus/imap.el b/lisp/gnus/imap.el
deleted file mode 100644
index 7643ef4a53d..00000000000
--- a/lisp/gnus/imap.el
+++ /dev/null
@@ -1,2961 +0,0 @@
-;;; imap.el --- imap library
-
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007 Free Software Foundation, Inc.
-
-;; Author: Simon Josefsson <jas@pdc.kth.se>
-;; Keywords: mail
-
-;; 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, 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; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; imap.el is a elisp library providing an interface for talking to
-;; IMAP servers.
-;;
-;; imap.el is roughly divided in two parts, one that parses IMAP
-;; responses from the server and storing data into buffer-local
-;; variables, and one for utility functions which send commands to
-;; server, waits for an answer, and return information.  The latter
-;; part is layered on top of the previous.
-;;
-;; The imap.el API consist of the following functions, other functions
-;; in this file should not be called directly and the result of doing
-;; so are at best undefined.
-;;
-;; Global commands:
-;;
-;; imap-open,       imap-opened,    imap-authenticate, imap-close,
-;; imap-capability, imap-namespace, imap-error-text
-;;
-;; Mailbox commands:
-;;
-;; imap-mailbox-get,       imap-mailbox-map,         imap-current-mailbox,
-;; imap-current-mailbox-p, imap-search,              imap-mailbox-select,
-;; imap-mailbox-examine,   imap-mailbox-unselect,    imap-mailbox-expunge
-;; imap-mailbox-close,     imap-mailbox-create,      imap-mailbox-delete
-;; imap-mailbox-rename,    imap-mailbox-lsub,        imap-mailbox-list
-;; imap-mailbox-subscribe, imap-mailbox-unsubscribe, imap-mailbox-status
-;; imap-mailbox-acl-get,   imap-mailbox-acl-set,     imap-mailbox-acl-delete
-;;
-;; Message commands:
-;;
-;; imap-fetch-asynch,                 imap-fetch,
-;; imap-current-message,              imap-list-to-message-set,
-;; imap-message-get,                  imap-message-map
-;; imap-message-envelope-date,        imap-message-envelope-subject,
-;; imap-message-envelope-from,        imap-message-envelope-sender,
-;; imap-message-envelope-reply-to,    imap-message-envelope-to,
-;; imap-message-envelope-cc,          imap-message-envelope-bcc
-;; imap-message-envelope-in-reply-to, imap-message-envelope-message-id
-;; imap-message-body,                 imap-message-flag-permanent-p
-;; imap-message-flags-set,            imap-message-flags-del
-;; imap-message-flags-add,            imap-message-copyuid
-;; imap-message-copy,                 imap-message-appenduid
-;; imap-message-append,               imap-envelope-from
-;; imap-body-lines
-;;
-;; It is my hope that these commands should be pretty self
-;; explanatory for someone that know IMAP.  All functions have
-;; additional documentation on how to invoke them.
-;;
-;; imap.el support RFC1730/2060/RFC3501 (IMAP4/IMAP4rev1), implemented
-;; IMAP extensions are RFC2195 (CRAM-MD5), RFC2086 (ACL), RFC2342
-;; (NAMESPACE), RFC2359 (UIDPLUS), the IMAP-part of RFC2595 (STARTTLS,
-;; LOGINDISABLED) (with use of external library starttls.el and
-;; program starttls), and the GSSAPI / kerberos V4 sections of RFC1731
-;; (with use of external program `imtest'), RFC2971 (ID).  It also
-;; takes advantage of the UNSELECT extension in Cyrus IMAPD.
-;;
-;; Without the work of John McClary Prevost and Jim Radford this library
-;; would not have seen the light of day.  Many thanks.
-;;
-;; This is a transcript of short interactive session for demonstration
-;; purposes.
-;;
-;; (imap-open "my.mail.server")
-;; => " *imap* my.mail.server:0"
-;;
-;; The rest are invoked with current buffer as the buffer returned by
-;; `imap-open'.  It is possible to do all without this, but it would
-;; look ugly here since `buffer' is always the last argument for all
-;; imap.el API functions.
-;;
-;; (imap-authenticate "myusername" "mypassword")
-;; => auth
-;;
-;; (imap-mailbox-lsub "*")
-;; => ("INBOX.sentmail" "INBOX.private" "INBOX.draft" "INBOX.spam")
-;;
-;; (imap-mailbox-list "INBOX.n%")
-;; => ("INBOX.namedroppers" "INBOX.nnimap" "INBOX.ntbugtraq")
-;;
-;; (imap-mailbox-select "INBOX.nnimap")
-;; => "INBOX.nnimap"
-;;
-;; (imap-mailbox-get 'exists)
-;; => 166
-;;
-;; (imap-mailbox-get 'uidvalidity)
-;; => "908992622"
-;;
-;; (imap-search "FLAGGED SINCE 18-DEC-98")
-;; => (235 236)
-;;
-;; (imap-fetch 235 "RFC822.PEEK" 'RFC822)
-;; => "X-Sieve: cmu-sieve 1.3^M\nX-Username: <jas@pdc.kth.se>^M\r...."
-;;
-;; Todo:
-;;
-;; o Parse UIDs as strings? We need to overcome the 28 bit limit somehow.
-;; o Don't use `read' at all (important places already fixed)
-;; o Accept list of articles instead of message set string in most
-;;   imap-message-* functions.
-;; o Send strings as literal if they contain, e.g., ".
-;;
-;; Revision history:
-;;
-;;  - 19991218 added starttls/digest-md5 patch,
-;;             by Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-;;             NB! you need SLIM for starttls.el and digest-md5.el
-;;  - 19991023 commited to pgnus
-;;
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-(eval-and-compile
-  (autoload 'starttls-open-stream "starttls")
-  (autoload 'starttls-negotiate "starttls")
-  (autoload 'sasl-find-mechanism "sasl")
-  (autoload 'digest-md5-parse-digest-challenge "digest-md5")
-  (autoload 'digest-md5-digest-response "digest-md5")
-  (autoload 'digest-md5-digest-uri "digest-md5")
-  (autoload 'digest-md5-challenge "digest-md5")
-  (autoload 'rfc2104-hash "rfc2104")
-  (autoload 'utf7-encode "utf7")
-  (autoload 'utf7-decode "utf7")
-  (autoload 'format-spec "format-spec")
-  (autoload 'format-spec-make "format-spec")
-  (autoload 'open-tls-stream "tls"))
-
-;; User variables.
-
-(defgroup imap nil
-  "Low-level IMAP issues."
-  :version "21.1"
-  :group 'mail)
-
-(defcustom imap-kerberos4-program '("imtest -m kerberos_v4 -u %l -p %p %s"
-				    "imtest -kp %s %p")
-  "List of strings containing commands for Kerberos 4 authentication.
-%s is replaced with server hostname, %p with port to connect to, and
-%l with the value of `imap-default-user'.  The program should accept
-IMAP commands on stdin and return responses to stdout.  Each entry in
-the list is tried until a successful connection is made."
-  :group 'imap
-  :type '(repeat string))
-
-(defcustom imap-gssapi-program (list
-				(concat "gsasl %s %p "
-					"--mechanism GSSAPI "
-					"--authentication-id %l")
-				"imtest -m gssapi -u %l -p %p %s")
-  "List of strings containing commands for GSSAPI (krb5) authentication.
-%s is replaced with server hostname, %p with port to connect to, and
-%l with the value of `imap-default-user'.  The program should accept
-IMAP commands on stdin and return responses to stdout.  Each entry in
-the list is tried until a successful connection is made."
-  :group 'imap
-  :type '(repeat string))
-
-(defcustom imap-ssl-program '("openssl s_client -quiet -ssl3 -connect %s:%p"
-			      "openssl s_client -quiet -ssl2 -connect %s:%p"
-			      "s_client -quiet -ssl3 -connect %s:%p"
-			      "s_client -quiet -ssl2 -connect %s:%p")
-  "A string, or list of strings, containing commands for SSL connections.
-Within a string, %s is replaced with the server address and %p with
-port number on server.  The program should accept IMAP commands on
-stdin and return responses to stdout.  Each entry in the list is tried
-until a successful connection is made."
-  :group 'imap
-  :type '(choice string
-		 (repeat string)))
-
-(defcustom imap-shell-program '("ssh %s imapd"
-				"rsh %s imapd"
-				"ssh %g ssh %s imapd"
-				"rsh %g rsh %s imapd")
-  "A list of strings, containing commands for IMAP connection.
-Within a string, %s is replaced with the server address, %p with port
-number on server, %g with `imap-shell-host', and %l with
-`imap-default-user'.  The program should read IMAP commands from stdin
-and write IMAP response to stdout. Each entry in the list is tried
-until a successful connection is made."
-  :group 'imap
-  :type '(repeat string))
-
-(defcustom imap-process-connection-type nil
-  "*Value for `process-connection-type' to use for Kerberos4, GSSAPI and SSL.
-The `process-connection-type' variable control type of device
-used to communicate with subprocesses.  Values are nil to use a
-pipe, or t or `pty' to use a pty.  The value has no effect if the
-system has no ptys or if all ptys are busy: then a pipe is used
-in any case.  The value takes effect when a IMAP server is
-opened, changing it after that has no effect."
-  :version "22.1"
-  :group 'imap
-  :type 'boolean)
-
-(defcustom imap-use-utf7 t
-  "If non-nil, do utf7 encoding/decoding of mailbox names.
-Since the UTF7 decoding currently only decodes into ISO-8859-1
-characters, you may disable this decoding if you need to access UTF7
-encoded mailboxes which doesn't translate into ISO-8859-1."
-  :group 'imap
-  :type 'boolean)
-
-(defcustom imap-log nil
-  "If non-nil, a imap session trace is placed in *imap-log* buffer.
-Note that username, passwords and other privacy sensitive
-information (such as e-mail) may be stored in the *imap-log*
-buffer.  It is not written to disk, however.  Do not enable this
-variable unless you are comfortable with that."
-  :group 'imap
-  :type 'boolean)
-
-(defcustom imap-debug nil
-  "If non-nil, random debug spews are placed in *imap-debug* buffer.
-Note that username, passwords and other privacy sensitive
-information (such as e-mail) may be stored in the *imap-debug*
-buffer.  It is not written to disk, however.  Do not enable this
-variable unless you are comfortable with that."
-  :group 'imap
-  :type 'boolean)
-
-(defcustom imap-shell-host "gateway"
-  "Hostname of rlogin proxy."
-  :group 'imap
-  :type 'string)
-
-(defcustom imap-default-user (user-login-name)
-  "Default username to use."
-  :group 'imap
-  :type 'string)
-
-(defcustom imap-read-timeout (if (string-match
-				  "windows-nt\\|os/2\\|emx\\|cygwin"
-				  (symbol-name system-type))
-				 1.0
-			       0.1)
-  "*How long to wait between checking for the end of output.
-Shorter values mean quicker response, but is more CPU intensive."
-  :type 'number
-  :group 'imap)
-
-(defcustom imap-store-password nil
-  "If non-nil, store session password without promting."
-  :group 'imap
-  :type 'boolean)
-
-;; Various variables.
-
-(defvar imap-fetch-data-hook nil
-  "Hooks called after receiving each FETCH response.")
-
-(defvar imap-streams '(gssapi kerberos4 starttls tls ssl network shell)
-  "Priority of streams to consider when opening connection to server.")
-
-(defvar imap-stream-alist
-  '((gssapi    imap-gssapi-stream-p    imap-gssapi-open)
-    (kerberos4 imap-kerberos4-stream-p imap-kerberos4-open)
-    (tls       imap-tls-p              imap-tls-open)
-    (ssl       imap-ssl-p              imap-ssl-open)
-    (network   imap-network-p          imap-network-open)
-    (shell     imap-shell-p            imap-shell-open)
-    (starttls  imap-starttls-p         imap-starttls-open))
-  "Definition of network streams.
-
-\(NAME CHECK OPEN)
-
-NAME names the stream, CHECK is a function returning non-nil if the
-server support the stream and OPEN is a function for opening the
-stream.")
-
-(defvar imap-authenticators '(gssapi
-			      kerberos4
-			      digest-md5
-			      cram-md5
-			      ;;sasl
-			      login
-			      anonymous)
-  "Priority of authenticators to consider when authenticating to server.")
-
-(defvar imap-authenticator-alist
-  '((gssapi     imap-gssapi-auth-p    imap-gssapi-auth)
-    (kerberos4  imap-kerberos4-auth-p imap-kerberos4-auth)
-    (sasl	imap-sasl-auth-p      imap-sasl-auth)
-    (cram-md5   imap-cram-md5-p       imap-cram-md5-auth)
-    (login      imap-login-p          imap-login-auth)
-    (anonymous  imap-anonymous-p      imap-anonymous-auth)
-    (digest-md5 imap-digest-md5-p     imap-digest-md5-auth))
-  "Definition of authenticators.
-
-\(NAME CHECK AUTHENTICATE)
-
-NAME names the authenticator.  CHECK is a function returning non-nil if
-the server support the authenticator and AUTHENTICATE is a function
-for doing the actual authentication.")
-
-(defvar imap-error nil
-  "Error codes from the last command.")
-
-(defvar imap-logout-timeout nil
-  "Close server immediately if it can't logout in this number of seconds.
-If it is nil, never close server until logout completes.  Normally,
-the value of this variable will be bound to a certain value to which
-an application program that uses this module specifies on a per-server
-basis.")
-
-;; Internal constants.  Change these and die.
-
-(defconst imap-default-port 143)
-(defconst imap-default-ssl-port 993)
-(defconst imap-default-tls-port 993)
-(defconst imap-default-stream 'network)
-(defconst imap-coding-system-for-read 'binary)
-(defconst imap-coding-system-for-write 'binary)
-(defconst imap-local-variables '(imap-server
-				 imap-port
-				 imap-client-eol
-				 imap-server-eol
-				 imap-auth
-				 imap-stream
-				 imap-username
-				 imap-password
-				 imap-current-mailbox
-				 imap-current-target-mailbox
-				 imap-message-data
-				 imap-capability
-				 imap-id
-				 imap-namespace
-				 imap-state
-				 imap-reached-tag
-				 imap-failed-tags
-				 imap-tag
-				 imap-process
-				 imap-calculate-literal-size-first
-				 imap-mailbox-data))
-(defconst imap-log-buffer "*imap-log*")
-(defconst imap-debug-buffer "*imap-debug*")
-
-;; Internal variables.
-
-(defvar imap-stream nil)
-(defvar imap-auth nil)
-(defvar imap-server nil)
-(defvar imap-port nil)
-(defvar imap-username nil)
-(defvar imap-password nil)
-(defvar imap-calculate-literal-size-first nil)
-(defvar imap-state 'closed
-  "IMAP state.
-Valid states are `closed', `initial', `nonauth', `auth', `selected'
-and `examine'.")
-
-(defvar imap-server-eol "\r\n"
-  "The EOL string sent from the server.")
-
-(defvar imap-client-eol "\r\n"
-  "The EOL string we send to the server.")
-
-(defvar imap-current-mailbox nil
-  "Current mailbox name.")
-
-(defvar imap-current-target-mailbox nil
-  "Current target mailbox for COPY and APPEND commands.")
-
-(defvar imap-mailbox-data nil
-  "Obarray with mailbox data.")
-
-(defvar imap-mailbox-prime 997
-  "Length of imap-mailbox-data.")
-
-(defvar imap-current-message nil
-  "Current message number.")
-
-(defvar imap-message-data nil
-  "Obarray with message data.")
-
-(defvar imap-message-prime 997
-  "Length of imap-message-data.")
-
-(defvar imap-capability nil
-  "Capability for server.")
-
-(defvar imap-id nil
-  "Identity of server.
-See RFC 2971.")
-
-(defvar imap-namespace nil
-  "Namespace for current server.")
-
-(defvar imap-reached-tag 0
-  "Lower limit on command tags that have been parsed.")
-
-(defvar imap-failed-tags nil
-  "Alist of tags that failed.
-Each element is a list with four elements; tag (a integer), response
-state (a symbol, `OK', `NO' or `BAD'), response code (a string), and
-human readable response text (a string).")
-
-(defvar imap-tag 0
-  "Command tag number.")
-
-(defvar imap-process nil
-  "Process.")
-
-(defvar imap-continuation nil
-  "Non-nil indicates that the server emitted a continuation request.
-The actual value is really the text on the continuation line.")
-
-(defvar imap-callbacks nil
-  "List of response tags and callbacks, on the form `(number . function)'.
-The function should take two arguments, the first the IMAP tag and the
-second the status (OK, NO, BAD etc) of the command.")
-
-
-;; Utility functions:
-
-(defun imap-remassoc (key alist)
-  "Delete by side effect any elements of LIST whose car is `equal' to KEY.
-The modified LIST is returned.  If the first member
-of LIST has a car that is `equal' to KEY, there is no way to remove it
-by side effect; therefore, write `(setq foo (remassoc key foo))' to be
-sure of changing the value of `foo'."
-  (when alist
-    (if (equal key (caar alist))
-	(cdr alist)
-      (setcdr alist (imap-remassoc key (cdr alist)))
-      alist)))
-
-(defsubst imap-disable-multibyte ()
-  "Enable multibyte in the current buffer."
-  (when (fboundp 'set-buffer-multibyte)
-    (set-buffer-multibyte nil)))
-
-(defsubst imap-utf7-encode (string)
-  (if imap-use-utf7
-      (and string
-	   (condition-case ()
-	       (utf7-encode string t)
-	     (error (message
-		     "imap: Could not UTF7 encode `%s', using it unencoded..."
-		     string)
-		    string)))
-    string))
-
-(defsubst imap-utf7-decode (string)
-  (if imap-use-utf7
-      (and string
-	   (condition-case ()
-	       (utf7-decode string t)
-	     (error (message
-		     "imap: Could not UTF7 decode `%s', using it undecoded..."
-		     string)
-		    string)))
-    string))
-
-(defsubst imap-ok-p (status)
-  (if (eq status 'OK)
-      t
-    (setq imap-error status)
-    nil))
-
-(defun imap-error-text (&optional buffer)
-  (with-current-buffer (or buffer (current-buffer))
-    (nth 3 (car imap-failed-tags))))
-
-
-;; Server functions; stream stuff:
-
-(defun imap-kerberos4-stream-p (buffer)
-  (imap-capability 'AUTH=KERBEROS_V4 buffer))
-
-(defun imap-kerberos4-open (name buffer server port)
-  (let ((cmds imap-kerberos4-program)
-	cmd done)
-    (while (and (not done) (setq cmd (pop cmds)))
-      (message "Opening Kerberos 4 IMAP connection with `%s'..." cmd)
-      (erase-buffer)
-      (let* ((port (or port imap-default-port))
-	     (coding-system-for-read imap-coding-system-for-read)
-	     (coding-system-for-write imap-coding-system-for-write)
-	     (process-connection-type imap-process-connection-type)
-	     (process (start-process
-		       name buffer shell-file-name shell-command-switch
-		       (format-spec
-			cmd
-			(format-spec-make
-			 ?s server
-			 ?p (number-to-string port)
-			 ?l imap-default-user))))
-	     response)
-	(when process
-	  (with-current-buffer buffer
-	    (setq imap-client-eol "\n"
-		  imap-calculate-literal-size-first t)
-	    (while (and (memq (process-status process) '(open run))
-			(set-buffer buffer) ;; XXX "blue moon" nntp.el bug
-			(goto-char (point-min))
-			;; Athena IMTEST can output SSL verify errors
-			(or (while (looking-at "^verify error:num=")
-			      (forward-line))
-			    t)
-			(or (while (looking-at "^TLS connection established")
-			      (forward-line))
-			    t)
-			;; cyrus 1.6.x (13? < x <= 22) queries capabilities
-			(or (while (looking-at "^C:")
-			      (forward-line))
-			    t)
-			;; cyrus 1.6 imtest print "S: " before server greeting
-			(or (not (looking-at "S: "))
-			    (forward-char 3)
-			    t)
-			(not (and (imap-parse-greeting)
-				  ;; success in imtest < 1.6:
-				  (or (re-search-forward
-				       "^__\\(.*\\)__\n" nil t)
-				      ;; success in imtest 1.6:
-				      (re-search-forward
-				       "^\\(Authenticat.*\\)" nil t))
-				  (setq response (match-string 1)))))
-	      (accept-process-output process 1)
-	      (sit-for 1))
-	    (and imap-log
-		 (with-current-buffer (get-buffer-create imap-log-buffer)
-		   (imap-disable-multibyte)
-		   (buffer-disable-undo)
-		   (goto-char (point-max))
-		   (insert-buffer-substring buffer)))
-	    (erase-buffer)
-	    (message "Opening Kerberos 4 IMAP connection with `%s'...%s" cmd
-		     (if response (concat "done, " response) "failed"))
-	    (if (and response (let ((case-fold-search nil))
-				(not (string-match "failed" response))))
-		(setq done process)
-	      (if (memq (process-status process) '(open run))
-		  (imap-logout))
-	      (delete-process process)
-	      nil)))))
-    done))
-
-(defun imap-gssapi-stream-p (buffer)
-  (imap-capability 'AUTH=GSSAPI buffer))
-
-(defun imap-gssapi-open (name buffer server port)
-  (let ((cmds imap-gssapi-program)
-	cmd done)
-    (while (and (not done) (setq cmd (pop cmds)))
-      (message "Opening GSSAPI IMAP connection with `%s'..." cmd)
-      (erase-buffer)
-      (let* ((port (or port imap-default-port))
-	     (coding-system-for-read imap-coding-system-for-read)
-	     (coding-system-for-write imap-coding-system-for-write)
-	     (process-connection-type imap-process-connection-type)
-	     (process (start-process
-		       name buffer shell-file-name shell-command-switch
-		       (format-spec
-			cmd
-			(format-spec-make
-			 ?s server
-			 ?p (number-to-string port)
-			 ?l imap-default-user))))
-	     response)
-	(when process
-	  (with-current-buffer buffer
-	    (setq imap-client-eol "\n"
-		  imap-calculate-literal-size-first t)
-	    (while (and (memq (process-status process) '(open run))
-			(set-buffer buffer) ;; XXX "blue moon" nntp.el bug
-			(goto-char (point-min))
-			;; Athena IMTEST can output SSL verify errors
-			(or (while (looking-at "^verify error:num=")
-			      (forward-line))
-			    t)
-			(or (while (looking-at "^TLS connection established")
-			      (forward-line))
-			    t)
-			;; cyrus 1.6.x (13? < x <= 22) queries capabilities
-			(or (while (looking-at "^C:")
-			      (forward-line))
-			    t)
-			;; cyrus 1.6 imtest print "S: " before server greeting
-			(or (not (looking-at "S: "))
-			    (forward-char 3)
-			    t)
-			;; GNU SASL may print 'Trying ...' first.
-			(or (not (looking-at "Trying "))
-			    (forward-line)
-			    t)
-			(not (and (imap-parse-greeting)
-				  ;; success in imtest 1.6:
-				  (re-search-forward
-				   (concat "^\\(\\(Authenticat.*\\)\\|\\("
-					   "Client authentication "
-					   "finished.*\\)\\)")
-				   nil t)
-				  (setq response (match-string 1)))))
-	      (accept-process-output process 1)
-	      (sit-for 1))
-	    (and imap-log
-		 (with-current-buffer (get-buffer-create imap-log-buffer)
-		   (imap-disable-multibyte)
-		   (buffer-disable-undo)
-		   (goto-char (point-max))
-		   (insert-buffer-substring buffer)))
-	    (erase-buffer)
-	    (message "GSSAPI IMAP connection: %s" (or response "failed"))
-	    (if (and response (let ((case-fold-search nil))
-				(not (string-match "failed" response))))
-		(setq done process)
-	      (if (memq (process-status process) '(open run))
-		  (imap-logout))
-	      (delete-process process)
-	      nil)))))
-    done))
-
-(defun imap-ssl-p (buffer)
-  nil)
-
-(defun imap-ssl-open (name buffer server port)
-  "Open a SSL connection to server."
-  (let ((cmds (if (listp imap-ssl-program) imap-ssl-program
-		(list imap-ssl-program)))
-	cmd done)
-    (while (and (not done) (setq cmd (pop cmds)))
-      (message "imap: Opening SSL connection with `%s'..." cmd)
-      (erase-buffer)
-      (let* ((port (or port imap-default-ssl-port))
-	     (coding-system-for-read imap-coding-system-for-read)
-	     (coding-system-for-write imap-coding-system-for-write)
-	     (process-connection-type imap-process-connection-type)
-	     (set-process-query-on-exit-flag
-	      (if (fboundp 'set-process-query-on-exit-flag)
-		  'set-process-query-on-exit-flag
-		'process-kill-without-query))
-	     process)
-	(when (progn
-		(setq process (start-process
-			       name buffer shell-file-name
-			       shell-command-switch
-			       (format-spec cmd
-					    (format-spec-make
-					     ?s server
-					     ?p (number-to-string port)))))
-		(funcall set-process-query-on-exit-flag process nil)
-		process)
-	  (with-current-buffer buffer
-	    (goto-char (point-min))
-	    (while (and (memq (process-status process) '(open run))
-			(set-buffer buffer) ;; XXX "blue moon" nntp.el bug
-			(goto-char (point-max))
-			(forward-line -1)
-			(not (imap-parse-greeting)))
-	      (accept-process-output process 1)
-	      (sit-for 1))
-	    (and imap-log
-		 (with-current-buffer (get-buffer-create imap-log-buffer)
-		   (imap-disable-multibyte)
-		   (buffer-disable-undo)
-		   (goto-char (point-max))
-		   (insert-buffer-substring buffer)))
-	    (erase-buffer)
-	    (when (memq (process-status process) '(open run))
-	      (setq done process))))))
-    (if done
-	(progn
-	  (message "imap: Opening SSL connection with `%s'...done" cmd)
-	  done)
-      (message "imap: Opening SSL connection with `%s'...failed" cmd)
-      nil)))
-
-(defun imap-tls-p (buffer)
-  nil)
-
-(defun imap-tls-open (name buffer server port)
-  (let* ((port (or port imap-default-tls-port))
-	 (coding-system-for-read imap-coding-system-for-read)
-	 (coding-system-for-write imap-coding-system-for-write)
-	 (process (open-tls-stream name buffer server port)))
-    (when process
-      (while (and (memq (process-status process) '(open run))
-		  (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
-		  (goto-char (point-max))
-		  (forward-line -1)
-		  (not (imap-parse-greeting)))
-	(accept-process-output process 1)
-	(sit-for 1))
-      (and imap-log
-	   (with-current-buffer (get-buffer-create imap-log-buffer)
-	     (imap-disable-multibyte)
-	     (buffer-disable-undo)
-	     (goto-char (point-max))
-	     (insert-buffer-substring buffer)))
-      (when (memq (process-status process) '(open run))
-	process))))
-
-(defun imap-network-p (buffer)
-  t)
-
-(defun imap-network-open (name buffer server port)
-  (let* ((port (or port imap-default-port))
-	 (coding-system-for-read imap-coding-system-for-read)
-	 (coding-system-for-write imap-coding-system-for-write)
-	 (process (open-network-stream name buffer server port)))
-    (when process
-      (while (and (memq (process-status process) '(open run))
-		  (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
-		  (goto-char (point-min))
-		  (not (imap-parse-greeting)))
-	(accept-process-output process 1)
-	(sit-for 1))
-      (and imap-log
-	   (with-current-buffer (get-buffer-create imap-log-buffer)
-	     (imap-disable-multibyte)
-	     (buffer-disable-undo)
-	     (goto-char (point-max))
-	     (insert-buffer-substring buffer)))
-      (when (memq (process-status process) '(open run))
-	process))))
-
-(defun imap-shell-p (buffer)
-  nil)
-
-(defun imap-shell-open (name buffer server port)
-  (let ((cmds (if (listp imap-shell-program) imap-shell-program
-		(list imap-shell-program)))
-	cmd done)
-    (while (and (not done) (setq cmd (pop cmds)))
-      (message "imap: Opening IMAP connection with `%s'..." cmd)
-      (setq imap-client-eol "\n")
-      (let* ((port (or port imap-default-port))
-	     (coding-system-for-read imap-coding-system-for-read)
-	     (coding-system-for-write imap-coding-system-for-write)
-	     (process (start-process
-		       name buffer shell-file-name shell-command-switch
-		       (format-spec
-			cmd
-			(format-spec-make
-			 ?s server
-			 ?g imap-shell-host
-			 ?p (number-to-string port)
-			 ?l imap-default-user)))))
-	(when process
-	  (while (and (memq (process-status process) '(open run))
-		      (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
-		      (goto-char (point-max))
-		      (forward-line -1)
-		      (not (imap-parse-greeting)))
-	    (accept-process-output process 1)
-	    (sit-for 1))
-	  (and imap-log
-	       (with-current-buffer (get-buffer-create imap-log-buffer)
-		 (imap-disable-multibyte)
-		 (buffer-disable-undo)
-		 (goto-char (point-max))
-		 (insert-buffer-substring buffer)))
-	  (erase-buffer)
-	  (when (memq (process-status process) '(open run))
-	    (setq done process)))))
-    (if done
-	(progn
-	  (message "imap: Opening IMAP connection with `%s'...done" cmd)
-	  done)
-      (message "imap: Opening IMAP connection with `%s'...failed" cmd)
-      nil)))
-
-(defun imap-starttls-p (buffer)
-  (imap-capability 'STARTTLS buffer))
-
-(defun imap-starttls-open (name buffer server port)
-  (let* ((port (or port imap-default-port))
-	 (coding-system-for-read imap-coding-system-for-read)
-	 (coding-system-for-write imap-coding-system-for-write)
-	 (process (starttls-open-stream name buffer server port))
-	 done tls-info)
-    (message "imap: Connecting with STARTTLS...")
-    (when process
-      (while (and (memq (process-status process) '(open run))
-		  (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
-		  (goto-char (point-max))
-		  (forward-line -1)
-		  (not (imap-parse-greeting)))
-	(accept-process-output process 1)
-	(sit-for 1))
-      (imap-send-command "STARTTLS")
-      (while (and (memq (process-status process) '(open run))
-		  (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
-		  (goto-char (point-max))
-		  (forward-line -1)
-		  (not (re-search-forward "[0-9]+ OK.*\r?\n" nil t)))
-	(accept-process-output process 1)
-	(sit-for 1))
-      (and imap-log
-	   (with-current-buffer (get-buffer-create imap-log-buffer)
-	     (buffer-disable-undo)
-	     (goto-char (point-max))
-	     (insert-buffer-substring buffer)))
-      (when (and (setq tls-info (starttls-negotiate process))
-		 (memq (process-status process) '(open run)))
-	(setq done process)))
-    (if (stringp tls-info)
-	(message "imap: STARTTLS info: %s" tls-info))
-    (message "imap: Connecting with STARTTLS...%s" (if done "done" "failed"))
-    done))
-
-;; Server functions; authenticator stuff:
-
-(defun imap-interactive-login (buffer loginfunc)
-  "Login to server in BUFFER.
-LOGINFUNC is passed a username and a password, it should return t if
-it where successful authenticating itself to the server, nil otherwise.
-Returns t if login was successful, nil otherwise."
-  (with-current-buffer buffer
-    (make-local-variable 'imap-username)
-    (make-local-variable 'imap-password)
-    (let (user passwd ret)
-      ;;      (condition-case ()
-      (while (or (not user) (not passwd))
-	(setq user (or imap-username
-		       (read-from-minibuffer
-			(concat "IMAP username for " imap-server
-				" (using stream `" (symbol-name imap-stream)
-				"'): ")
-			(or user imap-default-user))))
-	(setq passwd (or imap-password
-			 (read-passwd
-			  (concat "IMAP password for " user "@"
-				  imap-server " (using authenticator `"
-				  (symbol-name imap-auth) "'): "))))
-	(when (and user passwd)
-	  (if (funcall loginfunc user passwd)
-	      (progn
-		(setq ret t
-		      imap-username user)
-		(when (and (not imap-password)
-			   (or imap-store-password
-			       (y-or-n-p "Store password for this session? ")))
-		  (setq imap-password passwd)))
-	    (message "Login failed...")
-	    (setq passwd nil)
-	    (setq imap-password nil)
-	    (sit-for 1))))
-      ;;	(quit (with-current-buffer buffer
-      ;;		(setq user nil
-      ;;		      passwd nil)))
-      ;;	(error (with-current-buffer buffer
-      ;;		 (setq user nil
-      ;;		       passwd nil))))
-      ret)))
-
-(defun imap-gssapi-auth-p (buffer)
-  (eq imap-stream 'gssapi))
-
-(defun imap-gssapi-auth (buffer)
-  (message "imap: Authenticating using GSSAPI...%s"
-	   (if (eq imap-stream 'gssapi) "done" "failed"))
-  (eq imap-stream 'gssapi))
-
-(defun imap-kerberos4-auth-p (buffer)
-  (and (imap-capability 'AUTH=KERBEROS_V4 buffer)
-       (eq imap-stream 'kerberos4)))
-
-(defun imap-kerberos4-auth (buffer)
-  (message "imap: Authenticating using Kerberos 4...%s"
-	   (if (eq imap-stream 'kerberos4) "done" "failed"))
-  (eq imap-stream 'kerberos4))
-
-(defun imap-cram-md5-p (buffer)
-  (imap-capability 'AUTH=CRAM-MD5 buffer))
-
-(defun imap-cram-md5-auth (buffer)
-  "Login to server using the AUTH CRAM-MD5 method."
-  (message "imap: Authenticating using CRAM-MD5...")
-  (let ((done (imap-interactive-login
-	       buffer
-	       (lambda (user passwd)
-		 (imap-ok-p
-		  (imap-send-command-wait
-		   (list
-		    "AUTHENTICATE CRAM-MD5"
-		    (lambda (challenge)
-		      (let* ((decoded (base64-decode-string challenge))
-			     (hash (rfc2104-hash 'md5 64 16 passwd decoded))
-			     (response (concat user " " hash))
-			     (encoded (base64-encode-string response)))
-			encoded)))))))))
-    (if done
-	(message "imap: Authenticating using CRAM-MD5...done")
-      (message "imap: Authenticating using CRAM-MD5...failed"))))
-
-(defun imap-login-p (buffer)
-  (and (not (imap-capability 'LOGINDISABLED buffer))
-       (not (imap-capability 'X-LOGIN-CMD-DISABLED buffer))))
-
-(defun imap-quote-specials (string)
-  (with-temp-buffer
-    (insert string)
-    (goto-char (point-min))
-    (while (re-search-forward "[\\\"]" nil t)
-      (forward-char -1)
-      (insert "\\")
-      (forward-char 1))
-    (buffer-string)))
-
-(defun imap-login-auth (buffer)
-  "Login to server using the LOGIN command."
-  (message "imap: Plaintext authentication...")
-  (imap-interactive-login buffer
-			  (lambda (user passwd)
-			    (imap-ok-p (imap-send-command-wait
-					(concat "LOGIN \""
-						(imap-quote-specials user)
-						"\" \""
-						(imap-quote-specials passwd)
-						"\""))))))
-
-(defun imap-anonymous-p (buffer)
-  t)
-
-(defun imap-anonymous-auth (buffer)
-  (message "imap: Logging in anonymously...")
-  (with-current-buffer buffer
-    (imap-ok-p (imap-send-command-wait
-		(concat "LOGIN anonymous \"" (concat (user-login-name) "@"
-						     (system-name)) "\"")))))
-
-;;; Compiler directives.
-
-(defvar imap-sasl-client)
-(defvar imap-sasl-step)
-
-(defun imap-sasl-make-mechanisms (buffer)
-  (let ((mecs '()))
-    (mapc (lambda (sym)
-	    (let ((name (symbol-name sym)))
-	      (if (and (> (length name) 5)
-		       (string-equal "AUTH=" (substring name 0 5 )))
-		  (setq mecs (cons (substring name 5) mecs)))))
-	  (imap-capability nil buffer))
-    mecs))
-
-(defun imap-sasl-auth-p (buffer)
-  (and (condition-case ()
-	   (require 'sasl)
-	 (error nil))
-       (sasl-find-mechanism (imap-sasl-make-mechanisms buffer))))
-
-(defun imap-sasl-auth (buffer)
-  "Login to server using the SASL method."
-  (message "imap: Authenticating using SASL...")
-  (with-current-buffer buffer
-    (make-local-variable 'imap-username)
-    (make-local-variable 'imap-sasl-client)
-    (make-local-variable 'imap-sasl-step)
-    (let ((mechanism (sasl-find-mechanism (imap-sasl-make-mechanisms buffer)))
-	  logged user)
-      (while (not logged)
-	(setq user (or imap-username
-		       (read-from-minibuffer
-			(concat "IMAP username for " imap-server " using SASL "
-				(sasl-mechanism-name mechanism) ": ")
-			(or user imap-default-user))))
-	(when user
-	  (setq imap-sasl-client (sasl-make-client mechanism user "imap2" imap-server)
-		imap-sasl-step (sasl-next-step imap-sasl-client nil))
-	  (let ((tag (imap-send-command
-		      (if (sasl-step-data imap-sasl-step)
-			  (format "AUTHENTICATE %s %s"
-				  (sasl-mechanism-name mechanism)
-				  (sasl-step-data imap-sasl-step))
-			(format "AUTHENTICATE %s" (sasl-mechanism-name mechanism)))
-		      buffer)))
-	    (while (eq (imap-wait-for-tag tag) 'INCOMPLETE)
-	      (sasl-step-set-data imap-sasl-step (base64-decode-string imap-continuation))
-	      (setq imap-continuation nil
-		    imap-sasl-step (sasl-next-step imap-sasl-client imap-sasl-step))
-	      (imap-send-command-1 (if (sasl-step-data imap-sasl-step)
-				       (base64-encode-string (sasl-step-data imap-sasl-step) t)
-				     "")))
-	    (if (imap-ok-p (imap-wait-for-tag tag))
-		(setq imap-username user
-		      logged t)
-	      (message "Login failed...")
-	      (sit-for 1)))))
-      logged)))
-
-(defun imap-digest-md5-p (buffer)
-  (and (imap-capability 'AUTH=DIGEST-MD5 buffer)
-       (condition-case ()
-	   (require 'digest-md5)
-	 (error nil))))
-
-(defun imap-digest-md5-auth (buffer)
-  "Login to server using the AUTH DIGEST-MD5 method."
-  (message "imap: Authenticating using DIGEST-MD5...")
-  (imap-interactive-login
-   buffer
-   (lambda (user passwd)
-     (let ((tag
-	    (imap-send-command
-	     (list
-	      "AUTHENTICATE DIGEST-MD5"
-	      (lambda (challenge)
-		(digest-md5-parse-digest-challenge
-		 (base64-decode-string challenge))
-		(let* ((digest-uri
-			(digest-md5-digest-uri
-			 "imap" (digest-md5-challenge 'realm)))
-		       (response
-			(digest-md5-digest-response
-			 user passwd digest-uri)))
-		  (base64-encode-string response 'no-line-break))))
-	     )))
-       (if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE))
-	   nil
-	 (setq imap-continuation nil)
-	 (imap-send-command-1 "")
-	 (imap-ok-p (imap-wait-for-tag tag)))))))
-
-;; Server functions:
-
-(defun imap-open-1 (buffer)
-  (with-current-buffer buffer
-    (erase-buffer)
-    (setq imap-current-mailbox nil
-	  imap-current-message nil
-	  imap-state 'initial
-	  imap-process (condition-case ()
-			   (funcall (nth 2 (assq imap-stream
-						 imap-stream-alist))
-				    "imap" buffer imap-server imap-port)
-			 ((error quit) nil)))
-    (when imap-process
-      (set-process-filter imap-process 'imap-arrival-filter)
-      (set-process-sentinel imap-process 'imap-sentinel)
-      (while (and (eq imap-state 'initial)
-		  (memq (process-status imap-process) '(open run)))
-	(message "Waiting for response from %s..." imap-server)
-	(accept-process-output imap-process 1))
-      (message "Waiting for response from %s...done" imap-server)
-      (and (memq (process-status imap-process) '(open run))
-	   imap-process))))
-
-(defun imap-open (server &optional port stream auth buffer)
-  "Open a IMAP connection to host SERVER at PORT returning a buffer.
-If PORT is unspecified, a default value is used (143 except
-for SSL which use 993).
-STREAM indicates the stream to use, see `imap-streams' for available
-streams.  If nil, it choices the best stream the server is capable of.
-AUTH indicates authenticator to use, see `imap-authenticators' for
-available authenticators.  If nil, it choices the best stream the
-server is capable of.
-BUFFER can be a buffer or a name of a buffer, which is created if
-necessary.  If nil, the buffer name is generated."
-  (setq buffer (or buffer (format " *imap* %s:%d" server (or port 0))))
-  (with-current-buffer (get-buffer-create buffer)
-    (if (imap-opened buffer)
-	(imap-close buffer))
-    (mapc 'make-local-variable imap-local-variables)
-    (imap-disable-multibyte)
-    (buffer-disable-undo)
-    (setq imap-server (or server imap-server))
-    (setq imap-port (or port imap-port))
-    (setq imap-auth (or auth imap-auth))
-    (setq imap-stream (or stream imap-stream))
-    (message "imap: Connecting to %s..." imap-server)
-    (if (null (let ((imap-stream (or imap-stream imap-default-stream)))
-		(imap-open-1 buffer)))
-	(progn
-	  (message "imap: Connecting to %s...failed" imap-server)
-	  nil)
-      (when (null imap-stream)
-	;; Need to choose stream.
-	(let ((streams imap-streams))
-	  (while (setq stream (pop streams))
-	    ;; OK to use this stream?
-	    (when (funcall (nth 1 (assq stream imap-stream-alist)) buffer)
-	      ;; Stream changed?
-	      (if (not (eq imap-default-stream stream))
-		  (with-current-buffer (get-buffer-create
-					(generate-new-buffer-name " *temp*"))
-		    (mapc 'make-local-variable imap-local-variables)
-		    (imap-disable-multibyte)
-		    (buffer-disable-undo)
-		    (setq imap-server (or server imap-server))
-		    (setq imap-port (or port imap-port))
-		    (setq imap-auth (or auth imap-auth))
-		    (message "imap: Reconnecting with stream `%s'..." stream)
-		    (if (null (let ((imap-stream stream))
-				(imap-open-1 (current-buffer))))
-			(progn
-			  (kill-buffer (current-buffer))
-			  (message
-			   "imap: Reconnecting with stream `%s'...failed"
-			   stream))
-		      ;; We're done, kill the first connection
-		      (imap-close buffer)
-		      (let ((name (if (stringp buffer)
-				      buffer
-				    (buffer-name buffer))))
-			(kill-buffer buffer)
-			(rename-buffer name))
-		      (message "imap: Reconnecting with stream `%s'...done"
-			       stream)
-		      (setq imap-stream stream)
-		      (setq imap-capability nil)
-		      (setq streams nil)))
-		;; We're done
-		(message "imap: Connecting to %s...done" imap-server)
-		(setq imap-stream stream)
-		(setq imap-capability nil)
-		(setq streams nil))))))
-      (when (imap-opened buffer)
-	(setq imap-mailbox-data (make-vector imap-mailbox-prime 0)))
-      (when imap-stream
-	buffer))))
-
-(defun imap-opened (&optional buffer)
-  "Return non-nil if connection to imap server in BUFFER is open.
-If BUFFER is nil then the current buffer is used."
-  (and (setq buffer (get-buffer (or buffer (current-buffer))))
-       (buffer-live-p buffer)
-       (with-current-buffer buffer
-	 (and imap-process
-	      (memq (process-status imap-process) '(open run))))))
-
-(defun imap-authenticate (&optional user passwd buffer)
-  "Authenticate to server in BUFFER, using current buffer if nil.
-It uses the authenticator specified when opening the server.  If the
-authenticator requires username/passwords, they are queried from the
-user and optionally stored in the buffer.  If USER and/or PASSWD is
-specified, the user will not be questioned and the username and/or
-password is remembered in the buffer."
-  (with-current-buffer (or buffer (current-buffer))
-    (if (not (eq imap-state 'nonauth))
-	(or (eq imap-state 'auth)
-	    (eq imap-state 'selected)
-	    (eq imap-state 'examine))
-      (make-local-variable 'imap-username)
-      (make-local-variable 'imap-password)
-      (if user (setq imap-username user))
-      (if passwd (setq imap-password passwd))
-      (if imap-auth
-	  (and (funcall (nth 2 (assq imap-auth
-				     imap-authenticator-alist)) buffer)
-	       (setq imap-state 'auth))
-	;; Choose authenticator.
-	(let ((auths imap-authenticators)
-	      auth)
-	  (while (setq auth (pop auths))
-	    ;; OK to use authenticator?
-	    (when (funcall (nth 1 (assq auth imap-authenticator-alist)) buffer)
-	      (message "imap: Authenticating to `%s' using `%s'..."
-		       imap-server auth)
-	      (setq imap-auth auth)
-	      (if (funcall (nth 2 (assq auth imap-authenticator-alist)) buffer)
-		  (progn
-		    (message "imap: Authenticating to `%s' using `%s'...done"
-			     imap-server auth)
-		    (setq auths nil))
-		(message "imap: Authenticating to `%s' using `%s'...failed"
-			 imap-server auth)))))
-	imap-state))))
-
-(defun imap-close (&optional buffer)
-  "Close connection to server in BUFFER.
-If BUFFER is nil, the current buffer is used."
-  (with-current-buffer (or buffer (current-buffer))
-    (when (imap-opened)
-      (condition-case nil
-	  (imap-logout-wait)
-	(quit nil)))
-    (when (and imap-process
-	       (memq (process-status imap-process) '(open run)))
-      (delete-process imap-process))
-    (setq imap-current-mailbox nil
-	  imap-current-message nil
-	  imap-process nil)
-    (erase-buffer)
-    t))
-
-(defun imap-capability (&optional identifier buffer)
-  "Return a list of identifiers which server in BUFFER support.
-If IDENTIFIER, return non-nil if it's among the servers capabilities.
-If BUFFER is nil, the current buffer is assumed."
-  (with-current-buffer (or buffer (current-buffer))
-    (unless imap-capability
-      (unless (imap-ok-p (imap-send-command-wait "CAPABILITY"))
-	(setq imap-capability '(IMAP2))))
-    (if identifier
-	(memq (intern (upcase (symbol-name identifier))) imap-capability)
-      imap-capability)))
-
-(defun imap-id (&optional list-of-values buffer)
-  "Identify client to server in BUFFER, and return server identity.
-LIST-OF-VALUES is nil, or a plist with identifier and value
-strings to send to the server to identify the client.
-
-Return a list of identifiers which server in BUFFER support, or
-nil if it doesn't support ID or returns no information.
-
-If BUFFER is nil, the current buffer is assumed."
-  (with-current-buffer (or buffer (current-buffer))
-    (when (and (imap-capability 'ID)
-	       (imap-ok-p (imap-send-command-wait
-			   (if (null list-of-values)
-			       "ID NIL"
-			     (concat "ID (" (mapconcat (lambda (el)
-							 (concat "\"" el "\""))
-						       list-of-values
-						       " ") ")")))))
-      imap-id)))
-
-(defun imap-namespace (&optional buffer)
-  "Return a namespace hierarchy at server in BUFFER.
-If BUFFER is nil, the current buffer is assumed."
-  (with-current-buffer (or buffer (current-buffer))
-    (unless imap-namespace
-      (when (imap-capability 'NAMESPACE)
-	(imap-send-command-wait "NAMESPACE")))
-    imap-namespace))
-
-(defun imap-send-command-wait (command &optional buffer)
-  (imap-wait-for-tag (imap-send-command command buffer) buffer))
-
-(defun imap-logout (&optional buffer)
-  (or buffer (setq buffer (current-buffer)))
-  (if imap-logout-timeout
-      (with-timeout (imap-logout-timeout
-		     (condition-case nil
-			 (with-current-buffer buffer
-			   (delete-process imap-process))
-		       (error)))
-	(imap-send-command "LOGOUT" buffer))
-    (imap-send-command "LOGOUT" buffer)))
-
-(defun imap-logout-wait (&optional buffer)
-  (or buffer (setq buffer (current-buffer)))
-  (if imap-logout-timeout
-      (with-timeout (imap-logout-timeout
-		     (condition-case nil
-			 (with-current-buffer buffer
-			   (delete-process imap-process))
-		       (error)))
-	(imap-send-command-wait "LOGOUT" buffer))
-    (imap-send-command-wait "LOGOUT" buffer)))
-
-
-;; Mailbox functions:
-
-(defun imap-mailbox-put (propname value &optional mailbox buffer)
-  (with-current-buffer (or buffer (current-buffer))
-    (if imap-mailbox-data
-	(put (intern (or mailbox imap-current-mailbox) imap-mailbox-data)
-	     propname value)
-      (error "Imap-mailbox-data is nil, prop %s value %s mailbox %s buffer %s"
-	     propname value mailbox (current-buffer)))
-    t))
-
-(defsubst imap-mailbox-get-1 (propname &optional mailbox)
-  (get (intern-soft (or mailbox imap-current-mailbox) imap-mailbox-data)
-       propname))
-
-(defun imap-mailbox-get (propname &optional mailbox buffer)
-  (let ((mailbox (imap-utf7-encode mailbox)))
-    (with-current-buffer (or buffer (current-buffer))
-      (imap-mailbox-get-1 propname (or mailbox imap-current-mailbox)))))
-
-(defun imap-mailbox-map-1 (func &optional mailbox-decoder buffer)
-  (with-current-buffer (or buffer (current-buffer))
-    (let (result)
-      (mapatoms
-       (lambda (s)
-	 (push (funcall func (if mailbox-decoder
-				 (funcall mailbox-decoder (symbol-name s))
-			       (symbol-name s))) result))
-       imap-mailbox-data)
-      result)))
-
-(defun imap-mailbox-map (func &optional buffer)
-  "Map a function across each mailbox in `imap-mailbox-data', returning a list.
-Function should take a mailbox name (a string) as
-the only argument."
-  (imap-mailbox-map-1 func 'imap-utf7-decode buffer))
-
-(defun imap-current-mailbox (&optional buffer)
-  (with-current-buffer (or buffer (current-buffer))
-    (imap-utf7-decode imap-current-mailbox)))
-
-(defun imap-current-mailbox-p-1 (mailbox &optional examine)
-  (and (string= mailbox imap-current-mailbox)
-       (or (and examine
-		(eq imap-state 'examine))
-	   (and (not examine)
-		(eq imap-state 'selected)))))
-
-(defun imap-current-mailbox-p (mailbox &optional examine buffer)
-  (with-current-buffer (or buffer (current-buffer))
-    (imap-current-mailbox-p-1 (imap-utf7-encode mailbox) examine)))
-
-(defun imap-mailbox-select-1 (mailbox &optional examine)
-  "Select MAILBOX on server in BUFFER.
-If EXAMINE is non-nil, do a read-only select."
-  (if (imap-current-mailbox-p-1 mailbox examine)
-      imap-current-mailbox
-    (setq imap-current-mailbox mailbox)
-    (if (imap-ok-p (imap-send-command-wait
-		    (concat (if examine "EXAMINE" "SELECT") " \""
-			    mailbox "\"")))
-	(progn
-	  (setq imap-message-data (make-vector imap-message-prime 0)
-		imap-state (if examine 'examine 'selected))
-	  imap-current-mailbox)
-      ;; Failed SELECT/EXAMINE unselects current mailbox
-      (setq imap-current-mailbox nil))))
-
-(defun imap-mailbox-select (mailbox &optional examine buffer)
-  (with-current-buffer (or buffer (current-buffer))
-    (imap-utf7-decode
-     (imap-mailbox-select-1 (imap-utf7-encode mailbox) examine))))
-
-(defun imap-mailbox-examine-1 (mailbox &optional buffer)
-  (with-current-buffer (or buffer (current-buffer))
-    (imap-mailbox-select-1 mailbox 'examine)))
-
-(defun imap-mailbox-examine (mailbox &optional buffer)
-  "Examine MAILBOX on server in BUFFER."
-  (imap-mailbox-select mailbox 'examine buffer))
-
-(defun imap-mailbox-unselect (&optional buffer)
-  "Close current folder in BUFFER, without expunging articles."
-  (with-current-buffer (or buffer (current-buffer))
-    (when (or (eq imap-state 'auth)
-	      (and (imap-capability 'UNSELECT)
-		   (imap-ok-p (imap-send-command-wait "UNSELECT")))
-	      (and (imap-ok-p
-		    (imap-send-command-wait (concat "EXAMINE \""
-						    imap-current-mailbox
-						    "\"")))
-		   (imap-ok-p (imap-send-command-wait "CLOSE"))))
-      (setq imap-current-mailbox nil
-	    imap-message-data nil
-	    imap-state 'auth)
-      t)))
-
-(defun imap-mailbox-expunge (&optional asynch buffer)
-  "Expunge articles in current folder in BUFFER.
-If ASYNCH, do not wait for succesful completion of the command.
-If BUFFER is nil the current buffer is assumed."
-  (with-current-buffer (or buffer (current-buffer))
-    (when (and imap-current-mailbox (not (eq imap-state 'examine)))
-      (if asynch
-	  (imap-send-command "EXPUNGE")
-      (imap-ok-p (imap-send-command-wait "EXPUNGE"))))))
-
-(defun imap-mailbox-close (&optional asynch buffer)
-  "Expunge articles and close current folder in BUFFER.
-If ASYNCH, do not wait for succesful completion of the command.
-If BUFFER is nil the current buffer is assumed."
-  (with-current-buffer (or buffer (current-buffer))
-    (when imap-current-mailbox
-      (if asynch
-	  (imap-add-callback (imap-send-command "CLOSE")
-			     `(lambda (tag status)
-				(message "IMAP mailbox `%s' closed... %s"
-					 imap-current-mailbox status)
-				(when (eq ,imap-current-mailbox
-					  imap-current-mailbox)
-				  ;; Don't wipe out data if another mailbox
-				  ;; was selected...
-				  (setq imap-current-mailbox nil
-					imap-message-data nil
-					imap-state 'auth))))
-	(when (imap-ok-p (imap-send-command-wait "CLOSE"))
-	  (setq imap-current-mailbox nil
-		imap-message-data nil
-		imap-state 'auth)))
-      t)))
-
-(defun imap-mailbox-create-1 (mailbox)
-  (imap-ok-p (imap-send-command-wait (list "CREATE \"" mailbox "\""))))
-
-(defun imap-mailbox-create (mailbox &optional buffer)
-  "Create MAILBOX on server in BUFFER.
-If BUFFER is nil the current buffer is assumed."
-  (with-current-buffer (or buffer (current-buffer))
-    (imap-mailbox-create-1 (imap-utf7-encode mailbox))))
-
-(defun imap-mailbox-delete (mailbox &optional buffer)
-  "Delete MAILBOX on server in BUFFER.
-If BUFFER is nil the current buffer is assumed."
-  (let ((mailbox (imap-utf7-encode mailbox)))
-    (with-current-buffer (or buffer (current-buffer))
-      (imap-ok-p
-       (imap-send-command-wait (list "DELETE \"" mailbox "\""))))))
-
-(defun imap-mailbox-rename (oldname newname &optional buffer)
-  "Rename mailbox OLDNAME to NEWNAME on server in BUFFER.
-If BUFFER is nil the current buffer is assumed."
-  (let ((oldname (imap-utf7-encode oldname))
-	(newname (imap-utf7-encode newname)))
-    (with-current-buffer (or buffer (current-buffer))
-      (imap-ok-p
-       (imap-send-command-wait (list "RENAME \"" oldname "\" "
-				     "\"" newname "\""))))))
-
-(defun imap-mailbox-lsub (&optional root reference add-delimiter buffer)
-  "Return a list of subscribed mailboxes on server in BUFFER.
-If ROOT is non-nil, only list matching mailboxes.  If ADD-DELIMITER is
-non-nil, a hierarchy delimiter is added to root.  REFERENCE is a
-implementation-specific string that has to be passed to lsub command."
-  (with-current-buffer (or buffer (current-buffer))
-    ;; Make sure we know the hierarchy separator for root's hierarchy
-    (when (and add-delimiter (null (imap-mailbox-get-1 'delimiter root)))
-      (imap-send-command-wait (concat "LIST \"" reference "\" \""
-				      (imap-utf7-encode root) "\"")))
-    ;; clear list data (NB not delimiter and other stuff)
-    (imap-mailbox-map-1 (lambda (mailbox)
-			  (imap-mailbox-put 'lsub nil mailbox)))
-    (when (imap-ok-p
-	   (imap-send-command-wait
-	    (concat "LSUB \"" reference "\" \"" (imap-utf7-encode root)
-		    (and add-delimiter (imap-mailbox-get-1 'delimiter root))
-		    "%\"")))
-      (let (out)
-	(imap-mailbox-map-1 (lambda (mailbox)
-			      (when (imap-mailbox-get-1 'lsub mailbox)
-				(push (imap-utf7-decode mailbox) out))))
-	(nreverse out)))))
-
-(defun imap-mailbox-list (root &optional reference add-delimiter buffer)
-  "Return a list of mailboxes matching ROOT on server in BUFFER.
-If ADD-DELIMITER is non-nil, a hierarchy delimiter is added to
-root.  REFERENCE is a implementation-specific string that has to be
-passed to list command."
-  (with-current-buffer (or buffer (current-buffer))
-    ;; Make sure we know the hierarchy separator for root's hierarchy
-    (when (and add-delimiter (null (imap-mailbox-get-1 'delimiter root)))
-      (imap-send-command-wait (concat "LIST \"" reference "\" \""
-				      (imap-utf7-encode root) "\"")))
-    ;; clear list data (NB not delimiter and other stuff)
-    (imap-mailbox-map-1 (lambda (mailbox)
-			  (imap-mailbox-put 'list nil mailbox)))
-    (when (imap-ok-p
-	   (imap-send-command-wait
-	    (concat "LIST \"" reference "\" \"" (imap-utf7-encode root)
-		    (and add-delimiter (imap-mailbox-get-1 'delimiter root))
-		    "%\"")))
-      (let (out)
-	(imap-mailbox-map-1 (lambda (mailbox)
-			      (when (imap-mailbox-get-1 'list mailbox)
-				(push (imap-utf7-decode mailbox) out))))
-	(nreverse out)))))
-
-(defun imap-mailbox-subscribe (mailbox &optional buffer)
-  "Send the SUBSCRIBE command on the mailbox to server in BUFFER.
-Returns non-nil if successful."
-  (with-current-buffer (or buffer (current-buffer))
-    (imap-ok-p (imap-send-command-wait (concat "SUBSCRIBE \""
-					       (imap-utf7-encode mailbox)
-					       "\"")))))
-
-(defun imap-mailbox-unsubscribe (mailbox &optional buffer)
-  "Send the SUBSCRIBE command on the mailbox to server in BUFFER.
-Returns non-nil if successful."
-  (with-current-buffer (or buffer (current-buffer))
-    (imap-ok-p (imap-send-command-wait (concat "UNSUBSCRIBE "
-					       (imap-utf7-encode mailbox)
-					       "\"")))))
-
-(defun imap-mailbox-status (mailbox items &optional buffer)
-  "Get status items ITEM in MAILBOX from server in BUFFER.
-ITEMS can be a symbol or a list of symbols, valid symbols are one of
-the STATUS data items -- ie 'messages, 'recent, 'uidnext, 'uidvalidity
-or 'unseen.  If ITEMS is a list of symbols, a list of values is
-returned, if ITEMS is a symbol only its value is returned."
-  (with-current-buffer (or buffer (current-buffer))
-    (when (imap-ok-p
-	   (imap-send-command-wait (list "STATUS \""
-					 (imap-utf7-encode mailbox)
-					 "\" "
-					 (upcase
-					  (format "%s"
-						  (if (listp items)
-						      items
-						    (list items)))))))
-      (if (listp items)
-	  (mapcar (lambda (item)
-		    (imap-mailbox-get item mailbox))
-		  items)
-	(imap-mailbox-get items mailbox)))))
-
-(defun imap-mailbox-status-asynch (mailbox items &optional buffer)
-  "Send status item request ITEM on MAILBOX to server in BUFFER.
-ITEMS can be a symbol or a list of symbols, valid symbols are one of
-the STATUS data items -- ie 'messages, 'recent, 'uidnext, 'uidvalidity
-or 'unseen.  The IMAP command tag is returned."
-  (with-current-buffer (or buffer (current-buffer))
-    (imap-send-command (list "STATUS \""
-			     (imap-utf7-encode mailbox)
-			     "\" "
-			     (format "%s"
-				     (if (listp items)
-					 items
-				       (list items)))))))
-
-(defun imap-mailbox-acl-get (&optional mailbox buffer)
-  "Get ACL on mailbox from server in BUFFER."
-  (let ((mailbox (imap-utf7-encode mailbox)))
-    (with-current-buffer (or buffer (current-buffer))
-      (when (imap-ok-p
-	     (imap-send-command-wait (list "GETACL \""
-					   (or mailbox imap-current-mailbox)
-					   "\"")))
-	(imap-mailbox-get-1 'acl (or mailbox imap-current-mailbox))))))
-
-(defun imap-mailbox-acl-set (identifier rights &optional mailbox buffer)
-  "Change/set ACL for IDENTIFIER to RIGHTS in MAILBOX from server in BUFFER."
-  (let ((mailbox (imap-utf7-encode mailbox)))
-    (with-current-buffer (or buffer (current-buffer))
-      (imap-ok-p
-       (imap-send-command-wait (list "SETACL \""
-				     (or mailbox imap-current-mailbox)
-				     "\" "
-				     identifier
-				     " "
-				     rights))))))
-
-(defun imap-mailbox-acl-delete (identifier &optional mailbox buffer)
-  "Removes any <identifier,rights> pair for IDENTIFIER in MAILBOX from server in BUFFER."
-  (let ((mailbox (imap-utf7-encode mailbox)))
-    (with-current-buffer (or buffer (current-buffer))
-      (imap-ok-p
-       (imap-send-command-wait (list "DELETEACL \""
-				     (or mailbox imap-current-mailbox)
-				     "\" "
-				     identifier))))))
-
-
-;; Message functions:
-
-(defun imap-current-message (&optional buffer)
-  (with-current-buffer (or buffer (current-buffer))
-    imap-current-message))
-
-(defun imap-list-to-message-set (list)
-  (mapconcat (lambda (item)
-	       (number-to-string item))
-	     (if (listp list)
-		 list
-	       (list list))
-	     ","))
-
-(defun imap-range-to-message-set (range)
-  (mapconcat
-   (lambda (item)
-     (if (consp item)
-	 (format "%d:%d"
-		 (car item) (cdr item))
-       (format "%d" item)))
-   (if (and (listp range) (not (listp (cdr range))))
-       (list range) ;; make (1 . 2) into ((1 . 2))
-     range)
-   ","))
-
-(defun imap-fetch-asynch (uids props &optional nouidfetch buffer)
-  (with-current-buffer (or buffer (current-buffer))
-    (imap-send-command (format "%sFETCH %s %s" (if nouidfetch "" "UID ")
-			       (if (listp uids)
-				   (imap-list-to-message-set uids)
-				 uids)
-			       props))))
-
-(defun imap-fetch (uids props &optional receive nouidfetch buffer)
-  "Fetch properties PROPS from message set UIDS from server in BUFFER.
-UIDS can be a string, number or a list of numbers.  If RECEIVE
-is non-nil return these properties."
-  (with-current-buffer (or buffer (current-buffer))
-    (when (imap-ok-p (imap-send-command-wait
-		      (format "%sFETCH %s %s" (if nouidfetch "" "UID ")
-			      (if (listp uids)
-				  (imap-list-to-message-set uids)
-				uids)
-			      props)))
-      (if (or (null receive) (stringp uids))
-	  t
-	(if (listp uids)
-	    (mapcar (lambda (uid)
-		      (if (listp receive)
-			  (mapcar (lambda (prop)
-				    (imap-message-get uid prop))
-				  receive)
-			(imap-message-get uid receive)))
-		    uids)
-	  (imap-message-get uids receive))))))
-
-(defun imap-message-put (uid propname value &optional buffer)
-  (with-current-buffer (or buffer (current-buffer))
-    (if imap-message-data
-	(put (intern (number-to-string uid) imap-message-data)
-	     propname value)
-      (error "Imap-message-data is nil, uid %s prop %s value %s buffer %s"
-	     uid propname value (current-buffer)))
-    t))
-
-(defun imap-message-get (uid propname &optional buffer)
-  (with-current-buffer (or buffer (current-buffer))
-    (get (intern-soft (number-to-string uid) imap-message-data)
-	 propname)))
-
-(defun imap-message-map (func propname &optional buffer)
-  "Map a function across each mailbox in `imap-message-data', returning a list."
-  (with-current-buffer (or buffer (current-buffer))
-    (let (result)
-      (mapatoms
-       (lambda (s)
-	 (push (funcall func (get s 'UID) (get s propname)) result))
-       imap-message-data)
-      result)))
-
-(defmacro imap-message-envelope-date (uid &optional buffer)
-  `(with-current-buffer (or ,buffer (current-buffer))
-     (elt (imap-message-get ,uid 'ENVELOPE) 0)))
-
-(defmacro imap-message-envelope-subject (uid &optional buffer)
-  `(with-current-buffer (or ,buffer (current-buffer))
-     (elt (imap-message-get ,uid 'ENVELOPE) 1)))
-
-(defmacro imap-message-envelope-from (uid &optional buffer)
-  `(with-current-buffer (or ,buffer (current-buffer))
-     (elt (imap-message-get ,uid 'ENVELOPE) 2)))
-
-(defmacro imap-message-envelope-sender (uid &optional buffer)
-  `(with-current-buffer (or ,buffer (current-buffer))
-     (elt (imap-message-get ,uid 'ENVELOPE) 3)))
-
-(defmacro imap-message-envelope-reply-to (uid &optional buffer)
-  `(with-current-buffer (or ,buffer (current-buffer))
-     (elt (imap-message-get ,uid 'ENVELOPE) 4)))
-
-(defmacro imap-message-envelope-to (uid &optional buffer)
-  `(with-current-buffer (or ,buffer (current-buffer))
-     (elt (imap-message-get ,uid 'ENVELOPE) 5)))
-
-(defmacro imap-message-envelope-cc (uid &optional buffer)
-  `(with-current-buffer (or ,buffer (current-buffer))
-     (elt (imap-message-get ,uid 'ENVELOPE) 6)))
-
-(defmacro imap-message-envelope-bcc (uid &optional buffer)
-  `(with-current-buffer (or ,buffer (current-buffer))
-     (elt (imap-message-get ,uid 'ENVELOPE) 7)))
-
-(defmacro imap-message-envelope-in-reply-to (uid &optional buffer)
-  `(with-current-buffer (or ,buffer (current-buffer))
-     (elt (imap-message-get ,uid 'ENVELOPE) 8)))
-
-(defmacro imap-message-envelope-message-id (uid &optional buffer)
-  `(with-current-buffer (or ,buffer (current-buffer))
-     (elt (imap-message-get ,uid 'ENVELOPE) 9)))
-
-(defmacro imap-message-body (uid &optional buffer)
-  `(with-current-buffer (or ,buffer (current-buffer))
-     (imap-message-get ,uid 'BODY)))
-
-(defun imap-search (predicate &optional buffer)
-  (with-current-buffer (or buffer (current-buffer))
-    (imap-mailbox-put 'search 'dummy)
-    (when (imap-ok-p (imap-send-command-wait (concat "UID SEARCH " predicate)))
-      (if (eq (imap-mailbox-get-1 'search imap-current-mailbox) 'dummy)
-	  (progn
-	    (message "Missing SEARCH response to a SEARCH command (server not RFC compliant)...")
-	    nil)
-	(imap-mailbox-get-1 'search imap-current-mailbox)))))
-
-(defun imap-message-flag-permanent-p (flag &optional mailbox buffer)
-  "Return t if FLAG can be permanently (between IMAP sessions) saved on articles, in MAILBOX on server in BUFFER."
-  (with-current-buffer (or buffer (current-buffer))
-    (or (member "\\*" (imap-mailbox-get 'permanentflags mailbox))
-	(member flag (imap-mailbox-get 'permanentflags mailbox)))))
-
-(defun imap-message-flags-set (articles flags &optional silent buffer)
-  (when (and articles flags)
-    (with-current-buffer (or buffer (current-buffer))
-      (imap-ok-p (imap-send-command-wait
-		  (concat "UID STORE " articles
-			  " FLAGS" (if silent ".SILENT") " (" flags ")"))))))
-
-(defun imap-message-flags-del (articles flags &optional silent buffer)
-  (when (and articles flags)
-    (with-current-buffer (or buffer (current-buffer))
-      (imap-ok-p (imap-send-command-wait
-		  (concat "UID STORE " articles
-			  " -FLAGS" (if silent ".SILENT") " (" flags ")"))))))
-
-(defun imap-message-flags-add (articles flags &optional silent buffer)
-  (when (and articles flags)
-    (with-current-buffer (or buffer (current-buffer))
-      (imap-ok-p (imap-send-command-wait
-		  (concat "UID STORE " articles
-			  " +FLAGS" (if silent ".SILENT") " (" flags ")"))))))
-
-(defun imap-message-copyuid-1 (mailbox)
-  (if (imap-capability 'UIDPLUS)
-      (list (nth 0 (imap-mailbox-get-1 'copyuid mailbox))
-	    (string-to-number (nth 2 (imap-mailbox-get-1 'copyuid mailbox))))
-    (let ((old-mailbox imap-current-mailbox)
-	  (state imap-state)
-	  (imap-message-data (make-vector 2 0)))
-      (when (imap-mailbox-examine-1 mailbox)
-	(prog1
-	    (and (imap-fetch "*" "UID")
-		 (list (imap-mailbox-get-1 'uidvalidity mailbox)
-		       (apply 'max (imap-message-map
-				    (lambda (uid prop) uid) 'UID))))
-	  (if old-mailbox
-	      (imap-mailbox-select old-mailbox (eq state 'examine))
-	    (imap-mailbox-unselect)))))))
-
-(defun imap-message-copyuid (mailbox &optional buffer)
-  (with-current-buffer (or buffer (current-buffer))
-    (imap-message-copyuid-1 (imap-utf7-decode mailbox))))
-
-(defun imap-message-copy (articles mailbox
-				   &optional dont-create no-copyuid buffer)
-  "Copy ARTICLES (a string message set) to MAILBOX on server in
-BUFFER, creating mailbox if it doesn't exist.  If dont-create is
-non-nil, it will not create a mailbox.  On success, return a list with
-the UIDVALIDITY of the mailbox the article(s) was copied to as the
-first element, rest of list contain the saved articles' UIDs."
-  (when articles
-    (with-current-buffer (or buffer (current-buffer))
-      (let ((mailbox (imap-utf7-encode mailbox)))
-	(if (let ((cmd (concat "UID COPY " articles " \"" mailbox "\""))
-		  (imap-current-target-mailbox mailbox))
-	      (if (imap-ok-p (imap-send-command-wait cmd))
-		  t
-		(when (and (not dont-create)
-			   ;; removed because of buggy Oracle server
-			   ;; that doesn't send TRYCREATE tags (which
-			   ;; is a MUST according to specifications):
-			   ;;(imap-mailbox-get-1 'trycreate mailbox)
-			   (imap-mailbox-create-1 mailbox))
-		  (imap-ok-p (imap-send-command-wait cmd)))))
-	    (or no-copyuid
-		(imap-message-copyuid-1 mailbox)))))))
-
-(defun imap-message-appenduid-1 (mailbox)
-  (if (imap-capability 'UIDPLUS)
-      (imap-mailbox-get-1 'appenduid mailbox)
-    (let ((old-mailbox imap-current-mailbox)
-	  (state imap-state)
-	  (imap-message-data (make-vector 2 0)))
-      (when (imap-mailbox-examine-1 mailbox)
-	(prog1
-	    (and (imap-fetch "*" "UID")
-		 (list (imap-mailbox-get-1 'uidvalidity mailbox)
-		       (apply 'max (imap-message-map
-				    (lambda (uid prop) uid) 'UID))))
-	  (if old-mailbox
-	      (imap-mailbox-select old-mailbox (eq state 'examine))
-	    (imap-mailbox-unselect)))))))
-
-(defun imap-message-appenduid (mailbox &optional buffer)
-  (with-current-buffer (or buffer (current-buffer))
-    (imap-message-appenduid-1 (imap-utf7-encode mailbox))))
-
-(defun imap-message-append (mailbox article &optional flags date-time buffer)
-  "Append ARTICLE (a buffer) to MAILBOX on server in BUFFER.
-FLAGS and DATE-TIME is currently not used.  Return a cons holding
-uidvalidity of MAILBOX and UID the newly created article got, or nil
-on failure."
-  (let ((mailbox (imap-utf7-encode mailbox)))
-    (with-current-buffer (or buffer (current-buffer))
-      (and (let ((imap-current-target-mailbox mailbox))
-	     (imap-ok-p
-	      (imap-send-command-wait
-	       (list "APPEND \"" mailbox "\" "  article))))
-	   (imap-message-appenduid-1 mailbox)))))
-
-(defun imap-body-lines (body)
-  "Return number of lines in article by looking at the mime bodystructure BODY."
-  (if (listp body)
-      (if (stringp (car body))
-	  (cond ((and (string= (upcase (car body)) "TEXT")
-		      (numberp (nth 7 body)))
-		 (nth 7 body))
-		((and (string= (upcase (car body)) "MESSAGE")
-		      (numberp (nth 9 body)))
-		 (nth 9 body))
-		(t 0))
-	(apply '+ (mapcar 'imap-body-lines body)))
-    0))
-
-(defun imap-envelope-from (from)
-  "Return a from string line."
-  (and from
-       (concat (aref from 0)
-	       (if (aref from 0) " <")
-	       (aref from 2)
-	       "@"
-	       (aref from 3)
-	       (if (aref from 0) ">"))))
-
-
-;; Internal functions.
-
-(defun imap-add-callback (tag func)
-  (setq imap-callbacks (append (list (cons tag func)) imap-callbacks)))
-
-(defun imap-send-command-1 (cmdstr)
-  (setq cmdstr (concat cmdstr imap-client-eol))
-  (and imap-log
-       (with-current-buffer (get-buffer-create imap-log-buffer)
-	 (imap-disable-multibyte)
-	 (buffer-disable-undo)
-	 (goto-char (point-max))
-	 (insert cmdstr)))
-  (process-send-string imap-process cmdstr))
-
-(defun imap-send-command (command &optional buffer)
-  (with-current-buffer (or buffer (current-buffer))
-    (if (not (listp command)) (setq command (list command)))
-    (let ((tag (setq imap-tag (1+ imap-tag)))
-	  cmd cmdstr)
-      (setq cmdstr (concat (number-to-string imap-tag) " "))
-      (while (setq cmd (pop command))
-	(cond ((stringp cmd)
-	       (setq cmdstr (concat cmdstr cmd)))
-	      ((bufferp cmd)
-	       (let ((eol imap-client-eol)
-		     (calcfirst imap-calculate-literal-size-first)
-		     size)
-		 (with-current-buffer cmd
-		   (if calcfirst
-		       (setq size (buffer-size)))
-		   (when (not (equal eol "\r\n"))
-		     ;; XXX modifies buffer!
-		     (goto-char (point-min))
-		     (while (search-forward "\r\n" nil t)
-		       (replace-match eol)))
-		   (if (not calcfirst)
-		       (setq size (buffer-size))))
-		 (setq cmdstr
-		       (concat cmdstr (format "{%d}" size))))
-	       (unwind-protect
-		   (progn
-		     (imap-send-command-1 cmdstr)
-		     (setq cmdstr nil)
-		     (if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE))
-			 (setq command nil) ;; abort command if no cont-req
-		       (let ((process imap-process)
-			     (stream imap-stream)
-			     (eol imap-client-eol))
-			 (with-current-buffer cmd
-			   (and imap-log
-				(with-current-buffer (get-buffer-create
-						      imap-log-buffer)
-				  (imap-disable-multibyte)
-				  (buffer-disable-undo)
-				  (goto-char (point-max))
-				  (insert-buffer-substring cmd)))
-			   (process-send-region process (point-min)
-						(point-max)))
-			 (process-send-string process imap-client-eol))))
-		 (setq imap-continuation nil)))
-	      ((functionp cmd)
-	       (imap-send-command-1 cmdstr)
-	       (setq cmdstr nil)
-	       (unwind-protect
-		   (if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE))
-		       (setq command nil) ;; abort command if no cont-req
-		     (setq command (cons (funcall cmd imap-continuation)
-					 command)))
-		 (setq imap-continuation nil)))
-	      (t
-	       (error "Unknown command type"))))
-      (if cmdstr
-	  (imap-send-command-1 cmdstr))
-      tag)))
-
-(defun imap-wait-for-tag (tag &optional buffer)
-  (with-current-buffer (or buffer (current-buffer))
-    (let (imap-have-messaged)
-      (while (and (null imap-continuation)
-		  (memq (process-status imap-process) '(open run))
-		  (< imap-reached-tag tag))
-	(let ((len (/ (point-max) 1024))
-	      message-log-max)
-	  (unless (< len 10)
-	    (setq imap-have-messaged t)
-	    (message "imap read: %dk" len))
-	  (accept-process-output imap-process
-				 (truncate imap-read-timeout)
-				 (truncate (* (- imap-read-timeout
-						 (truncate imap-read-timeout))
-					      1000)))))
-      ;; A process can die _before_ we have processed everything it
-      ;; has to say.  Moreover, this can happen in between the call to
-      ;; accept-process-output and the call to process-status in an
-      ;; iteration of the loop above.
-      (when (and (null imap-continuation)
-		 (< imap-reached-tag tag))
-	(accept-process-output imap-process 0 0))
-      (when imap-have-messaged
-	(message ""))
-      (and (memq (process-status imap-process) '(open run))
-	   (or (assq tag imap-failed-tags)
-	       (if imap-continuation
-		   'INCOMPLETE
-		 'OK))))))
-
-(defun imap-sentinel (process string)
-  (delete-process process))
-
-(defun imap-find-next-line ()
-  "Return point at end of current line, taking into account literals.
-Return nil if no complete line has arrived."
-  (when (re-search-forward (concat imap-server-eol "\\|{\\([0-9]+\\)}"
-				   imap-server-eol)
-			   nil t)
-    (if (match-string 1)
-	(if (< (point-max) (+ (point) (string-to-number (match-string 1))))
-	    nil
-	  (goto-char (+ (point) (string-to-number (match-string 1))))
-	  (imap-find-next-line))
-      (point))))
-
-(defun imap-arrival-filter (proc string)
-  "IMAP process filter."
-  ;; Sometimes, we are called even though the process has died.
-  ;; Better abstain from doing stuff in that case.
-  (when (buffer-name (process-buffer proc))
-    (with-current-buffer (process-buffer proc)
-      (goto-char (point-max))
-      (insert string)
-      (and imap-log
-	   (with-current-buffer (get-buffer-create imap-log-buffer)
-	     (imap-disable-multibyte)
-	     (buffer-disable-undo)
-	     (goto-char (point-max))
-	     (insert string)))
-      (let (end)
-	(goto-char (point-min))
-	(while (setq end (imap-find-next-line))
-	  (save-restriction
-	    (narrow-to-region (point-min) end)
-	    (delete-backward-char (length imap-server-eol))
-	    (goto-char (point-min))
-	    (unwind-protect
-		(cond ((eq imap-state 'initial)
-		       (imap-parse-greeting))
-		      ((or (eq imap-state 'auth)
-			   (eq imap-state 'nonauth)
-			   (eq imap-state 'selected)
-			   (eq imap-state 'examine))
-		       (imap-parse-response))
-		      (t
-		       (message "Unknown state %s in arrival filter"
-				imap-state)))
-	      (delete-region (point-min) (point-max)))))))))
-
-
-;; Imap parser.
-
-(defsubst imap-forward ()
-  (or (eobp) (forward-char)))
-
-;;   number          = 1*DIGIT
-;;                       ; Unsigned 32-bit integer
-;;                       ; (0 <= n < 4,294,967,296)
-
-(defsubst imap-parse-number ()
-  (when (looking-at "[0-9]+")
-    (prog1
-	(string-to-number (match-string 0))
-      (goto-char (match-end 0)))))
-
-;;   literal         = "{" number "}" CRLF *CHAR8
-;;                       ; Number represents the number of CHAR8s
-
-(defsubst imap-parse-literal ()
-  (when (looking-at "{\\([0-9]+\\)}\r\n")
-    (let ((pos (match-end 0))
-	  (len (string-to-number (match-string 1))))
-      (if (< (point-max) (+ pos len))
-	  nil
-	(goto-char (+ pos len))
-	(buffer-substring pos (+ pos len))))))
-
-;;   string          = quoted / literal
-;;
-;;   quoted          = DQUOTE *QUOTED-CHAR DQUOTE
-;;
-;;   QUOTED-CHAR     = <any TEXT-CHAR except quoted-specials> /
-;;                     "\" quoted-specials
-;;
-;;   quoted-specials = DQUOTE / "\"
-;;
-;;   TEXT-CHAR       = <any CHAR except CR and LF>
-
-(defsubst imap-parse-string ()
-  (cond ((eq (char-after) ?\")
-	 (forward-char 1)
-	 (let ((p (point)) (name ""))
-	   (skip-chars-forward "^\"\\\\")
-	   (setq name (buffer-substring p (point)))
-	   (while (eq (char-after) ?\\)
-	     (setq p (1+ (point)))
-	     (forward-char 2)
-	     (skip-chars-forward "^\"\\\\")
-	     (setq name (concat name (buffer-substring p (point)))))
-	   (forward-char 1)
-	   name))
-	((eq (char-after) ?{)
-	 (imap-parse-literal))))
-
-;;   nil             = "NIL"
-
-(defsubst imap-parse-nil ()
-  (if (looking-at "NIL")
-      (goto-char (match-end 0))))
-
-;;   nstring         = string / nil
-
-(defsubst imap-parse-nstring ()
-  (or (imap-parse-string)
-      (and (imap-parse-nil)
-	   nil)))
-
-;;   astring         = atom / string
-;;
-;;   atom            = 1*ATOM-CHAR
-;;
-;;   ATOM-CHAR       = <any CHAR except atom-specials>
-;;
-;;   atom-specials   = "(" / ")" / "{" / SP / CTL / list-wildcards /
-;;                     quoted-specials
-;;
-;;   list-wildcards  = "%" / "*"
-;;
-;;   quoted-specials = DQUOTE / "\"
-
-(defsubst imap-parse-astring ()
-  (or (imap-parse-string)
-      (buffer-substring (point)
-			(if (re-search-forward "[(){ \r\n%*\"\\]" nil t)
-			    (goto-char (1- (match-end 0)))
-			  (end-of-line)
-			  (point)))))
-
-;;   address         = "(" addr-name SP addr-adl SP addr-mailbox SP
-;;                      addr-host ")"
-;;
-;;   addr-adl        = nstring
-;;                       ; Holds route from [RFC-822] route-addr if
-;;                       ; non-nil
-;;
-;;   addr-host       = nstring
-;;                       ; nil indicates [RFC-822] group syntax.
-;;                       ; Otherwise, holds [RFC-822] domain name
-;;
-;;   addr-mailbox    = nstring
-;;                       ; nil indicates end of [RFC-822] group; if
-;;                       ; non-nil and addr-host is nil, holds
-;;                       ; [RFC-822] group name.
-;;                       ; Otherwise, holds [RFC-822] local-part
-;;                       ; after removing [RFC-822] quoting
-;;
-;;   addr-name       = nstring
-;;                       ; If non-nil, holds phrase from [RFC-822]
-;;                       ; mailbox after removing [RFC-822] quoting
-;;
-
-(defsubst imap-parse-address ()
-  (let (address)
-    (when (eq (char-after) ?\()
-      (imap-forward)
-      (setq address (vector (prog1 (imap-parse-nstring)
-			      (imap-forward))
-			    (prog1 (imap-parse-nstring)
-			      (imap-forward))
-			    (prog1 (imap-parse-nstring)
-			      (imap-forward))
-			    (imap-parse-nstring)))
-      (when (eq (char-after) ?\))
-	(imap-forward)
-	address))))
-
-;;   address-list    = "(" 1*address ")" / nil
-;;
-;;   nil             = "NIL"
-
-(defsubst imap-parse-address-list ()
-  (if (eq (char-after) ?\()
-      (let (address addresses)
-	(imap-forward)
-	(while (and (not (eq (char-after) ?\)))
-		    ;; next line for MS Exchange bug
-		    (progn (and (eq (char-after) ? ) (imap-forward)) t)
-		    (setq address (imap-parse-address)))
-	  (setq addresses (cons address addresses)))
-	(when (eq (char-after) ?\))
-	  (imap-forward)
-	  (nreverse addresses)))
-    ;; With assert, the code might not be eval'd.
-    ;; (assert (imap-parse-nil) t "In imap-parse-address-list")
-    (imap-parse-nil)))
-
-;;   mailbox         = "INBOX" / astring
-;;                       ; INBOX is case-insensitive.  All case variants of
-;;                       ; INBOX (e.g. "iNbOx") MUST be interpreted as INBOX
-;;                       ; not as an astring.  An astring which consists of
-;;                       ; the case-insensitive sequence "I" "N" "B" "O" "X"
-;;                       ; is considered to be INBOX and not an astring.
-;;                       ;  Refer to section 5.1 for further
-;;                       ; semantic details of mailbox names.
-
-(defsubst imap-parse-mailbox ()
-  (let ((mailbox (imap-parse-astring)))
-    (if (string-equal "INBOX" (upcase mailbox))
-	"INBOX"
-      mailbox)))
-
-;;   greeting        = "*" SP (resp-cond-auth / resp-cond-bye) CRLF
-;;
-;;   resp-cond-auth  = ("OK" / "PREAUTH") SP resp-text
-;;                       ; Authentication condition
-;;
-;;   resp-cond-bye   = "BYE" SP resp-text
-
-(defun imap-parse-greeting ()
-  "Parse a IMAP greeting."
-  (cond ((looking-at "\\* OK ")
-	 (setq imap-state 'nonauth))
-	((looking-at "\\* PREAUTH ")
-	 (setq imap-state 'auth))
-	((looking-at "\\* BYE ")
-	 (setq imap-state 'closed))))
-
-;;   response        = *(continue-req / response-data) response-done
-;;
-;;   continue-req    = "+" SP (resp-text / base64) CRLF
-;;
-;;   response-data   = "*" SP (resp-cond-state / resp-cond-bye /
-;;                     mailbox-data / message-data / capability-data) CRLF
-;;
-;;   response-done   = response-tagged / response-fatal
-;;
-;;   response-fatal  = "*" SP resp-cond-bye CRLF
-;;                       ; Server closes connection immediately
-;;
-;;   response-tagged = tag SP resp-cond-state CRLF
-;;
-;;   resp-cond-state = ("OK" / "NO" / "BAD") SP resp-text
-;;                       ; Status condition
-;;
-;;   resp-cond-bye   = "BYE" SP resp-text
-;;
-;;   mailbox-data    =  "FLAGS" SP flag-list /
-;;		        "LIST" SP mailbox-list /
-;;                      "LSUB" SP mailbox-list /
-;;		        "SEARCH" *(SP nz-number) /
-;;                      "STATUS" SP mailbox SP "("
-;;	                      [status-att SP number *(SP status-att SP number)] ")" /
-;;                      number SP "EXISTS" /
-;;		        number SP "RECENT"
-;;
-;;   message-data    = nz-number SP ("EXPUNGE" / ("FETCH" SP msg-att))
-;;
-;;   capability-data = "CAPABILITY" *(SP capability) SP "IMAP4rev1"
-;;                     *(SP capability)
-;;                       ; IMAP4rev1 servers which offer RFC 1730
-;;                       ; compatibility MUST list "IMAP4" as the first
-;;                       ; capability.
-
-(defun imap-parse-response ()
-  "Parse a IMAP command response."
-  (let (token)
-    (case (setq token (read (current-buffer)))
-      (+ (setq imap-continuation
-	       (or (buffer-substring (min (point-max) (1+ (point)))
-				     (point-max))
-		   t)))
-      (* (case (prog1 (setq token (read (current-buffer)))
-		 (imap-forward))
-	   (OK         (imap-parse-resp-text))
-	   (NO         (imap-parse-resp-text))
-	   (BAD        (imap-parse-resp-text))
-	   (BYE        (imap-parse-resp-text))
-	   (FLAGS      (imap-mailbox-put 'flags (imap-parse-flag-list)))
-	   (LIST       (imap-parse-data-list 'list))
-	   (LSUB       (imap-parse-data-list 'lsub))
-	   (SEARCH     (imap-mailbox-put
-			'search
-			(read (concat "(" (buffer-substring (point) (point-max)) ")"))))
-	   (STATUS     (imap-parse-status))
-	   (CAPABILITY (setq imap-capability
-			       (read (concat "(" (upcase (buffer-substring
-							  (point) (point-max)))
-					     ")"))))
-	   (ID	       (setq imap-id (read (buffer-substring (point)
-							     (point-max)))))
-	   (ACL        (imap-parse-acl))
-	   (t       (case (prog1 (read (current-buffer))
-			    (imap-forward))
-		      (EXISTS  (imap-mailbox-put 'exists token))
-		      (RECENT  (imap-mailbox-put 'recent token))
-		      (EXPUNGE t)
-		      (FETCH   (imap-parse-fetch token))
-		      (t       (message "Garbage: %s" (buffer-string)))))))
-      (t (let (status)
-	   (if (not (integerp token))
-	       (message "Garbage: %s" (buffer-string))
-	     (case (prog1 (setq status (read (current-buffer)))
-		     (imap-forward))
-	       (OK  (progn
-		      (setq imap-reached-tag (max imap-reached-tag token))
-		      (imap-parse-resp-text)))
-	       (NO  (progn
-		      (setq imap-reached-tag (max imap-reached-tag token))
-		      (save-excursion
-			(imap-parse-resp-text))
-		      (let (code text)
-			(when (eq (char-after) ?\[)
-			  (setq code (buffer-substring (point)
-						       (search-forward "]")))
-			  (imap-forward))
-			(setq text (buffer-substring (point) (point-max)))
-			(push (list token status code text)
-			      imap-failed-tags))))
-	       (BAD (progn
-		      (setq imap-reached-tag (max imap-reached-tag token))
-		      (save-excursion
-			(imap-parse-resp-text))
-		      (let (code text)
-			(when (eq (char-after) ?\[)
-			  (setq code (buffer-substring (point)
-						       (search-forward "]")))
-			  (imap-forward))
-			(setq text (buffer-substring (point) (point-max)))
-			(push (list token status code text) imap-failed-tags)
-			(error "Internal error, tag %s status %s code %s text %s"
-			       token status code text))))
-	       (t   (message "Garbage: %s" (buffer-string))))
-	     (when (assq token imap-callbacks)
-	       (funcall (cdr (assq token imap-callbacks)) token status)
-	       (setq imap-callbacks
-		     (imap-remassoc token imap-callbacks)))))))))
-
-;;   resp-text       = ["[" resp-text-code "]" SP] text
-;;
-;;   text            = 1*TEXT-CHAR
-;;
-;;   TEXT-CHAR       = <any CHAR except CR and LF>
-
-(defun imap-parse-resp-text ()
-  (imap-parse-resp-text-code))
-
-;;   resp-text-code  = "ALERT" /
-;;                     "BADCHARSET [SP "(" astring *(SP astring) ")" ] /
-;;                     "NEWNAME" SP string SP string /
-;;		       "PARSE" /
-;;                     "PERMANENTFLAGS" SP "("
-;;                               [flag-perm *(SP flag-perm)] ")" /
-;;                     "READ-ONLY" /
-;;		       "READ-WRITE" /
-;;		       "TRYCREATE" /
-;;                     "UIDNEXT" SP nz-number /
-;;		       "UIDVALIDITY" SP nz-number /
-;;                     "UNSEEN" SP nz-number /
-;;                     resp-text-atom [SP 1*<any TEXT-CHAR except "]">]
-;;
-;;   resp_code_apnd  = "APPENDUID" SPACE nz_number SPACE uniqueid
-;;
-;;   resp_code_copy  = "COPYUID" SPACE nz_number SPACE set SPACE set
-;;
-;;   set             = sequence-num / (sequence-num ":" sequence-num) /
-;;                        (set "," set)
-;;                          ; Identifies a set of messages.  For message
-;;                          ; sequence numbers, these are consecutive
-;;                          ; numbers from 1 to the number of messages in
-;;                          ; the mailbox
-;;                          ; Comma delimits individual numbers, colon
-;;                          ; delimits between two numbers inclusive.
-;;                          ; Example: 2,4:7,9,12:* is 2,4,5,6,7,9,12,13,
-;;                          ; 14,15 for a mailbox with 15 messages.
-;;
-;;   sequence-num    = nz-number / "*"
-;;                          ; * is the largest number in use.  For message
-;;                          ; sequence numbers, it is the number of messages
-;;                          ; in the mailbox.  For unique identifiers, it is
-;;                          ; the unique identifier of the last message in
-;;                          ; the mailbox.
-;;
-;;   flag-perm       = flag / "\*"
-;;
-;;   flag            = "\Answered" / "\Flagged" / "\Deleted" /
-;;                     "\Seen" / "\Draft" / flag-keyword / flag-extension
-;;                       ; Does not include "\Recent"
-;;
-;;   flag-extension  = "\" atom
-;;                       ; Future expansion.  Client implementations
-;;                       ; MUST accept flag-extension flags.  Server
-;;                       ; implementations MUST NOT generate
-;;                       ; flag-extension flags except as defined by
-;;                       ; future standard or standards-track
-;;                       ; revisions of this specification.
-;;
-;;   flag-keyword    = atom
-;;
-;;   resp-text-atom  = 1*<any ATOM-CHAR except "]">
-
-(defun imap-parse-resp-text-code ()
-  ;; xxx next line for stalker communigate pro 3.3.1 bug
-  (when (looking-at " \\[")
-    (imap-forward))
-  (when (eq (char-after) ?\[)
-    (imap-forward)
-    (cond ((search-forward "PERMANENTFLAGS " nil t)
-	   (imap-mailbox-put 'permanentflags (imap-parse-flag-list)))
-	  ((search-forward "UIDNEXT \\([0-9]+\\)" nil t)
-	   (imap-mailbox-put 'uidnext (match-string 1)))
-	  ((search-forward "UNSEEN " nil t)
-	   (imap-mailbox-put 'first-unseen (read (current-buffer))))
-	  ((looking-at "UIDVALIDITY \\([0-9]+\\)")
-	   (imap-mailbox-put 'uidvalidity (match-string 1)))
-	  ((search-forward "READ-ONLY" nil t)
-	   (imap-mailbox-put 'read-only t))
-	  ((search-forward "NEWNAME " nil t)
-	   (let (oldname newname)
-	     (setq oldname (imap-parse-string))
-	     (imap-forward)
-	     (setq newname (imap-parse-string))
-	     (imap-mailbox-put 'newname newname oldname)))
-	  ((search-forward "TRYCREATE" nil t)
-	   (imap-mailbox-put 'trycreate t imap-current-target-mailbox))
-	  ((looking-at "APPENDUID \\([0-9]+\\) \\([0-9]+\\)")
-	   (imap-mailbox-put 'appenduid
-			     (list (match-string 1)
-				   (string-to-number (match-string 2)))
-			     imap-current-target-mailbox))
-	  ((looking-at "COPYUID \\([0-9]+\\) \\([0-9,:]+\\) \\([0-9,:]+\\)")
-	   (imap-mailbox-put 'copyuid (list (match-string 1)
-					    (match-string 2)
-					    (match-string 3))
-			     imap-current-target-mailbox))
-	  ((search-forward "ALERT] " nil t)
-	   (message "Imap server %s information: %s" imap-server
-		    (buffer-substring (point) (point-max)))))))
-
-;;   mailbox-list    = "(" [mbx-list-flags] ")" SP
-;;                      (DQUOTE QUOTED-CHAR DQUOTE / nil) SP mailbox
-;;
-;;   mbx-list-flags  = *(mbx-list-oflag SP) mbx-list-sflag
-;;                     *(SP mbx-list-oflag) /
-;;                     mbx-list-oflag *(SP mbx-list-oflag)
-;;
-;;   mbx-list-oflag  = "\Noinferiors" / flag-extension
-;;                       ; Other flags; multiple possible per LIST response
-;;
-;;   mbx-list-sflag  = "\Noselect" / "\Marked" / "\Unmarked"
-;;                       ; Selectability flags; only one per LIST response
-;;
-;;   QUOTED-CHAR     = <any TEXT-CHAR except quoted-specials> /
-;;                     "\" quoted-specials
-;;
-;;   quoted-specials = DQUOTE / "\"
-
-(defun imap-parse-data-list (type)
-  (let (flags delimiter mailbox)
-    (setq flags (imap-parse-flag-list))
-    (when (looking-at " NIL\\| \"\\\\?\\(.\\)\"")
-      (setq delimiter (match-string 1))
-      (goto-char (1+ (match-end 0)))
-      (when (setq mailbox (imap-parse-mailbox))
-	(imap-mailbox-put type t mailbox)
-	(imap-mailbox-put 'list-flags flags mailbox)
-	(imap-mailbox-put 'delimiter delimiter mailbox)))))
-
-;;  msg_att         ::= "(" 1#("ENVELOPE" SPACE envelope /
-;;                      "FLAGS" SPACE "(" #(flag / "\Recent") ")" /
-;;                      "INTERNALDATE" SPACE date_time /
-;;                      "RFC822" [".HEADER" / ".TEXT"] SPACE nstring /
-;;                      "RFC822.SIZE" SPACE number /
-;;                      "BODY" ["STRUCTURE"] SPACE body /
-;;                      "BODY" section ["<" number ">"] SPACE nstring /
-;;                      "UID" SPACE uniqueid) ")"
-;;
-;;  date_time       ::= <"> date_day_fixed "-" date_month "-" date_year
-;;                      SPACE time SPACE zone <">
-;;
-;;  section         ::= "[" [section_text / (nz_number *["." nz_number]
-;;                      ["." (section_text / "MIME")])] "]"
-;;
-;;  section_text    ::= "HEADER" / "HEADER.FIELDS" [".NOT"]
-;;                      SPACE header_list / "TEXT"
-;;
-;;  header_fld_name ::= astring
-;;
-;;  header_list     ::= "(" 1#header_fld_name ")"
-
-(defsubst imap-parse-header-list ()
-  (when (eq (char-after) ?\()
-    (let (strlist)
-      (while (not (eq (char-after) ?\)))
-	(imap-forward)
-	(push (imap-parse-astring) strlist))
-      (imap-forward)
-      (nreverse strlist))))
-
-(defsubst imap-parse-fetch-body-section ()
-  (let ((section
-	 (buffer-substring (point) (1- (re-search-forward "[] ]" nil t)))))
-    (if (eq (char-before) ? )
-	(prog1
-	    (mapconcat 'identity (cons section (imap-parse-header-list)) " ")
-	  (search-forward "]" nil t))
-      section)))
-
-(defun imap-parse-fetch (response)
-  (when (eq (char-after) ?\()
-    (let (uid flags envelope internaldate rfc822 rfc822header rfc822text
-	      rfc822size body bodydetail bodystructure flags-empty)
-      (while (not (eq (char-after) ?\)))
-	(imap-forward)
-	(let ((token (read (current-buffer))))
-	  (imap-forward)
-	  (cond ((eq token 'UID)
-		 (setq uid (condition-case ()
-			       (read (current-buffer))
-			     (error))))
-		((eq token 'FLAGS)
-		 (setq flags (imap-parse-flag-list))
-		 (if (not flags)
-		     (setq flags-empty 't)))
-		((eq token 'ENVELOPE)
-		 (setq envelope (imap-parse-envelope)))
-		((eq token 'INTERNALDATE)
-		 (setq internaldate (imap-parse-string)))
-		((eq token 'RFC822)
-		 (setq rfc822 (imap-parse-nstring)))
-		((eq token 'RFC822.HEADER)
-		 (setq rfc822header (imap-parse-nstring)))
-		((eq token 'RFC822.TEXT)
-		 (setq rfc822text (imap-parse-nstring)))
-		((eq token 'RFC822.SIZE)
-		 (setq rfc822size (read (current-buffer))))
-		((eq token 'BODY)
-		 (if (eq (char-before) ?\[)
-		     (push (list
-			    (upcase (imap-parse-fetch-body-section))
-			    (and (eq (char-after) ?<)
-				 (buffer-substring (1+ (point))
-						   (search-forward ">" nil t)))
-			    (progn (imap-forward)
-				   (imap-parse-nstring)))
-			   bodydetail)
-		   (setq body (imap-parse-body))))
-		((eq token 'BODYSTRUCTURE)
-		 (setq bodystructure (imap-parse-body))))))
-      (when uid
-	(setq imap-current-message uid)
-	(imap-message-put uid 'UID uid)
-	(and (or flags flags-empty) (imap-message-put uid 'FLAGS flags))
-	(and envelope (imap-message-put uid 'ENVELOPE envelope))
-	(and internaldate (imap-message-put uid 'INTERNALDATE internaldate))
-	(and rfc822 (imap-message-put uid 'RFC822 rfc822))
-	(and rfc822header (imap-message-put uid 'RFC822.HEADER rfc822header))
-	(and rfc822text (imap-message-put uid 'RFC822.TEXT rfc822text))
-	(and rfc822size (imap-message-put uid 'RFC822.SIZE rfc822size))
-	(and body (imap-message-put uid 'BODY body))
-	(and bodydetail (imap-message-put uid 'BODYDETAIL bodydetail))
-	(and bodystructure (imap-message-put uid 'BODYSTRUCTURE bodystructure))
-	(run-hooks 'imap-fetch-data-hook)))))
-
-;;   mailbox-data    =  ...
-;;                      "STATUS" SP mailbox SP "("
-;;	                      [status-att SP number
-;;                            *(SP status-att SP number)] ")"
-;;                      ...
-;;
-;;   status-att      = "MESSAGES" / "RECENT" / "UIDNEXT" / "UIDVALIDITY" /
-;;                     "UNSEEN"
-
-(defun imap-parse-status ()
-  (let ((mailbox (imap-parse-mailbox)))
-    (if (eq (char-after) ? )
-	(forward-char))
-    (when (and mailbox (eq (char-after) ?\())
-      (while (and (not (eq (char-after) ?\)))
-		  (or (forward-char) t)
-		  (looking-at "\\([A-Za-z]+\\) "))
-	(let ((token (match-string 1)))
-	  (goto-char (match-end 0))
-	  (cond ((string= token "MESSAGES")
-		 (imap-mailbox-put 'messages (read (current-buffer)) mailbox))
-		((string= token "RECENT")
-		 (imap-mailbox-put 'recent (read (current-buffer)) mailbox))
-		((string= token "UIDNEXT")
-		 (and (looking-at "[0-9]+")
-		      (imap-mailbox-put 'uidnext (match-string 0) mailbox)
-		      (goto-char (match-end 0))))
-		((string= token "UIDVALIDITY")
-		 (and (looking-at "[0-9]+")
-		      (imap-mailbox-put 'uidvalidity (match-string 0) mailbox)
-		      (goto-char (match-end 0))))
-		((string= token "UNSEEN")
-		 (imap-mailbox-put 'unseen (read (current-buffer)) mailbox))
-		(t
-		 (message "Unknown status data %s in mailbox %s ignored"
-			  token mailbox)
-		 (read (current-buffer)))))))))
-
-;;   acl_data        ::= "ACL" SPACE mailbox *(SPACE identifier SPACE
-;;                        rights)
-;;
-;;   identifier      ::= astring
-;;
-;;   rights          ::= astring
-
-(defun imap-parse-acl ()
-  (let ((mailbox (imap-parse-mailbox))
-	identifier rights acl)
-    (while (eq (char-after) ?\ )
-      (imap-forward)
-      (setq identifier (imap-parse-astring))
-      (imap-forward)
-      (setq rights (imap-parse-astring))
-      (setq acl (append acl (list (cons identifier rights)))))
-    (imap-mailbox-put 'acl acl mailbox)))
-
-;;   flag-list       = "(" [flag *(SP flag)] ")"
-;;
-;;   flag            = "\Answered" / "\Flagged" / "\Deleted" /
-;;                     "\Seen" / "\Draft" / flag-keyword / flag-extension
-;;                       ; Does not include "\Recent"
-;;
-;;   flag-keyword    = atom
-;;
-;;   flag-extension  = "\" atom
-;;                       ; Future expansion.  Client implementations
-;;                       ; MUST accept flag-extension flags.  Server
-;;                       ; implementations MUST NOT generate
-;;                       ; flag-extension flags except as defined by
-;;                       ; future standard or standards-track
-;;                       ; revisions of this specification.
-
-(defun imap-parse-flag-list ()
-  (let (flag-list start)
-    (assert (eq (char-after) ?\() nil "In imap-parse-flag-list")
-    (while (and (not (eq (char-after) ?\)))
-		(setq start (progn
-			      (imap-forward)
-			      ;; next line for Courier IMAP bug.
-			      (skip-chars-forward " ")
-			      (point)))
-		(> (skip-chars-forward "^ )" (point-at-eol)) 0))
-      (push (buffer-substring start (point)) flag-list))
-    (assert (eq (char-after) ?\)) nil "In imap-parse-flag-list")
-    (imap-forward)
-    (nreverse flag-list)))
-
-;;   envelope        = "(" env-date SP env-subject SP env-from SP env-sender SP
-;;                     env-reply-to SP env-to SP env-cc SP env-bcc SP
-;;                     env-in-reply-to SP env-message-id ")"
-;;
-;;   env-bcc         = "(" 1*address ")" / nil
-;;
-;;   env-cc          = "(" 1*address ")" / nil
-;;
-;;   env-date        = nstring
-;;
-;;   env-from        = "(" 1*address ")" / nil
-;;
-;;   env-in-reply-to = nstring
-;;
-;;   env-message-id  = nstring
-;;
-;;   env-reply-to    = "(" 1*address ")" / nil
-;;
-;;   env-sender      = "(" 1*address ")" / nil
-;;
-;;   env-subject     = nstring
-;;
-;;   env-to          = "(" 1*address ")" / nil
-
-(defun imap-parse-envelope ()
-  (when (eq (char-after) ?\()
-    (imap-forward)
-    (vector (prog1 (imap-parse-nstring)	;; date
-	      (imap-forward))
-	    (prog1 (imap-parse-nstring)	;; subject
-	      (imap-forward))
-	    (prog1 (imap-parse-address-list) ;; from
-	      (imap-forward))
-	    (prog1 (imap-parse-address-list) ;; sender
-	      (imap-forward))
-	    (prog1 (imap-parse-address-list) ;; reply-to
-	      (imap-forward))
-	    (prog1 (imap-parse-address-list) ;; to
-	      (imap-forward))
-	    (prog1 (imap-parse-address-list) ;; cc
-	      (imap-forward))
-	    (prog1 (imap-parse-address-list) ;; bcc
-	      (imap-forward))
-	    (prog1 (imap-parse-nstring)	;; in-reply-to
-	      (imap-forward))
-	    (prog1 (imap-parse-nstring)	;; message-id
-	      (imap-forward)))))
-
-;;   body-fld-param  = "(" string SP string *(SP string SP string) ")" / nil
-
-(defsubst imap-parse-string-list ()
-  (cond ((eq (char-after) ?\() ;; body-fld-param
-	 (let (strlist str)
-	   (imap-forward)
-	   (while (setq str (imap-parse-string))
-	     (push str strlist)
-	     ;; buggy stalker communigate pro 3.0 doesn't print SPC
-	     ;; between body-fld-param's sometimes
-	     (or (eq (char-after) ?\")
-		 (imap-forward)))
-	   (nreverse strlist)))
-	((imap-parse-nil)
-	 nil)))
-
-;;   body-extension  = nstring / number /
-;;                      "(" body-extension *(SP body-extension) ")"
-;;                       ; Future expansion.  Client implementations
-;;                       ; MUST accept body-extension fields.  Server
-;;                       ; implementations MUST NOT generate
-;;                       ; body-extension fields except as defined by
-;;                       ; future standard or standards-track
-;;                       ; revisions of this specification.
-
-(defun imap-parse-body-extension ()
-  (if (eq (char-after) ?\()
-      (let (b-e)
-	(imap-forward)
-	(push (imap-parse-body-extension) b-e)
-	(while (eq (char-after) ?\ )
-	  (imap-forward)
-	  (push (imap-parse-body-extension) b-e))
-	(assert (eq (char-after) ?\)) nil "In imap-parse-body-extension")
-	(imap-forward)
-	(nreverse b-e))
-    (or (imap-parse-number)
-	(imap-parse-nstring))))
-
-;;   body-ext-1part  = body-fld-md5 [SP body-fld-dsp [SP body-fld-lang
-;;                     *(SP body-extension)]]
-;;                       ; MUST NOT be returned on non-extensible
-;;                       ; "BODY" fetch
-;;
-;;   body-ext-mpart  = body-fld-param [SP body-fld-dsp [SP body-fld-lang
-;;                     *(SP body-extension)]]
-;;                       ; MUST NOT be returned on non-extensible
-;;                       ; "BODY" fetch
-
-(defsubst imap-parse-body-ext ()
-  (let (ext)
-    (when (eq (char-after) ?\ )	;; body-fld-dsp
-      (imap-forward)
-      (let (dsp)
-	(if (eq (char-after) ?\()
-	    (progn
-	      (imap-forward)
-	      (push (imap-parse-string) dsp)
-	      (imap-forward)
-	      (push (imap-parse-string-list) dsp)
-	      (imap-forward))
-	  ;; With assert, the code might not be eval'd.
-	  ;; (assert (imap-parse-nil) t "In imap-parse-body-ext")
-	  (imap-parse-nil))
-	(push (nreverse dsp) ext))
-      (when (eq (char-after) ?\ ) ;; body-fld-lang
-	(imap-forward)
-	(if (eq (char-after) ?\()
-	    (push (imap-parse-string-list) ext)
-	  (push (imap-parse-nstring) ext))
-	(while (eq (char-after) ?\ ) ;; body-extension
-	  (imap-forward)
-	  (setq ext (append (imap-parse-body-extension) ext)))))
-    ext))
-
-;;   body            = "(" body-type-1part / body-type-mpart ")"
-;;
-;;   body-ext-1part  = body-fld-md5 [SP body-fld-dsp [SP body-fld-lang
-;;                     *(SP body-extension)]]
-;;                       ; MUST NOT be returned on non-extensible
-;;                       ; "BODY" fetch
-;;
-;;   body-ext-mpart  = body-fld-param [SP body-fld-dsp [SP body-fld-lang
-;;                     *(SP body-extension)]]
-;;                       ; MUST NOT be returned on non-extensible
-;;                       ; "BODY" fetch
-;;
-;;   body-fields     = body-fld-param SP body-fld-id SP body-fld-desc SP
-;;                     body-fld-enc SP body-fld-octets
-;;
-;;   body-fld-desc   = nstring
-;;
-;;   body-fld-dsp    = "(" string SP body-fld-param ")" / nil
-;;
-;;   body-fld-enc    = (DQUOTE ("7BIT" / "8BIT" / "BINARY" / "BASE64"/
-;;                     "QUOTED-PRINTABLE") DQUOTE) / string
-;;
-;;   body-fld-id     = nstring
-;;
-;;   body-fld-lang   = nstring / "(" string *(SP string) ")"
-;;
-;;   body-fld-lines  = number
-;;
-;;   body-fld-md5    = nstring
-;;
-;;   body-fld-octets = number
-;;
-;;   body-fld-param  = "(" string SP string *(SP string SP string) ")" / nil
-;;
-;;   body-type-1part = (body-type-basic / body-type-msg / body-type-text)
-;;                     [SP body-ext-1part]
-;;
-;;   body-type-basic = media-basic SP body-fields
-;;                       ; MESSAGE subtype MUST NOT be "RFC822"
-;;
-;;   body-type-msg   = media-message SP body-fields SP envelope
-;;                     SP body SP body-fld-lines
-;;
-;;   body-type-text  = media-text SP body-fields SP body-fld-lines
-;;
-;;   body-type-mpart = 1*body SP media-subtype
-;;                     [SP body-ext-mpart]
-;;
-;;   media-basic     = ((DQUOTE ("APPLICATION" / "AUDIO" / "IMAGE" /
-;;                     "MESSAGE" / "VIDEO") DQUOTE) / string) SP media-subtype
-;;                       ; Defined in [MIME-IMT]
-;;
-;;   media-message   = DQUOTE "MESSAGE" DQUOTE SP DQUOTE "RFC822" DQUOTE
-;;                      ; Defined in [MIME-IMT]
-;;
-;;   media-subtype   = string
-;;                       ; Defined in [MIME-IMT]
-;;
-;;   media-text      = DQUOTE "TEXT" DQUOTE SP media-subtype
-;;                       ; Defined in [MIME-IMT]
-
-(defun imap-parse-body ()
-  (let (body)
-    (when (eq (char-after) ?\()
-      (imap-forward)
-      (if (eq (char-after) ?\()
-	  (let (subbody)
-	    (while (and (eq (char-after) ?\()
-			(setq subbody (imap-parse-body)))
-	     ;; buggy stalker communigate pro 3.0 insert a SPC between
-	      ;; parts in multiparts
-	      (when (and (eq (char-after) ?\ )
-			 (eq (char-after (1+ (point))) ?\())
-		(imap-forward))
-	      (push subbody body))
-	    (imap-forward)
-	    (push (imap-parse-string) body) ;; media-subtype
-	    (when (eq (char-after) ?\ )	;; body-ext-mpart:
-	      (imap-forward)
-	      (if (eq (char-after) ?\()	;; body-fld-param
-		  (push (imap-parse-string-list) body)
-		(push (and (imap-parse-nil) nil) body))
-	      (setq body
-		    (append (imap-parse-body-ext) body))) ;; body-ext-...
-	    (assert (eq (char-after) ?\)) nil "In imap-parse-body")
-	    (imap-forward)
-	    (nreverse body))
-
-	(push (imap-parse-string) body)	;; media-type
-	(imap-forward)
-	(push (imap-parse-string) body)	;; media-subtype
-	(imap-forward)
-	;; next line for Sun SIMS bug
-	(and (eq (char-after) ? ) (imap-forward))
-	(if (eq (char-after) ?\() ;; body-fld-param
-	    (push (imap-parse-string-list) body)
-	  (push (and (imap-parse-nil) nil) body))
-	(imap-forward)
-	(push (imap-parse-nstring) body) ;; body-fld-id
-	(imap-forward)
-	(push (imap-parse-nstring) body) ;; body-fld-desc
-	(imap-forward)
-	;; next `or' for Sun SIMS bug, it regard body-fld-enc as a
-	;; nstring and return nil instead of defaulting back to 7BIT
-	;; as the standard says.
-	(push (or (imap-parse-nstring) "7BIT") body) ;; body-fld-enc
-	(imap-forward)
-	(push (imap-parse-number) body)	;; body-fld-octets
-
-   ;; ok, we're done parsing the required parts, what comes now is one
-	;; of three things:
-	;;
-	;; envelope       (then we're parsing body-type-msg)
-	;; body-fld-lines (then we're parsing body-type-text)
-	;; body-ext-1part (then we're parsing body-type-basic)
-	;;
-  ;; the problem is that the two first are in turn optionally followed
-;; by the third.  So we parse the first two here (if there are any)...
-
-	(when (eq (char-after) ?\ )
-	  (imap-forward)
-	  (let (lines)
-	    (cond ((eq (char-after) ?\() ;; body-type-msg:
-		   (push (imap-parse-envelope) body) ;; envelope
-		   (imap-forward)
-		   (push (imap-parse-body) body) ;; body
-		   ;; buggy stalker communigate pro 3.0 doesn't print
-		   ;; number of lines in message/rfc822 attachment
-		   (if (eq (char-after) ?\))
-		       (push 0 body)
-		     (imap-forward)
-		     (push (imap-parse-number) body))) ;; body-fld-lines
-		  ((setq lines (imap-parse-number)) ;; body-type-text:
-		   (push lines body)) ;; body-fld-lines
-		  (t
-		   (backward-char))))) ;; no match...
-
-	;; ...and then parse the third one here...
-
-	(when (eq (char-after) ?\ ) ;; body-ext-1part:
-	  (imap-forward)
-	  (push (imap-parse-nstring) body) ;; body-fld-md5
-	  (setq body (append (imap-parse-body-ext) body))) ;; body-ext-1part..
-
-	(assert (eq (char-after) ?\)) nil "In imap-parse-body 2")
-	(imap-forward)
-	(nreverse body)))))
-
-(when imap-debug			; (untrace-all)
-  (require 'trace)
-  (buffer-disable-undo (get-buffer-create imap-debug-buffer))
-  (mapc (lambda (f) (trace-function-background f imap-debug-buffer))
-	'(
-	  imap-utf7-encode
-	  imap-utf7-decode
-	  imap-error-text
-	  imap-kerberos4s-p
-	  imap-kerberos4-open
-	  imap-ssl-p
-	  imap-ssl-open
-	  imap-network-p
-	  imap-network-open
-	  imap-interactive-login
-	  imap-kerberos4a-p
-	  imap-kerberos4-auth
-	  imap-cram-md5-p
-	  imap-cram-md5-auth
-	  imap-login-p
-	  imap-login-auth
-	  imap-anonymous-p
-	  imap-anonymous-auth
-	  imap-open-1
-	  imap-open
-	  imap-opened
-	  imap-authenticate
-	  imap-close
-	  imap-capability
-	  imap-namespace
-	  imap-send-command-wait
-	  imap-mailbox-put
-	  imap-mailbox-get
-	  imap-mailbox-map-1
-	  imap-mailbox-map
-	  imap-current-mailbox
-	  imap-current-mailbox-p-1
-	  imap-current-mailbox-p
-	  imap-mailbox-select-1
-	  imap-mailbox-select
-	  imap-mailbox-examine-1
-	  imap-mailbox-examine
-	  imap-mailbox-unselect
-	  imap-mailbox-expunge
-	  imap-mailbox-close
-	  imap-mailbox-create-1
-	  imap-mailbox-create
-	  imap-mailbox-delete
-	  imap-mailbox-rename
-	  imap-mailbox-lsub
-	  imap-mailbox-list
-	  imap-mailbox-subscribe
-	  imap-mailbox-unsubscribe
-	  imap-mailbox-status
-	  imap-mailbox-acl-get
-	  imap-mailbox-acl-set
-	  imap-mailbox-acl-delete
-	  imap-current-message
-	  imap-list-to-message-set
-	  imap-fetch-asynch
-	  imap-fetch
-	  imap-message-put
-	  imap-message-get
-	  imap-message-map
-	  imap-search
-	  imap-message-flag-permanent-p
-	  imap-message-flags-set
-	  imap-message-flags-del
-	  imap-message-flags-add
-	  imap-message-copyuid-1
-	  imap-message-copyuid
-	  imap-message-copy
-	  imap-message-appenduid-1
-	  imap-message-appenduid
-	  imap-message-append
-	  imap-body-lines
-	  imap-envelope-from
-	  imap-send-command-1
-	  imap-send-command
-	  imap-wait-for-tag
-	  imap-sentinel
-	  imap-find-next-line
-	  imap-arrival-filter
-	  imap-parse-greeting
-	  imap-parse-response
-	  imap-parse-resp-text
-	  imap-parse-resp-text-code
-	  imap-parse-data-list
-	  imap-parse-fetch
-	  imap-parse-status
-	  imap-parse-acl
-	  imap-parse-flag-list
-	  imap-parse-envelope
-	  imap-parse-body-extension
-	  imap-parse-body
-	  )))
-
-(provide 'imap)
-
-;;; arch-tag: 27369ed6-33e4-482f-96f1-8bb906ba70f7
-;;; imap.el ends here
diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el
index abf32756498..39595b767ad 100644
--- a/lisp/gnus/mail-source.el
+++ b/lisp/gnus/mail-source.el
@@ -27,18 +27,20 @@
 
 ;;; Code:
 
+(require 'format-spec)
 (eval-when-compile
   (require 'cl)
-  (require 'imap)
-  (eval-when-compile (defvar display-time-mail-function)))
+  (require 'imap))
 (eval-and-compile
   (autoload 'pop3-movemail "pop3")
   (autoload 'pop3-get-message-count "pop3")
   (autoload 'nnheader-cancel-timer "nnheader"))
-(require 'format-spec)
 (require 'mm-util)
 (require 'message) ;; for `message-directory'
 
+(defvar display-time-mail-function)
+
+
 (defgroup mail-source nil
   "The mail-fetching library."
   :version "21.1"
@@ -56,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"
diff --git a/lisp/gnus/mailcap.el b/lisp/gnus/mailcap.el
index 6839a6472b7..063b2ec2f44 100644
--- a/lisp/gnus/mailcap.el
+++ b/lisp/gnus/mailcap.el
@@ -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 @@ If TEST is not given, it defaults to t."
       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 @@ entry) will be returned.  If it is a string, then the mailcap field
 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 @@ this type is returned."
 	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 @@ this type is returned."
 	(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 @@ If FORCE, re-parse even if already parsed."
 (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
diff --git a/lisp/gnus/md4.el b/lisp/gnus/md4.el
deleted file mode 100644
index aa9bc543203..00000000000
--- a/lisp/gnus/md4.el
+++ /dev/null
@@ -1,228 +0,0 @@
-;;; md4.el --- MD4 Message Digest Algorithm.
-
-;; Copyright (C) 2004 Free Software Foundation, Inc.
-;; Copyright (C) 2001 Taro Kawagishi
-;; Author: Taro Kawagishi <tarok@transpulse.org>
-;; Keywords: MD4
-;; Version: 1.00
-;; Created: February 2001
-
-;; This file is part of FLIM (Faithful Library about Internet Message).
-
-;; This program 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, or (at your option)
-;; any later version.
-;;
-;; This program 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 this program; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Code:
-
-;;;
-;;; MD4 hash calculation
-
-(defvar md4-buffer (make-vector 4 '(0 . 0))
-  "work buffer of four 32-bit integers")
-
-(defun md4 (in n)
-  "Returns the MD4 hash string of 16 bytes long for a string IN of N
-bytes long.  N is required to handle strings containing character 0."
-  (let (m
-	(b (cons 0 (* n 8)))
-	(i 0)
-	(buf (make-string 128 0)) c4)
-    ;; initial values
-    (aset md4-buffer 0 '(26437 . 8961))		;0x67452301
-    (aset md4-buffer 1 '(61389 . 43913))	;0xefcdab89
-    (aset md4-buffer 2 '(39098 . 56574))	;0x98badcfe
-    (aset md4-buffer 3 '(4146 . 21622))		;0x10325476
-
-    ;; process the string in 64 bits chunks
-    (while (> n 64)
-      (setq m (md4-copy64 (substring in 0 64)))
-      (md4-64 m)
-      (setq in (substring in 64))
-      (setq n (- n 64)))
-
-    ;; process the rest of the string (length is now n <= 64)
-    (setq i 0)
-    (while (< i n)
-      (aset buf i (aref in i))
-      (setq i (1+ i)))
-    (aset buf n 128)			;0x80
-    (if (<= n 55)
-	(progn
-	  (setq c4 (md4-pack-int32 b))
-	  (aset buf 56 (aref c4 0))
-	  (aset buf 57 (aref c4 1))
-	  (aset buf 58 (aref c4 2))
-	  (aset buf 59 (aref c4 3))
-	  (setq m (md4-copy64 buf))
-	  (md4-64 m))
-      ;; else
-      (setq c4 (md4-pack-int32 b))
-      (aset buf 120 (aref c4 0))
-      (aset buf 121 (aref c4 1))
-      (aset buf 122 (aref c4 2))
-      (aset buf 123 (aref c4 3))
-      (setq m (md4-copy64 buf))
-      (md4-64 m)
-      (setq m (md4-copy64 (substring buf 64)))
-      (md4-64 m)))
-
-    (concat (md4-pack-int32 (aref md4-buffer 0))
-	    (md4-pack-int32 (aref md4-buffer 1))
-	    (md4-pack-int32 (aref md4-buffer 2))
-	    (md4-pack-int32 (aref md4-buffer 3))))
-
-(defsubst md4-F (x y z) (logior (logand x y) (logand (lognot x) z)))
-(defsubst md4-G (x y z) (logior (logand x y) (logand x z) (logand y z)))
-(defsubst md4-H (x y z) (logxor x y z))
-
-(defmacro md4-make-step (name func)
-  `(defun ,name (a b c d xk s ac)
-     (let*
-         ((h1 (+ (car a) (,func (car b) (car c) (car d)) (car xk) (car ac)))
-          (l1 (+ (cdr a) (,func (cdr b) (cdr c) (cdr d)) (cdr xk) (cdr ac)))
-          (h2 (logand 65535 (+ h1 (lsh l1 -16))))
-          (l2 (logand 65535 l1))
-	  ;; cyclic shift of 32 bits integer
-          (h3 (logand 65535 (if (> s 15)
-                                (+ (lsh h2 (- s 32)) (lsh l2 (- s 16)))
-                              (+ (lsh h2 s) (lsh l2 (- s 16))))))
-          (l3 (logand 65535 (if (> s 15)
-                                (+ (lsh l2 (- s 32)) (lsh h2 (- s 16)))
-                              (+ (lsh l2 s) (lsh h2 (- s 16)))))))
-       (cons h3 l3))))
-
-(md4-make-step md4-round1 md4-F)
-(md4-make-step md4-round2 md4-G)
-(md4-make-step md4-round3 md4-H)
-
-(defsubst md4-add (x y)
-  "Return 32-bit sum of 32-bit integers X and Y."
-  (let ((h (+ (car x) (car y)))
-	(l (+ (cdr x) (cdr y))))
-    (cons (logand 65535 (+ h (lsh l -16))) (logand 65535 l))))
-
-(defsubst md4-and (x y)
-  (cons (logand (car x) (car y)) (logand (cdr x) (cdr y))))
-
-(defun md4-64 (m)
-  "Calculate md4 of 64 bytes chunk M which is represented as 16 pairs of
-32 bits integers.  The resulting md4 value is placed in md4-buffer."
-  (let ((a (aref md4-buffer 0))
-	(b (aref md4-buffer 1))
-	(c (aref md4-buffer 2))
-	(d (aref md4-buffer 3)))
-    (setq a (md4-round1 a b c d (aref m  0)   3 '(0 . 0))
-	  d (md4-round1 d a b c (aref m  1)   7 '(0 . 0))
-	  c (md4-round1 c d a b (aref m  2)  11 '(0 . 0))
-	  b (md4-round1 b c d a (aref m  3)  19 '(0 . 0))
-	  a (md4-round1 a b c d (aref m  4)   3 '(0 . 0))
-	  d (md4-round1 d a b c (aref m  5)   7 '(0 . 0))
-	  c (md4-round1 c d a b (aref m  6)  11 '(0 . 0))
-	  b (md4-round1 b c d a (aref m  7)  19 '(0 . 0))
-	  a (md4-round1 a b c d (aref m  8)   3 '(0 . 0))
-	  d (md4-round1 d a b c (aref m  9)   7 '(0 . 0))
-	  c (md4-round1 c d a b (aref m 10)  11 '(0 . 0))
-	  b (md4-round1 b c d a (aref m 11)  19 '(0 . 0))
-	  a (md4-round1 a b c d (aref m 12)   3 '(0 . 0))
-	  d (md4-round1 d a b c (aref m 13)   7 '(0 . 0))
-	  c (md4-round1 c d a b (aref m 14)  11 '(0 . 0))
-	  b (md4-round1 b c d a (aref m 15)  19 '(0 . 0))
-
-	  a (md4-round2 a b c d (aref m  0)   3 '(23170 . 31129)) ;0x5A827999
-	  d (md4-round2 d a b c (aref m  4)   5 '(23170 . 31129))
-	  c (md4-round2 c d a b (aref m  8)   9 '(23170 . 31129))
-	  b (md4-round2 b c d a (aref m 12)  13 '(23170 . 31129))
-	  a (md4-round2 a b c d (aref m  1)   3 '(23170 . 31129))
-	  d (md4-round2 d a b c (aref m  5)   5 '(23170 . 31129))
-	  c (md4-round2 c d a b (aref m  9)   9 '(23170 . 31129))
-	  b (md4-round2 b c d a (aref m 13)  13 '(23170 . 31129))
-	  a (md4-round2 a b c d (aref m  2)   3 '(23170 . 31129))
-	  d (md4-round2 d a b c (aref m  6)   5 '(23170 . 31129))
-	  c (md4-round2 c d a b (aref m 10)   9 '(23170 . 31129))
-	  b (md4-round2 b c d a (aref m 14)  13 '(23170 . 31129))
-	  a (md4-round2 a b c d (aref m  3)   3 '(23170 . 31129))
-	  d (md4-round2 d a b c (aref m  7)   5 '(23170 . 31129))
-	  c (md4-round2 c d a b (aref m 11)   9 '(23170 . 31129))
-	  b (md4-round2 b c d a (aref m 15)  13 '(23170 . 31129))
-
-	  a (md4-round3 a b c d (aref m  0)   3 '(28377 . 60321)) ;0x6ED9EBA1
-	  d (md4-round3 d a b c (aref m  8)   9 '(28377 . 60321))
-	  c (md4-round3 c d a b (aref m  4)  11 '(28377 . 60321))
-	  b (md4-round3 b c d a (aref m 12)  15 '(28377 . 60321))
-	  a (md4-round3 a b c d (aref m  2)   3 '(28377 . 60321))
-	  d (md4-round3 d a b c (aref m 10)   9 '(28377 . 60321))
-	  c (md4-round3 c d a b (aref m  6)  11 '(28377 . 60321))
-	  b (md4-round3 b c d a (aref m 14)  15 '(28377 . 60321))
-	  a (md4-round3 a b c d (aref m  1)   3 '(28377 . 60321))
-	  d (md4-round3 d a b c (aref m  9)   9 '(28377 . 60321))
-	  c (md4-round3 c d a b (aref m  5)  11 '(28377 . 60321))
-	  b (md4-round3 b c d a (aref m 13)  15 '(28377 . 60321))
-	  a (md4-round3 a b c d (aref m  3)   3 '(28377 . 60321))
-	  d (md4-round3 d a b c (aref m 11)   9 '(28377 . 60321))
-	  c (md4-round3 c d a b (aref m  7)  11 '(28377 . 60321))
-	  b (md4-round3 b c d a (aref m 15)  15 '(28377 . 60321)))
-
-    (aset md4-buffer 0 (md4-add a (aref md4-buffer 0)))
-    (aset md4-buffer 1 (md4-add b (aref md4-buffer 1)))
-    (aset md4-buffer 2 (md4-add c (aref md4-buffer 2)))
-    (aset md4-buffer 3 (md4-add d (aref md4-buffer 3)))
-    ))
-
-(defun md4-copy64 (seq)
-  "Unpack a 64 bytes string into 16 pairs of 32 bits integers."
-  (let ((int32s (make-vector 16 0)) (i 0) j)
-    (while (< i 16)
-      (setq j (* i 4))
-      (aset int32s i (cons (+ (aref seq (+ j 2)) (lsh (aref seq (+ j 3)) 8))
-			   (+ (aref seq j) (lsh (aref seq (1+ j)) 8))))
-      (setq i (1+ i)))
-    int32s))
-
-;;;
-;;; sub functions
-
-(defun md4-pack-int16 (int16)
-  "Pack 16 bits integer in 2 bytes string as little endian."
-  (let ((str (make-string 2 0)))
-    (aset str 0 (logand int16 255))
-    (aset str 1 (lsh int16 -8))
-    str))
-
-(defun md4-pack-int32 (int32)
-  "Pack 32 bits integer in a 4 bytes string as little endian.  A 32 bits
-integer is represented as a pair of two 16 bits integers (cons high low)."
-  (let ((str (make-string 4 0))
-	(h (car int32)) (l (cdr int32)))
-    (aset str 0 (logand l 255))
-    (aset str 1 (lsh l -8))
-    (aset str 2 (logand h 255))
-    (aset str 3 (lsh h -8))
-    str))
-
-(defun md4-unpack-int16 (str)
-  (if (eq 2 (length str))
-      (+ (lsh (aref str 1) 8) (aref str 0))
-    (error "%s is not 2 bytes long" str)))
-
-(defun md4-unpack-int32 (str)
-  (if (eq 4 (length str))
-      (cons (+ (lsh (aref str 3) 8) (aref str 2))
-	    (+ (lsh (aref str 1) 8) (aref str 0)))
-    (error "%s is not 4 bytes long" str)))
-
-(provide 'md4)
-
-;;; arch-tag: 99d706fe-089b-42ea-9507-67ae41091e6e
-;;; md4.el ends here
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 895c36a6beb..3aaa8c25745 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -32,9 +32,8 @@
 ;;; Code:
 
 (eval-when-compile
-  (require 'cl)
-  (defvar gnus-message-group-art)
-  (defvar gnus-list-identifiers)) ; gnus-sum is required where necessary
+  (require 'cl))
+  
 (require 'hashcash)
 (require 'canlock)
 (require 'mailheader)
@@ -51,6 +50,11 @@
 (require 'rfc822)
 (require 'ecomplete)
 
+(autoload 'mailclient-send-it "mailclient") ;; Emacs 22 or contrib/
+
+(defvar gnus-message-group-art)
+(defvar gnus-list-identifiers) ; gnus-sum is required where necessary
+(defvar rmail-enable-mime-composing)
 
 (defgroup message '((user-mail-address custom-variable)
 		    (user-full-name custom-variable))
@@ -269,7 +273,7 @@ included.  Organization and User-Agent are optional."
   :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."
@@ -474,8 +478,7 @@ This is used by `message-kill-buffer'."
   :group 'message-buffers
   :type 'boolean)
 
-(eval-when-compile
-  (defvar gnus-local-organization))
+(defvar gnus-local-organization)
 (defcustom message-user-organization
   (or (and (boundp 'gnus-local-organization)
 	   (stringp gnus-local-organization)
@@ -585,21 +588,21 @@ Done before generating the new subject of a forward."
   :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
@@ -618,28 +621,36 @@ Done before generating the new subject of a forward."
   :link '(custom-manual "(message)Canceling News")
   :type 'string)
 
+(defvar smtpmail-default-smtp-server)
+
+(defun message-send-mail-function ()
+  "Return suitable value for the variable `message-send-mail-function'."
+  (cond ((and (require 'sendmail)
+	      (boundp 'sendmail-program)
+	      sendmail-program
+	      (executable-find sendmail-program))
+	 'message-send-mail-with-sendmail)
+	((and (locate-library "smtpmail")
+	      (require 'smtpmail)
+	      smtpmail-default-smtp-server)
+	 'message-smtpmail-send-it)
+	((locate-library "mailclient")
+	 'message-send-mail-with-mailclient)
+	(t
+	 (lambda ()
+	   (error "Don't know how to send mail.  Please customize `message-send-mail-function'")))))
+
 ;; Useful to set in site-init.el
-(defcustom message-send-mail-function
-  (let ((program (if (boundp 'sendmail-program)
-		     ;; see paths.el
-		     sendmail-program)))
-    (cond
-     ((and program
-	   (string-match "/" program) ;; Skip path
-	   (file-executable-p program))
-      'message-send-mail-with-sendmail)
-     ((and program
-	   (executable-find program))
-      'message-send-mail-with-sendmail)
-     (t
-      'smtpmail-send-it)))
+(defcustom message-send-mail-function (message-send-mail-function)
   "Function to call to send the current buffer as mail.
 The headers should be delimited by a line whose contents match the
 variable `mail-header-separator'.
 
-Valid values include `message-send-mail-with-sendmail' (the default),
+Valid values include `message-send-mail-with-sendmail'
 `message-send-mail-with-mh', `message-send-mail-with-qmail',
-`message-smtpmail-send-it', `smtpmail-send-it' and `feedmail-send-it'.
+`message-smtpmail-send-it', `smtpmail-send-it',
+`feedmail-send-it' and `message-send-mail-with-mailclient'.  The
+default is system dependent.
 
 See also `send-mail-function'."
   :type '(radio (function-item message-send-mail-with-sendmail)
@@ -648,8 +659,12 @@ See also `send-mail-function'."
 		(function-item message-smtpmail-send-it)
 		(function-item smtpmail-send-it)
 		(function-item feedmail-send-it)
-		(function :tag "Other"))
+		(function :tag "Other")
+		(function-item message-send-mail-with-mailclient
+			       :tag "Use Mailclient package")
+ 		(function :tag "Other"))
   :group 'message-sending
+  :initialize 'custom-initialize-default
   :link '(custom-manual "(message)Mail Variables")
   :group 'message-mail)
 
@@ -816,9 +831,8 @@ might set this variable to '(\"-f\" \"you@some.where\")."
   :type '(choice (function)
 		 (repeat string)))
 
-(eval-when-compile
-  (defvar gnus-post-method)
-  (defvar gnus-select-method))
+(defvar gnus-post-method)
+(defvar gnus-select-method)
 (defcustom message-post-method
   (cond ((and (boundp 'gnus-post-method)
 	      (listp gnus-post-method)
@@ -1122,8 +1136,7 @@ these lines."
 	   (file-readable-p "/etc/sendmail.cf")
 	   (let ((buffer (get-buffer-create " *temp*")))
 	     (unwind-protect
-		 (save-excursion
-		   (set-buffer buffer)
+		 (with-current-buffer buffer
 		   (insert-file-contents "/etc/sendmail.cf")
 		   (goto-char (point-min))
 		   (let ((case-fold-search nil))
@@ -1205,7 +1218,7 @@ If nil, you might be asked to input the charset."
 (defcustom message-dont-reply-to-names
   (and (boundp 'rmail-dont-reply-to-names) rmail-dont-reply-to-names)
   "*Addresses to prune when doing wide replies.
-This can be a regexp or a list of regexps. Also, a value of nil means
+This can be a regexp or a list of regexps.  Also, a value of nil means
 exclude your own user name only."
   :version "21.1"
   :group 'message
@@ -1617,7 +1630,7 @@ functionality to work."
 
 (defcustom message-generate-hashcash (if (executable-find "hashcash") t)
   "*Whether to generate X-Hashcash: headers.
-If `t', always generate hashcash headers.  If `opportunistic',
+If t, always generate hashcash headers.  If `opportunistic',
 only generate hashcash headers if it can be done without the user
 waiting (i.e., only asynchronously).
 
@@ -1640,9 +1653,8 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'."
 (defvar message-inserted-headers nil)
 
 ;; Byte-compiler warning
-(eval-when-compile
-  (defvar gnus-active-hashtb)
-  (defvar gnus-read-active-file))
+(defvar gnus-active-hashtb)
+(defvar gnus-read-active-file)
 
 ;;; Regexp matching the delimiter of messages in UNIX mail format
 ;;; (UNIX From lines), minus the initial ^.  It should be a copy
@@ -1916,8 +1928,7 @@ see `message-narrow-to-headers-or-head'."
   "Evaluate FORMS in the reply buffer, if it exists."
   `(when (and message-reply-buffer
 	      (buffer-name message-reply-buffer))
-     (save-excursion
-       (set-buffer message-reply-buffer)
+     (with-current-buffer message-reply-buffer
        ,@forms)))
 
 (put 'message-with-reply-buffer 'lisp-indent-function 0)
@@ -2662,9 +2673,8 @@ Prefixed with two \\[universal-argument]'s, display the PGG manual."
 
 (defvar message-tool-bar-map nil)
 
-(eval-when-compile
-  (defvar facemenu-add-face-function)
-  (defvar facemenu-remove-face-function))
+(defvar facemenu-add-face-function)
+(defvar facemenu-remove-face-function)
 
 ;;; Forbidden properties
 ;;
@@ -3084,8 +3094,7 @@ or in the synonym headers, defined by `message-header-synonyms'."
   (let ((follow-to
 	 (and message-reply-buffer
 	      (buffer-name message-reply-buffer)
-	      (save-excursion
-		(set-buffer message-reply-buffer)
+	      (with-current-buffer message-reply-buffer
 		(message-get-reply-headers t)))))
     (save-excursion
       (save-restriction
@@ -3337,8 +3346,7 @@ The three allowed values according to RFC 1327 are `high', `normal'
 and `low'."
   (interactive)
   (save-excursion
-    (let ((valid '("high" "normal" "low"))
-	  (new "high")
+    (let ((new "high")
 	  cur)
       (save-restriction
 	(message-narrow-to-headers)
@@ -3612,7 +3620,7 @@ Really top post? ")))
 (defun message-buffers ()
   "Return a list of active message buffers."
   (let (buffers)
-    (save-excursion
+    (save-current-buffer
       (dolist (buffer (buffer-list t))
 	(set-buffer buffer)
 	(when (and (eq major-mode 'message-mode)
@@ -3620,8 +3628,6 @@ Really top post? ")))
 	  (push (buffer-name buffer) buffers))))
     (nreverse buffers)))
 
-(eval-when-compile (defvar mail-citation-hook))	; Compiler directive
-
 (defun message-cite-original-1 (strip-signature)
   "Cite an original message.
 If STRIP-SIGNATURE is non-nil, strips off the signature from the
@@ -3688,6 +3694,8 @@ This function uses `mail-citation-hook' if that is non-nil."
   "Cite function in the standard Message manner."
   (message-cite-original-1 nil))
 
+(defvar gnus-extract-address-components)
+
 (defun message-insert-formatted-citation-line (&optional from date)
   "Function that inserts a formatted citation line.
 
@@ -4304,8 +4312,7 @@ This function could be useful in `message-setup-hook'."
       ;; Let the user do all of the above.
       (run-hooks 'message-header-hook))
     (unwind-protect
-	(save-excursion
-	  (set-buffer tembuf)
+	(with-current-buffer tembuf
 	  (erase-buffer)
 	  ;; Avoid copying text props (except hard newlines).
 	  (insert (with-current-buffer mailbuf
@@ -4450,8 +4457,7 @@ If you always want Gnus to send messages in one piece, set
 	    (unless (or (null cpr) (and (numberp cpr) (zerop cpr)))
 	      (error "Sending...failed with exit value %d" cpr)))
 	  (when message-interactive
-	    (save-excursion
-	      (set-buffer errbuf)
+	    (with-current-buffer errbuf
 	      (goto-char (point-min))
 	      (while (re-search-forward "\n+ *" nil t)
 		(replace-match "; "))
@@ -4532,6 +4538,13 @@ manual for details."
   (run-hooks 'message-send-mail-hook)
   (smtpmail-send-it))
 
+(defun message-send-mail-with-mailclient ()
+  "Send the prepared message buffer with `mailclient-send-it'.
+This only differs from `smtpmail-send-it' that this command evaluates
+`message-send-mail-hook' just before sending a message."
+  (run-hooks 'message-send-mail-hook)
+  (mailclient-send-it))
+
 (defun message-canlock-generate ()
   "Return a string that is non-trivial to guess.
 Do not use this for anything important, it is cryptographically weak."
@@ -4614,8 +4627,7 @@ Otherwise, generate and save a value for `canlock-password' first."
 		 (message-check-news-syntax)))
 	  nil
 	(unwind-protect
-	    (save-excursion
-	      (set-buffer tembuf)
+	    (with-current-buffer tembuf
 	      (buffer-disable-undo)
 	      (erase-buffer)
 	      ;; Avoid copying text props (except hard newlines).
@@ -5278,8 +5290,7 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'."
   "Return the References header for this message."
   (when message-reply-headers
     (let ((message-id (mail-header-message-id message-reply-headers))
-	  (references (mail-header-references message-reply-headers))
-	  new-references)
+	  (references (mail-header-references message-reply-headers)))
       (if (or references message-id)
 	  (concat (or references "") (and references " ")
 		  (or message-id ""))
@@ -5527,8 +5538,7 @@ subscribed address (and not the additional To and Cc header contents)."
 			     (mapcar 'funcall
 				     message-subscribed-address-functions))))
     (save-match-data
-      (let ((subscribed-lists nil)
-	    (list
+      (let ((list
 	     (loop for recipient in recipients
 	       when (loop for regexp in mft-regexps
 		      when (string-match regexp recipient) return t)
@@ -5549,7 +5559,9 @@ subscribed address (and not the additional To and Cc header contents)."
 			(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:? "
@@ -6873,8 +6885,7 @@ the message."
 	    (setq subject (funcall func subject))))
 	subject))))
 
-(eval-when-compile
-  (defvar gnus-article-decoded-p))
+(defvar gnus-article-decoded-p)
 
 
 ;;;###autoload
@@ -7088,8 +7099,6 @@ is for the internal use."
 	(rmail-msg-restore-non-pruned-header)))
   (message-forward-make-body forward-buffer))
 
-(eval-when-compile (defvar rmail-enable-mime-composing))
-
 ;; Fixme: Should have defcustom.
 ;;;###autoload
 (defun message-insinuate-rmail ()
@@ -7311,8 +7320,7 @@ which specify the range to operate on."
     (mapcar #'delete-overlay (overlays-in (point-min) (point-max)))))
 
 ;; Support for toolbar
-(eval-when-compile
-  (defvar tool-bar-mode))
+(defvar tool-bar-mode)
 
 ;; Note: The :set function in the `message-tool-bar*' variables will only
 ;; affect _new_ message buffers.  We might add a function that walks thru all
@@ -7377,7 +7385,7 @@ See `gmm-tool-bar-from-list' for details on the format of the list."
 
 (defcustom message-tool-bar-retro
   '(;; Old Emacs 21 icon for consistency.
-    (message-send-and-exit "gnus/mail_send")
+    (message-send-and-exit "gnus/mail-send")
     (message-kill-buffer "close")
     (message-dont-send "cancel")
     (mml-attach-file "attach" mml-mode-map)
@@ -7556,9 +7564,8 @@ The following arguments may contain lists of values."
   (if (and show
 	   (setq text (message-flatten-list text)))
       (save-window-excursion
-	(save-excursion
-	  (with-output-to-temp-buffer " *MESSAGE information message*"
-	    (set-buffer " *MESSAGE information message*")
+        (with-output-to-temp-buffer " *MESSAGE information message*"
+          (with-current-buffer " *MESSAGE information message*"
 	    (fundamental-mode)		; for Emacs 20.4+
 	    (mapc 'princ text)
 	    (goto-char (point-min))))
@@ -7581,16 +7588,13 @@ Then clone the local variables and values from the old buffer to the
 new one, cloning only the locals having a substring matching the
 regexp VARSTR."
   (let ((oldbuf (current-buffer)))
-    (save-excursion
-      (set-buffer (generate-new-buffer name))
+    (with-current-buffer (generate-new-buffer name)
       (message-clone-locals oldbuf varstr)
       (current-buffer))))
 
 (defun message-clone-locals (buffer &optional varstr)
   "Clone the local variables from BUFFER to the current buffer."
-  (let ((locals (save-excursion
-		  (set-buffer buffer)
-		  (buffer-local-variables)))
+  (let ((locals (with-current-buffer buffer (buffer-local-variables)))
 	(regexp "^gnus\\|^nn\\|^message\\|^sendmail\\|^smtp\\|^user-mail-address"))
     (mapcar
      (lambda (local)
diff --git a/lisp/gnus/mm-bodies.el b/lisp/gnus/mm-bodies.el
index 20af36564f7..0560c51ba41 100644
--- a/lisp/gnus/mm-bodies.el
+++ b/lisp/gnus/mm-bodies.el
@@ -26,14 +26,14 @@
 
 ;;; Code:
 
-(eval-when-compile
-  (defvar mm-uu-decode-function)
-  (defvar mm-uu-binhex-decode-function))
-
 (require 'mm-util)
 (require 'rfc2047)
 (require 'mm-encode)
 
+(defvar mm-uu-yenc-decode-function)
+(defvar mm-uu-decode-function)
+(defvar mm-uu-binhex-decode-function)
+
 ;; 8bit treatment gets any char except: 0x32 - 0x7f, LF, TAB, BEL,
 ;; BS, vertical TAB, form feed, and ^_
 ;;
@@ -170,8 +170,6 @@ If no encoding was done, nil is returned."
 ;;; Functions for decoding
 ;;;
 
-(eval-when-compile (defvar mm-uu-yenc-decode-function))
-
 (defun mm-decode-content-transfer-encoding (encoding &optional type)
   "Decodes buffer encoded with ENCODING, returning success status.
 If TYPE is `text/plain' CRLF->LF translation may occur."
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index 14e5c255d2a..71ef9bcdf55 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -895,7 +895,7 @@ external if displayed external."
 			  ;; a vector in Emacs but is a list in XEmacs)
 			  ;; requires that it is lexically scoped.
 			  (timer (run-at-time 2.0 nil 'ignore)))
-		       (if (boundp 'itimer-list)
+		       (if (featurep 'xemacs)
 			   (lambda (process state)
 			     (when (eq 'exit (process-status process))
 			       (if (memq timer itimer-list)
@@ -1364,34 +1364,35 @@ be determined."
 	    (mm-handle-set-cache handle spec))))))
 
 (defun mm-create-image-xemacs (type)
-  (cond
-   ((equal type "xbm")
-    ;; xbm images require special handling, since
-    ;; the only way to create glyphs from these
-    ;; (without a ton of work) is to write them
-    ;; out to a file, and then create a file
-    ;; specifier.
-    (let ((file (mm-make-temp-file
-		 (expand-file-name "emm" mm-tmp-directory)
-		 nil ".xbm")))
-      (unwind-protect
-	  (progn
-	    (write-region (point-min) (point-max) file)
-	    (make-glyph (list (cons 'x file))))
-	(ignore-errors
-	  (delete-file file)))))
-   (t
-    (make-glyph
-     (vector
-      (or (mm-image-type-from-buffer)
-	  (intern type))
-      :data (buffer-string))))))
+  (when (featurep 'xemacs)
+    (cond
+     ((equal type "xbm")
+      ;; xbm images require special handling, since
+      ;; the only way to create glyphs from these
+      ;; (without a ton of work) is to write them
+      ;; out to a file, and then create a file
+      ;; specifier.
+      (let ((file (mm-make-temp-file
+		   (expand-file-name "emm" mm-tmp-directory)
+		   nil ".xbm")))
+	(unwind-protect
+	    (progn
+	      (write-region (point-min) (point-max) file)
+	      (make-glyph (list (cons 'x file))))
+	  (ignore-errors
+	    (delete-file file)))))
+     (t
+      (make-glyph
+       (vector
+	(or (mm-image-type-from-buffer)
+	    (intern type))
+	:data (buffer-string)))))))
 
 (defun mm-image-fit-p (handle)
   "Say whether the image in HANDLE will fit the current window."
   (let ((image (mm-get-image handle)))
     (or (not image)
-	(if (fboundp 'glyph-width)
+	(if (featurep 'xemacs)
 	    ;; XEmacs' glyphs can actually tell us about their width, so
 	    ;; lets be nice and smart about them.
 	    (or mm-inline-large-images
diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el
index cfc6c949be0..edb7521dbf3 100644
--- a/lisp/gnus/mm-util.el
+++ b/lisp/gnus/mm-util.el
@@ -36,6 +36,8 @@
 	(require 'timer))
     (require 'timer)))
 
+(defvar mm-mime-mule-charset-alist )
+
 (eval-and-compile
   (mapc
    (lambda (elem)
@@ -837,9 +839,10 @@ This affects whether coding conversion should be attempted generally."
   (autoload 'latin-unity-massage-name "latin-unity")
   (autoload 'latin-unity-maybe-remap "latin-unity")
   (autoload 'latin-unity-representations-feasible-region "latin-unity")
-  (autoload 'latin-unity-representations-present-region "latin-unity")
-  (defvar latin-unity-coding-systems)
-  (defvar latin-unity-ucs-list))
+  (autoload 'latin-unity-representations-present-region "latin-unity"))
+
+(defvar latin-unity-coding-systems)
+(defvar latin-unity-ucs-list)
 
 (defun mm-xemacs-find-mime-charset-1 (begin end)
   "Determine which MIME charset to use to send region as message.
@@ -1375,7 +1378,7 @@ gzip, bzip2, etc. are allowed."
 		    (funcall (symbol-value 'set-auto-coding-function)
 			     nil (- (point-max) (point-min)))
 		  (error nil)))))
-	   ((featurep 'file-coding) ;; XEmacs
+	   ((and (featurep 'xemacs) (featurep 'file-coding)) ;; XEmacs
 	    (let ((case-fold-search t)
 		  (end (point-at-eol))
 		  codesys start)
diff --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el
index c7f6b16a1c8..52d47b728ef 100644
--- a/lisp/gnus/mm-uu.el
+++ b/lisp/gnus/mm-uu.el
@@ -272,7 +272,7 @@ If PROPERTIES is non-nil, PROPERTIES are applied to the buffer,
 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)))
@@ -305,11 +305,10 @@ apply the face `mm-uu-extract'."
 
 (mm-uu-configure)
 
-(eval-when-compile
-  (defvar file-name)
-  (defvar start-point)
-  (defvar end-point)
-  (defvar entry))
+(defvar file-name)
+(defvar start-point)
+(defvar end-point)
+(defvar entry)
 
 (defun mm-uu-uu-filename ()
   (if (looking-at ".+")
@@ -375,8 +374,7 @@ apply the face `mm-uu-extract'."
 		  (list mm-dissect-disposition
 			(cons 'filename file-name))))
 
-(eval-when-compile
-  (defvar gnus-newsgroup-name))
+(defvar gnus-newsgroup-name)
 
 (defun mm-uu-emacs-sources-test ()
   (setq file-name (match-string 1))
@@ -430,7 +428,12 @@ apply the face `mm-uu-extract'."
 			    (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
@@ -465,8 +468,7 @@ apply the face `mm-uu-extract'."
 	   (y-or-n-p "Verify pgp signed part? ")
 	 (message ""))))))
 
-(eval-when-compile
-  (defvar gnus-newsgroup-charset))
+(defvar gnus-newsgroup-charset)
 
 (defun mm-uu-pgp-signed-extract-1 (handles ctl)
   (let ((buf (mm-uu-copy-to-buffer (point-min) (point-max))))
diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el
index ffaf0ed68ba..cb4f42dabcf 100644
--- a/lisp/gnus/mm-view.el
+++ b/lisp/gnus/mm-view.el
@@ -97,19 +97,20 @@
 	  (delete-region b (+ b 2)))))))
 
 (defun mm-inline-image-xemacs (handle)
-  (insert "\n\n")
-  (forward-char -2)
-  (let ((annot (make-annotation (mm-get-image handle) nil 'text))
-	buffer-read-only)
-    (mm-handle-set-undisplayer
-     handle
-     `(lambda ()
-	(let ((b ,(point-marker))
-	      buffer-read-only)
-	  (delete-annotation ,annot)
-	  (delete-region (- b 2) b))))
-    (set-extent-property annot 'mm t)
-    (set-extent-property annot 'duplicable t)))
+  (when (featurep 'xemacs)
+    (insert "\n\n")
+    (forward-char -2)
+    (let ((annot (make-annotation (mm-get-image handle) nil 'text))
+	  buffer-read-only)
+      (mm-handle-set-undisplayer
+       handle
+       `(lambda ()
+	  (let ((b ,(point-marker))
+		buffer-read-only)
+	    (delete-annotation ,annot)
+	    (delete-region (- b 2) b))))
+      (set-extent-property annot 'mm t)
+      (set-extent-property annot 'duplicable t))))
 
 (eval-and-compile
   (if (featurep 'xemacs)
@@ -568,7 +569,7 @@
       ;; By default, XEmacs font-lock uses non-duplicable text
       ;; properties.  This code forces all the text properties
       ;; to be copied along with the text.
-      (when (fboundp 'extent-list)
+      (when (featurep 'xemacs)
 	(map-extents (lambda (ext ignored)
 		       (set-extent-property ext 'duplicable t)
 		       nil)
diff --git a/lisp/gnus/mml-sec.el b/lisp/gnus/mml-sec.el
index 29bc0d41a1b..e7ecc06164f 100644
--- a/lisp/gnus/mml-sec.el
+++ b/lisp/gnus/mml-sec.el
@@ -27,7 +27,9 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
-(require 'password)
+(or (require 'password-cache nil t)
+    (require 'password))
+
 (autoload 'mml2015-sign "mml2015")
 (autoload 'mml2015-encrypt "mml2015")
 (autoload 'mml1991-sign "mml1991")
diff --git a/lisp/gnus/mml-smime.el b/lisp/gnus/mml-smime.el
index c00ac416b8b..07dc1ab4ccb 100644
--- a/lisp/gnus/mml-smime.el
+++ b/lisp/gnus/mml-smime.el
@@ -142,6 +142,8 @@ Whether the passphrase is cached at all is controlled by
       nil))
   (goto-char (point-max)))
 
+(defvar gnus-extract-address-components)
+
 (defun mml-smime-openssl-sign-query ()
   ;; query information (what certificate) from user when MML tag is
   ;; added, for use later by the signing process
@@ -298,13 +300,13 @@ Whether the passphrase is cached at all is controlled by
 (defun mml-smime-openssl-verify-test (handle ctl)
   smime-openssl-program)
 
-(eval-and-compile
-  (autoload 'epg-make-context "epg"))
+(defvar epg-user-id-alist)
+(defvar epg-digest-algorithm-alist)
+(defvar inhibit-redisplay)
+(defvar password-cache-expiry)
 
 (eval-when-compile
-  (defvar epg-user-id-alist)
-  (defvar epg-digest-algorithm-alist)
-  (defvar inhibit-redisplay)
+  (autoload 'epg-make-context "epg")
   (autoload 'epg-context-set-armor "epg")
   (autoload 'epg-context-set-signers "epg")
   (autoload 'epg-context-result-for "epg")
@@ -321,12 +323,6 @@ Whether the passphrase is cached at all is controlled by
   (autoload 'epg-expand-group "epg-config")
   (autoload 'epa-select-keys "epa"))
 
-(eval-when-compile
-  (defvar password-cache-expiry)
-  (autoload 'password-read "password")
-  (autoload 'password-cache-add "password")
-  (autoload 'password-cache-remove "password"))
-
 (defvar mml-smime-epg-secret-key-id-list nil)
 
 (defun mml-smime-epg-passphrase-callback (context key-id ignore)
diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el
index 7fbc8bb3209..c5b7796ffaf 100644
--- a/lisp/gnus/mml.el
+++ b/lisp/gnus/mml.el
@@ -53,6 +53,7 @@
 (defvar message-required-mail-headers)
 (defvar message-required-news-headers)
 (defvar dnd-protocol-alist)
+(defvar mml-dnd-protocol-alist)
 
 (defcustom mml-content-type-parameters
   '(name access-type expiration size permission format)
@@ -806,9 +807,9 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
 	 (mail-header-encode-parameter
 	  (symbol-name type) value))))))
 
-(eval-when-compile
-  (defvar ange-ftp-name-format)
-  (defvar efs-path-regexp))
+(defvar ange-ftp-name-format)
+(defvar efs-path-regexp)
+
 (defun mml-parse-file-name (path)
   (if (if (boundp 'efs-path-regexp)
 	  (string-match efs-path-regexp path)
diff --git a/lisp/gnus/mml1991.el b/lisp/gnus/mml1991.el
index f6d2dcc7ad5..be9981676e6 100644
--- a/lisp/gnus/mml1991.el
+++ b/lisp/gnus/mml1991.el
@@ -244,10 +244,9 @@ Whether the passphrase is cached at all is controlled by
 
 ;; pgg wrapper
 
-(eval-when-compile
-  (defvar pgg-default-user-id)
-  (defvar pgg-errors-buffer)
-  (defvar pgg-output-buffer))
+(defvar pgg-default-user-id)
+(defvar pgg-errors-buffer)
+(defvar pgg-output-buffer)
 
 (defun mml1991-pgg-sign (cont)
   (let ((pgg-text-mode t)
@@ -313,11 +312,11 @@ Whether the passphrase is cached at all is controlled by
 
 ;; epg wrapper
 
-(eval-and-compile
-  (autoload 'epg-make-context "epg"))
+(defvar epg-user-id-alist)
+(defvar password-cache-expiry)
 
-(eval-when-compile
-  (defvar epg-user-id-alist)
+(eval-and-compile
+  (autoload 'epg-make-context "epg")
   (autoload 'epg-passphrase-callback-function "epg")
   (autoload 'epa-select-keys "epa")
   (autoload 'epg-list-keys "epg")
@@ -330,12 +329,6 @@ Whether the passphrase is cached at all is controlled by
   (autoload 'epg-configuration "epg-config")
   (autoload 'epg-expand-group "epg-config"))
 
-(eval-when-compile
-  (defvar password-cache-expiry)
-  (autoload 'password-read "password")
-  (autoload 'password-cache-add "password")
-  (autoload 'password-cache-remove "password"))
-
 (defvar mml1991-epg-secret-key-id-list nil)
 
 (defun mml1991-epg-passphrase-callback (context key-id ignore)
diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el
index 1760e4615ce..28d1929399e 100644
--- a/lisp/gnus/mml2015.el
+++ b/lisp/gnus/mml2015.el
@@ -173,9 +173,8 @@ Whether the passphrase is cached at all is controlled by
   (autoload 'mc-cleanup-recipient-headers "mc-toplev")
   (autoload 'mc-sign-generic "mc-toplev"))
 
-(eval-when-compile
-  (defvar mc-default-scheme)
-  (defvar mc-schemes))
+(defvar mc-default-scheme)
+(defvar mc-schemes)
 
 (defvar mml2015-decrypt-function 'mailcrypt-decrypt)
 (defvar mml2015-verify-function 'mailcrypt-verify)
@@ -707,10 +706,9 @@ Whether the passphrase is cached at all is controlled by
 
 ;;; pgg wrapper
 
-(eval-when-compile
-  (defvar pgg-default-user-id)
-  (defvar pgg-errors-buffer)
-  (defvar pgg-output-buffer))
+(defvar pgg-default-user-id)
+(defvar pgg-errors-buffer)
+(defvar pgg-output-buffer)
 
 (eval-and-compile
   (autoload 'pgg-decrypt-region "pgg")
@@ -945,13 +943,12 @@ Whether the passphrase is cached at all is controlled by
 
 ;;; epg wrapper
 
-(eval-and-compile
-  (autoload 'epg-make-context "epg"))
+(defvar epg-user-id-alist)
+(defvar epg-digest-algorithm-alist)
+(defvar inhibit-redisplay)
 
-(eval-when-compile
-  (defvar epg-user-id-alist)
-  (defvar epg-digest-algorithm-alist)
-  (defvar inhibit-redisplay)
+(eval-and-compile
+  (autoload 'epg-make-context "epg")
   (autoload 'epg-context-set-armor "epg")
   (autoload 'epg-context-set-textmode "epg")
   (autoload 'epg-context-set-signers "epg")
@@ -972,11 +969,7 @@ Whether the passphrase is cached at all is controlled by
   (autoload 'epg-expand-group "epg-config")
   (autoload 'epa-select-keys "epa"))
 
-(eval-when-compile
-  (defvar password-cache-expiry)
-  (autoload 'password-read "password")
-  (autoload 'password-cache-add "password")
-  (autoload 'password-cache-remove "password"))
+(defvar password-cache-expiry)
 
 (defvar mml2015-epg-secret-key-id-list nil)
 
diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el
index 015c0643893..3767828a766 100644
--- a/lisp/gnus/nndiary.el
+++ b/lisp/gnus/nndiary.el
@@ -1085,7 +1085,7 @@ all.  This may very well take some time.")
 	(unless no-active
 	  (nnmail-save-active nndiary-group-alist nndiary-active-file))))))
 
-(eval-when-compile (defvar files))
+(defvar files)
 (defun nndiary-generate-active-info (dir)
   ;; Update the active info for this group.
   (let* ((group (nnheader-file-to-group
diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el
index 031d2c3d0fb..11cb4bff55c 100644
--- a/lisp/gnus/nnheader.el
+++ b/lisp/gnus/nnheader.el
@@ -32,6 +32,9 @@
 (eval-when-compile (require 'cl))
 
 (defvar nnmail-extra-headers)
+(defvar gnus-newsgroup-name)
+(defvar nnheader-file-coding-system)
+(defvar jka-compr-compression-info-list)
 
 ;; Requiring `gnus-util' at compile time creates a circular
 ;; dependency between nnheader.el and gnus-util.el.
@@ -696,7 +699,6 @@ the line could be found."
     (erase-buffer))
   (current-buffer))
 
-(eval-when-compile (defvar jka-compr-compression-info-list))
 (defvar nnheader-numerical-files
   (if (boundp 'jka-compr-compression-info-list)
       (concat "\\([0-9]+\\)\\("
@@ -939,9 +941,8 @@ first.  Otherwise, find the newest one, though it may take a time."
 	(car results)
       (car (sort results 'file-newer-than-file-p)))))
 
-(eval-when-compile
-  (defvar ange-ftp-path-format)
-  (defvar efs-path-regexp))
+(defvar ange-ftp-path-format)
+(defvar efs-path-regexp)
 (defun nnheader-re-read-dir (path)
   "Re-read directory PATH if PATH is on a remote system."
   (if (and (fboundp 'efs-re-read-dir) (boundp 'efs-path-regexp))
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index 28938e4c0a6..9b0fab70469 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -208,7 +208,7 @@ This is generally not required, and will slow things down considerably.
 You may need it if you want to use an advanced splitting function that
 analyzes the body before splitting the article.
 If this variable is nil, bodies will not be downloaded; if this
-variable is the symbol `default' the default behaviour is
+variable is the symbol `default' the default behavior is
 used (which currently is nil, unless you use a statistical
 spam.el test); if this variable is another non-nil value bodies
 will be downloaded."
diff --git a/lisp/gnus/nnkiboze.el b/lisp/gnus/nnkiboze.el
index 78e35c410bb..06acca8c09d 100644
--- a/lisp/gnus/nnkiboze.el
+++ b/lisp/gnus/nnkiboze.el
@@ -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))
diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el
index 7608660f019..e05c286b1ab 100644
--- a/lisp/gnus/nnmail.el
+++ b/lisp/gnus/nnmail.el
@@ -240,16 +240,11 @@ If non-nil, also update the cache when copy or move articles."
   :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."
@@ -693,7 +688,7 @@ nn*-request-list should have been called before calling this function."
 	      (setq group (symbol-name group)))
 	    (if (and (numberp (setq max (read buffer)))
 		     (numberp (setq min (read buffer))))
-		(push (list group (cons min max))
+		(push (list (mm-string-as-unibyte group) (cons min max))
 		      group-assoc)))
 	(error nil))
       (widen)
@@ -708,6 +703,7 @@ nn*-request-list should have been called before calling this function."
   (let ((coding-system-for-write nnmail-active-file-coding-system))
     (when file-name
       (with-temp-file file-name
+	(mm-disable-multibyte)
 	(nnmail-generate-active group-assoc)))))
 
 (defun nnmail-generate-active (alist)
@@ -1764,10 +1760,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
 (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)
@@ -1777,20 +1770,6 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
     (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)
diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el
index 04b6af72aed..e7674168484 100644
--- a/lisp/gnus/nnmaildir.el
+++ b/lisp/gnus/nnmaildir.el
@@ -1,5 +1,6 @@
 ;;; nnmaildir.el --- maildir backend for Gnus
-;; Public domain.
+
+;; This file is in the public domain.
 
 ;; Author: Paul Jarc <prj@po.cwru.edu>
 
diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el
index 0f159181026..8a5afbe5b60 100644
--- a/lisp/gnus/nnml.el
+++ b/lisp/gnus/nnml.el
@@ -258,7 +258,8 @@ non-nil.")
 	    (string-to-number (file-name-nondirectory path)))))))
 
 (deffoo nnml-request-group (group &optional server dont-check)
-  (let ((file-name-coding-system nnmail-pathname-coding-system))
+  (let ((file-name-coding-system nnmail-pathname-coding-system)
+	(decoded (nnml-decoded-group-name group server)))
     (cond
      ((not (nnml-possibly-change-directory group server))
       (nnheader-report 'nnml "Invalid group (no such directory)"))
@@ -268,15 +269,15 @@ non-nil.")
      ((not (file-directory-p nnml-current-directory))
       (nnheader-report 'nnml "%s is not a directory" nnml-current-directory))
      (dont-check
-      (nnheader-report 'nnml "Group %s selected" group)
+      (nnheader-report 'nnml "Group %s selected" decoded)
       t)
      (t
       (nnheader-re-read-dir nnml-current-directory)
       (nnmail-activate 'nnml)
       (let ((active (nth 1 (assoc group nnml-group-alist))))
 	(if (not active)
-	    (nnheader-report 'nnml "No such group: %s" group)
-	  (nnheader-report 'nnml "Selected group %s" group)
+	    (nnheader-report 'nnml "No such group: %s" decoded)
+	  (nnheader-report 'nnml "Selected group %s" decoded)
 	  (nnheader-insert "211 %d %d %d %s\n"
 			   (max (1+ (- (cdr active) (car active))) 0)
 			   (car active) (cdr active) group)))))))
@@ -885,7 +886,7 @@ Unless no-active is non-nil, update the active file too."
 	  (unless no-active
 	    (nnmail-save-active nnml-group-alist nnml-active-file)))))))
 
-(eval-when-compile (defvar files))
+(defvar files)
 (defun nnml-generate-active-info (dir)
   ;; Update the active info for this group.
   (let ((group (directory-file-name dir))
diff --git a/lisp/gnus/nnnil.el b/lisp/gnus/nnnil.el
index 926553365d3..5c5e3c1af91 100644
--- a/lisp/gnus/nnnil.el
+++ b/lisp/gnus/nnnil.el
@@ -1,8 +1,11 @@
 ;;; nnnil.el --- empty backend for Gnus
-;; Public domain.
+
+;; This file is in the public domain.
 
 ;; Author: Paul Jarc <prj@po.cwru.edu>
 
+;; 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, or (at your option)
diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el
index 5241f9d80e6..f72166b0455 100644
--- a/lisp/gnus/nnrss.el
+++ b/lisp/gnus/nnrss.el
@@ -195,9 +195,8 @@ used to render text.  If it is nil, text will simply be folded.")
 (deffoo nnrss-close-group (group &optional server)
   t)
 
-(eval-when-compile
-  (defvar mm-text-html-renderer)
-  (defvar mm-text-html-washer-alist))
+(defvar mm-text-html-renderer)
+(defvar mm-text-html-washer-alist)
 
 (deffoo nnrss-request-article (article &optional group server buffer)
   (setq group (nnrss-decode-group-name group))
diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el
index c8c14da4df7..356ffefddeb 100644
--- a/lisp/gnus/nntp.el
+++ b/lisp/gnus/nntp.el
@@ -364,6 +364,32 @@ be restored and the command retried."
 
   (throw 'nntp-with-open-group-error t))
 
+(defmacro nntp-insert-buffer-substring (buffer &optional start end)
+  "Copy string from unibyte buffer to multibyte current buffer."
+  (if (featurep 'xemacs)
+      `(insert-buffer-substring ,buffer ,start ,end)
+    `(if enable-multibyte-characters
+	 (insert (with-current-buffer ,buffer
+		   (mm-string-to-multibyte
+		    ,(if (or start end)
+			 `(buffer-substring (or ,start (point-min))
+					    (or ,end (point-max)))
+		       '(buffer-string)))))
+       (insert-buffer-substring ,buffer ,start ,end))))
+
+(defmacro nntp-copy-to-buffer (buffer start end)
+  "Copy string from unibyte current buffer to multibyte buffer."
+  (if (featurep 'xemacs)
+      `(copy-to-buffer ,buffer ,start ,end)
+    `(let ((string (buffer-substring ,start ,end)))
+       (with-current-buffer ,buffer
+	 (erase-buffer)
+	 (insert (if enable-multibyte-characters
+		     (mm-string-to-multibyte string)
+		   string))
+	 (goto-char (point-min))
+	 nil))))
+
 (defsubst nntp-wait-for (process wait-for buffer &optional decode discard)
   "Wait for WAIT-FOR to arrive from PROCESS."
 
@@ -409,7 +435,7 @@ be restored and the command retried."
 	    (save-excursion
 	      (set-buffer buffer)
 	      (goto-char (point-max))
-	      (insert-buffer-substring (process-buffer process))
+	      (nntp-insert-buffer-substring (process-buffer process))
 	      ;; Nix out "nntp reading...." message.
 	      (when nntp-have-messaged
 		(setq nntp-have-messaged nil)
@@ -653,7 +679,7 @@ command whose response triggered the error."
 					      nntp-server-buffer))
 				    (buffer  (and process
 						  (process-buffer process))))
-				;; When I an able to identify the
+				;; When I am able to identify the
 				;; connection to the server AND I've
 				;; received NO reponse for
 				;; nntp-connection-timeout seconds.
@@ -738,7 +764,7 @@ command whose response triggered the error."
          (nnheader-fold-continuation-lines)
          ;; Remove all "\r"'s.
          (nnheader-strip-cr)
-         (copy-to-buffer nntp-server-buffer (point-min) (point-max))
+	 (nntp-copy-to-buffer nntp-server-buffer (point-min) (point-max))
          'headers)))))
 
 (deffoo nntp-retrieve-groups (groups &optional server)
@@ -820,7 +846,8 @@ command whose response triggered the error."
 
            (if (not nntp-server-list-active-group)
                (progn
-                 (copy-to-buffer nntp-server-buffer (point-min) (point-max))
+		 (nntp-copy-to-buffer nntp-server-buffer
+				      (point-min) (point-max))
                  'group)
              ;; We have read active entries, so we just delete the
              ;; superfluous gunk.
@@ -828,7 +855,7 @@ command whose response triggered the error."
              (while (re-search-forward "^[.2-5]" nil t)
                (delete-region (match-beginning 0)
                               (progn (forward-line 1) (point))))
-             (copy-to-buffer nntp-server-buffer (point-min) (point-max))
+	     (nntp-copy-to-buffer nntp-server-buffer (point-min) (point-max))
              'active)))))))
 
 (deffoo nntp-retrieve-articles (articles &optional group server)
@@ -893,7 +920,7 @@ command whose response triggered the error."
           (narrow-to-region
            (setq point (goto-char (point-max)))
            (progn
-             (insert-buffer-substring buf last-point (cdr entry))
+	     (nntp-insert-buffer-substring buf last-point (cdr entry))
              (point-max)))
           (setq last-point (cdr entry))
           (nntp-decode-text)
@@ -1206,7 +1233,7 @@ password contained in '~/.nntp-authinfo'."
       (format " *server %s %s %s*"
 	      nntp-address nntp-port-number
 	      (gnus-buffer-exists-p buffer))))
-    (mm-enable-multibyte)
+    (mm-disable-multibyte)
     (set (make-local-variable 'after-change-functions) nil)
     (set (make-local-variable 'nntp-process-wait-for) nil)
     (set (make-local-variable 'nntp-process-callback) nil)
@@ -1390,7 +1417,7 @@ password contained in '~/.nntp-authinfo'."
 		(goto-char (point-max))
 		(save-restriction
 		  (narrow-to-region (point) (point))
-		  (insert-buffer-substring buf start)
+		  (nntp-insert-buffer-substring buf start)
 		  (when decode
 		    (nntp-decode-text))))))
 	  ;; report it.
@@ -1619,7 +1646,7 @@ password contained in '~/.nntp-authinfo'."
 	(when in-process-buffer-p
 	  (set-buffer buf)
 	  (goto-char (point-max))
-	  (insert-buffer-substring process-buffer)
+	  (nntp-insert-buffer-substring process-buffer)
 	  (set-buffer process-buffer)
 	  (erase-buffer)
 	  (set-buffer buf))
diff --git a/lisp/gnus/ntlm.el b/lisp/gnus/ntlm.el
deleted file mode 100644
index edea2c3048a..00000000000
--- a/lisp/gnus/ntlm.el
+++ /dev/null
@@ -1,537 +0,0 @@
-;;; ntlm.el --- NTLM (NT LanManager) authentication support
-
-;; Copyright (C) 2001 Taro Kawagishi
-;; Author: Taro Kawagishi <tarok@transpulse.org>
-;; Keywords: NTLM, SASL
-;; Version: 1.00
-;; Created: February 2001
-
-;; This program 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, or (at your option)
-;; any later version.
-;;
-;; This program 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 this program; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; This library is a direct translation of the Samba release 2.2.0
-;; implementation of Windows NT and LanManager compatible password
-;; encryption.
-;; 
-;; Interface functions:
-;; 
-;; ntlm-build-auth-request
-;;   This will return a binary string, which should be used in the
-;;   base64 encoded form and it is the caller's responsibility to encode
-;;   the returned string with base64.
-;;
-;; ntlm-build-auth-response
-;;   It is the caller's responsibility to pass a base64 decoded string
-;;   (which will be a binary string) as the first argument and to
-;;   encode the returned string with base64.  The second argument user
-;;   should be given in user@domain format.
-;; 
-;; ntlm-get-password-hashes
-;;
-;;
-;; NTLM authentication procedure example:
-;;
-;;  1. Open a network connection to the Exchange server at the IMAP port (143)
-;;  2. Receive an opening message such as:
-;;     "* OK Microsoft Exchange IMAP4rev1 server version 5.5.2653.7 (XXXX) ready"
-;;  3. Ask for IMAP server capability by sending "NNN capability"
-;;  4. Receive a capability message such as:
-;;     "* CAPABILITY IMAP4 IMAP4rev1 IDLE LITERAL+ LOGIN-REFERRALS MAILBOX-REFERRALS NAMESPACE AUTH=NTLM"
-;;  5. Ask for NTLM authentication by sending a string
-;;     "NNN authenticate ntlm"
-;;  6. Receive continuation acknowledgment "+"
-;;  7. Send NTLM authentication request generated by 'ntlm-build-auth-request
-;;  8. Receive NTLM challenge string following acknowledgment "+"
-;;  9. Generate response to challenge by 'ntlm-build-auth-response
-;;     (here two hash function values of the user password are encrypted)
-;; 10. Receive authentication completion message such as
-;;     "NNN OK AUTHENTICATE NTLM completed."
-
-;;; Code:
-
-(require 'md4)
-
-;;;
-;;; NTLM authentication interface functions
-
-(defun ntlm-build-auth-request (user &optional domain)
-  "Return the NTLM authentication request string for USER and DOMAIN.
-USER is a string representing a user name to be authenticated and
-DOMAIN is a NT domain.  USER can include a NT domain part as in
-user@domain where the string after @ is used as the domain if DOMAIN
-is not given."
-  (interactive)
-  (let ((request-ident (concat "NTLMSSP" (make-string 1 0)))
-	(request-msgType (concat (make-string 1 1) (make-string 3 0)))
-					;0x01 0x00 0x00 0x00
-	(request-flags (concat (make-string 1 7) (make-string 1 178)
-			       (make-string 2 0)))
-					;0x07 0xb2 0x00 0x00
-	lu ld off-d off-u)
-    (when (string-match "@" user)
-      (unless domain
-	(setq domain (substring user (1+ (match-beginning 0)))))
-      (setq user (substring user 0 (match-beginning 0))))
-    ;; set fields offsets within the request struct
-    (setq lu (length user))
-    (setq ld (length domain))
-    (setq off-u 32)			;offset to the string 'user
-    (setq off-d (+ 32 lu))		;offset to the string 'domain
-    ;; pack the request struct in a string
-    (concat request-ident		;8 bytes
-	    request-msgType	;4 bytes
-	    request-flags		;4 bytes
-	    (md4-pack-int16 lu)	;user field, count field
-	    (md4-pack-int16 lu)	;user field, max count field
-	    (md4-pack-int32 (cons 0 off-u)) ;user field, offset field
-	    (md4-pack-int16 ld)	;domain field, count field
-	    (md4-pack-int16 ld)	;domain field, max count field
-	    (md4-pack-int32 (cons 0 off-d)) ;domain field, offset field
-	    user			;bufer field
-	    domain		;bufer field
-	    )))
-
-(eval-when-compile
-  (defmacro ntlm-string-as-unibyte (string)
-    (if (fboundp 'string-as-unibyte)
-	`(string-as-unibyte ,string)
-      string)))
-
-(defun ntlm-build-auth-response (challenge user password-hashes)
-  "Return the response string to a challenge string CHALLENGE given by
-the NTLM based server for the user USER and the password hash list
-PASSWORD-HASHES.  NTLM uses two hash values which are represented
-by PASSWORD-HASHES.  PASSWORD-HASHES should be a return value of
- (list (ntlm-smb-passwd-hash password) (ntlm-md4hash password))"
-  (let* ((rchallenge (ntlm-string-as-unibyte challenge))
-	 ;; get fields within challenge struct
-	 ;;(ident (substring rchallenge 0 8))	;ident, 8 bytes
-	 ;;(msgType (substring rchallenge 8 12))	;msgType, 4 bytes
-	 (uDomain (substring rchallenge 12 20))	;uDomain, 8 bytes
-	 (flags (substring rchallenge 20 24))	;flags, 4 bytes
-	 (challengeData (substring rchallenge 24 32)) ;challengeData, 8 bytes
-	 uDomain-len uDomain-offs
-	 ;; response struct and its fields
-	 lmRespData			;lmRespData, 24 bytes
-	 ntRespData			;ntRespData, 24 bytes
-	 domain				;ascii domain string
-	 lu ld off-lm off-nt off-d off-u off-w off-s)
-    ;; extract domain string from challenge string
-    (setq uDomain-len (md4-unpack-int16 (substring uDomain 0 2)))
-    (setq uDomain-offs (md4-unpack-int32 (substring uDomain 4 8)))
-    (setq domain
-	  (ntlm-unicode2ascii (substring challenge
-					 (cdr uDomain-offs)
-					 (+ (cdr uDomain-offs) uDomain-len))
-			      (/ uDomain-len 2)))
-    ;; overwrite domain in case user is given in <user>@<domain> format
-    (when (string-match "@" user)
-      (setq domain (substring user (1+ (match-beginning 0))))
-      (setq user (substring user 0 (match-beginning 0))))
-
-    ;; generate response data
-    (setq lmRespData
-	  (ntlm-smb-owf-encrypt (car password-hashes) challengeData))
-    (setq ntRespData
-	  (ntlm-smb-owf-encrypt (cadr password-hashes) challengeData))
-
-    ;; get offsets to fields to pack the response struct in a string
-    (setq lu (length user))
-    (setq ld (length domain))
-    (setq off-lm 64)			;offset to string 'lmResponse
-    (setq off-nt (+ 64 24))		;offset to string 'ntResponse
-    (setq off-d (+ 64 48))		;offset to string 'uDomain
-    (setq off-u (+ 64 48 (* 2 ld)))	;offset to string 'uUser
-    (setq off-w (+ 64 48 (* 2 (+ ld lu)))) ;offset to string 'uWks
-    (setq off-s (+ 64 48 (* 2 (+ ld lu lu)))) ;offset to string 'sessionKey
-    ;; pack the response struct in a string
-    (concat "NTLMSSP\0"			;response ident field, 8 bytes
-	    (md4-pack-int32 '(0 . 3))	;response msgType field, 4 bytes
-
-	    ;; lmResponse field, 8 bytes
-	    ;;AddBytes(response,lmResponse,lmRespData,24);
-	    (md4-pack-int16 24)		;len field
-	    (md4-pack-int16 24)		;maxlen field
-	    (md4-pack-int32 (cons 0 off-lm)) ;field offset
-
-	    ;; ntResponse field, 8 bytes
-	    ;;AddBytes(response,ntResponse,ntRespData,24);
-	    (md4-pack-int16 24)		;len field
-	    (md4-pack-int16 24)		;maxlen field
-	    (md4-pack-int32 (cons 0 off-nt)) ;field offset
-
-	    ;; uDomain field, 8 bytes
-	    ;;AddUnicodeString(response,uDomain,domain);
-	    ;;AddBytes(response, uDomain, udomain, 2*ld);
-	    (md4-pack-int16 (* 2 ld))	;len field
-	    (md4-pack-int16 (* 2 ld))	;maxlen field
-	    (md4-pack-int32 (cons 0 off-d)) ;field offset
-
-	    ;; uUser field, 8 bytes
-	    ;;AddUnicodeString(response,uUser,u);
-	    ;;AddBytes(response, uUser, uuser, 2*lu);
-	    (md4-pack-int16 (* 2 lu))	;len field
-	    (md4-pack-int16 (* 2 lu))	;maxlen field
-	    (md4-pack-int32 (cons 0 off-u)) ;field offset
-
-	    ;; uWks field, 8 bytes
-	    ;;AddUnicodeString(response,uWks,u);
-	    (md4-pack-int16 (* 2 lu))	;len field
-	    (md4-pack-int16 (* 2 lu))	;maxlen field
-	    (md4-pack-int32 (cons 0 off-w)) ;field offset
-
-	    ;; sessionKey field, 8 bytes
-	    ;;AddString(response,sessionKey,NULL);
-	    (md4-pack-int16 0)		;len field
-	    (md4-pack-int16 0)		;maxlen field
-	    (md4-pack-int32 (cons 0 (- off-s off-lm))) ;field offset
-
-	    ;; flags field, 4 bytes
-	    flags			;
-
-	    ;; buffer field
-	    lmRespData			;lmResponse, 24 bytes
-	    ntRespData			;ntResponse, 24 bytes
-	    (ntlm-ascii2unicode domain	;unicode domain string, 2*ld bytes
-				(length domain)) ;
-	    (ntlm-ascii2unicode user	;unicode user string, 2*lu bytes
-				(length user)) ;
-	    (ntlm-ascii2unicode user	;unicode user string, 2*lu bytes
-				(length user)) ;
-	    )))
-
-(defun ntlm-get-password-hashes (password)
-  "Return a pair of SMB hash and NT MD4 hash of the given password PASSWORD"
-  (list (ntlm-smb-passwd-hash password)
-	(ntlm-md4hash password)))
-
-(defun ntlm-ascii2unicode (str len)
-  "Convert an ASCII string into a NT Unicode string, which is
-little-endian utf16."
-  (let ((utf (make-string (* 2 len) 0)) (i 0) val)
-    (while (and (< i len)
-		(not (zerop (setq val (aref str i)))))
-      (aset utf (* 2 i) val)
-      (aset utf (1+ (* 2 i)) 0)
-      (setq i (1+ i)))
-    utf))
-
-(defun ntlm-unicode2ascii (str len)
-  "Extract 7 bits ASCII part of a little endian utf16 string STR of length LEN."
-  (let ((buf (make-string len 0)) (i 0) (j 0))
-    (while (< i len)
-      (aset buf i (logand (aref str j) 127)) ;(string-to-number "7f" 16)
-      (setq i (1+ i)
-	    j (+ 2 j)))
-    buf))
-
-(defun ntlm-smb-passwd-hash (passwd)
-  "Return the SMB password hash string of 16 bytes long for the given password
-string PASSWD.  PASSWD is truncated to 14 bytes if longer."
-  (let ((len (min (length passwd) 14)))
-    (ntlm-smb-des-e-p16
-     (concat (substring (upcase passwd) 0 len) ;fill top 14 bytes with passwd
-	     (make-string (- 15 len) 0)))))
-
-(defun ntlm-smb-owf-encrypt (passwd c8)
-  "Return the response string of 24 bytes long for the given password
-string PASSWD based on the DES encryption.  PASSWD is of at most 14
-bytes long and the challenge string C8 of 8 bytes long."
-  (let ((len (min (length passwd) 16)) p22)
-    (setq p22 (concat (substring passwd 0 len) ;fill top 16 bytes with passwd
-		      (make-string (- 22 len) 0)))
-    (ntlm-smb-des-e-p24 p22 c8)))
-
-(defun ntlm-smb-des-e-p24 (p22 c8)
-  "Return a 24 bytes hashed string for a 21 bytes string P22 and a 8 bytes
-string C8."
-  (concat (ntlm-smb-hash c8 p22 t)		;hash first 8 bytes of p22
-	  (ntlm-smb-hash c8 (substring p22 7) t)
-	  (ntlm-smb-hash c8 (substring p22 14) t)))
-
-(defconst ntlm-smb-sp8 [75 71 83 33 64 35 36 37])
-
-(defun ntlm-smb-des-e-p16 (p15)
-  "Return a 16 bytes hashed string for a 15 bytes string P15."
-  (concat (ntlm-smb-hash ntlm-smb-sp8 p15 t)	;hash of first 8 bytes of p15
-	  (ntlm-smb-hash ntlm-smb-sp8		;hash of last 8 bytes of p15
-			 (substring p15 7) t)))
-
-(defun ntlm-smb-hash (in key forw)
-  "Return the hash string of length 8 for a string IN of length 8 and
-a string KEY of length 8.  FORW is t or nil."
-  (let ((out (make-string 8 0))
-	outb				;string of length 64
-	(inb (make-string 64 0))
-	(keyb (make-string 64 0))
-	(key2 (ntlm-smb-str-to-key key))
-	(i 0) aa)
-    (while (< i 64)
-      (unless (zerop (logand (aref in (/ i 8)) (lsh 1 (- 7 (% i 8)))))
-	(aset inb i 1))
-      (unless (zerop (logand (aref key2 (/ i 8)) (lsh 1 (- 7 (% i 8)))))
-	(aset keyb i 1))
-      (setq i (1+ i)))
-    (setq outb (ntlm-smb-dohash inb keyb forw))
-    (setq i 0)
-    (while (< i 64)
-      (unless (zerop (aref outb i))
-	(setq aa (aref out (/ i 8)))
-	(aset out (/ i 8)
-	      (logior aa (lsh 1 (- 7 (% i 8))))))
-      (setq i (1+ i)))
-    out))
-
-(defun ntlm-smb-str-to-key (str)
-  "Return a string of length 8 for the given string STR of length 7."
-  (let ((key (make-string 8 0))
-	(i 7))
-    (aset key 0 (lsh (aref str 0) -1))
-    (aset key 1 (logior
-		 (lsh (logand (aref str 0) 1) 6)
-		 (lsh (aref str 1) -2)))
-    (aset key 2 (logior
-		 (lsh (logand (aref str 1) 3) 5)
-		 (lsh (aref str 2) -3)))
-    (aset key 3 (logior
-		 (lsh (logand (aref str 2) 7) 4)
-		 (lsh (aref str 3) -4)))
-    (aset key 4 (logior
-		 (lsh (logand (aref str 3) 15) 3)
-		 (lsh (aref str 4) -5)))
-    (aset key 5 (logior
-		 (lsh (logand (aref str 4) 31) 2)
-		 (lsh (aref str 5) -6)))
-    (aset key 6 (logior
-		 (lsh (logand (aref str 5) 63) 1)
-		 (lsh (aref str 6) -7)))
-    (aset key 7 (logand (aref str 6) 127))
-    (while (>= i 0)
-      (aset key i (lsh (aref key i) 1))
-      (setq i (1- i)))
-    key))
-
-(defconst ntlm-smb-perm1 [57 49 41 33 25 17  9
-		     1 58 50 42 34 26 18
-		     10  2 59 51 43 35 27
-		     19 11  3 60 52 44 36
-		     63 55 47 39 31 23 15
-		     7 62 54 46 38 30 22
-		     14  6 61 53 45 37 29
-		     21 13  5 28 20 12  4])
-
-(defconst ntlm-smb-perm2 [14 17 11 24  1  5
-		     3 28 15  6 21 10
-		     23 19 12  4 26  8
-		     16  7 27 20 13  2
-		     41 52 31 37 47 55
-		     30 40 51 45 33 48
-		     44 49 39 56 34 53
-		     46 42 50 36 29 32])
-
-(defconst ntlm-smb-perm3 [58 50 42 34 26 18 10  2
-		     60 52 44 36 28 20 12  4
-		     62 54 46 38 30 22 14  6
-		     64 56 48 40 32 24 16  8
-		     57 49 41 33 25 17  9  1
-		     59 51 43 35 27 19 11  3
-		     61 53 45 37 29 21 13  5
-		     63 55 47 39 31 23 15  7])
-
-(defconst ntlm-smb-perm4 [32  1  2  3  4  5
-		     4  5  6  7  8  9
-		     8  9 10 11 12 13
-		     12 13 14 15 16 17
-		     16 17 18 19 20 21
-		     20 21 22 23 24 25
-		     24 25 26 27 28 29
-		     28 29 30 31 32  1])
-
-(defconst ntlm-smb-perm5 [16  7 20 21
-		     29 12 28 17
-		     1 15 23 26
-		     5 18 31 10
-		     2  8 24 14
-		     32 27  3  9
-		     19 13 30  6
-		     22 11  4 25])
-
-(defconst ntlm-smb-perm6 [40  8 48 16 56 24 64 32
-		     39  7 47 15 55 23 63 31
-		     38  6 46 14 54 22 62 30
-		     37  5 45 13 53 21 61 29
-		     36  4 44 12 52 20 60 28
-		     35  3 43 11 51 19 59 27
-		     34  2 42 10 50 18 58 26
-		     33  1 41  9 49 17 57 25])
-
-(defconst ntlm-smb-sc [1 1 2 2 2 2 2 2 1 2 2 2 2 2 2 1])
-
-(defconst ntlm-smb-sbox [[[14  4 13  1  2 15 11  8  3 10  6 12  5  9  0  7]
-		     [ 0 15  7  4 14  2 13  1 10  6 12 11  9  5  3  8]
-		     [ 4  1 14  8 13  6  2 11 15 12  9  7  3 10  5  0]
-		     [15 12  8  2  4  9  1  7  5 11  3 14 10  0  6 13]]
-		    [[15  1  8 14  6 11  3  4  9  7  2 13 12  0  5 10]
-		     [ 3 13  4  7 15  2  8 14 12  0  1 10  6  9 11  5]
-		     [ 0 14  7 11 10  4 13  1  5  8 12  6  9  3  2 15]
-		     [13  8 10  1  3 15  4  2 11  6  7 12  0  5 14  9]]
-		    [[10  0  9 14  6  3 15  5  1 13 12  7 11  4  2  8]
-		     [13  7  0  9  3  4  6 10  2  8  5 14 12 11 15  1]
-		     [13  6  4  9  8 15  3  0 11  1  2 12  5 10 14  7]
-		     [ 1 10 13  0  6  9  8  7  4 15 14  3 11  5  2 12]]
-		    [[ 7 13 14  3  0  6  9 10  1  2  8  5 11 12  4 15]
-		     [13  8 11  5  6 15  0  3  4  7  2 12  1 10 14  9]
-		     [10  6  9  0 12 11  7 13 15  1  3 14  5  2  8  4]
-		     [ 3 15  0  6 10  1 13  8  9  4  5 11 12  7  2 14]]
-		    [[ 2 12  4  1  7 10 11  6  8  5  3 15 13  0 14  9]
-		     [14 11  2 12  4  7 13  1  5  0 15 10  3  9  8  6]
-		     [ 4  2  1 11 10 13  7  8 15  9 12  5  6  3  0 14]
-		     [11  8 12  7  1 14  2 13  6 15  0  9 10  4  5  3]]
-		    [[12  1 10 15  9  2  6  8  0 13  3  4 14  7  5 11]
-		     [10 15  4  2  7 12  9  5  6  1 13 14  0 11  3  8]
-		     [ 9 14 15  5  2  8 12  3  7  0  4 10  1 13 11  6]
-		     [ 4  3  2 12  9  5 15 10 11 14  1  7  6  0  8 13]]
-		    [[ 4 11  2 14 15  0  8 13  3 12  9  7  5 10  6  1]
-		     [13  0 11  7  4  9  1 10 14  3  5 12  2 15  8  6]
-		     [ 1  4 11 13 12  3  7 14 10 15  6  8  0  5  9  2]
-		     [ 6 11 13  8  1  4 10  7  9  5  0 15 14  2  3 12]]
-		    [[13  2  8  4  6 15 11  1 10  9  3 14  5  0 12  7]
-		     [ 1 15 13  8 10  3  7  4 12  5  6 11  0 14  9  2]
-		     [ 7 11  4  1  9 12 14  2  0  6 10 13 15  3  5  8]
-		     [ 2  1 14  7  4 10  8 13 15 12  9  0  3  5  6 11]]])
-
-(defsubst ntlm-string-permute (in perm n)
-  "Return a string of length N for a string IN and a permutation vector
-PERM of size N.  The length of IN should be height of PERM."
-  (let ((i 0) (out (make-string n 0)))
-    (while (< i n)
-      (aset out i (aref in (- (aref perm i) 1)))
-      (setq i (1+ i)))
-    out))
-
-(defsubst ntlm-string-lshift (str count len)
-  "Return a string by circularly shifting a string STR by COUNT to the left.
-length of STR is LEN."
-  (let ((c (% count len)))
-    (concat (substring str c len) (substring str 0 c))))
-
-(defsubst ntlm-string-xor (in1 in2 n)
-  "Return exclusive-or of sequences in1 and in2"
-  (let ((w (make-string n 0)) (i 0))
-    (while (< i n)
-      (aset w i (logxor (aref in1 i) (aref in2 i)))
-      (setq i (1+ i)))
-    w))
-
-(defun ntlm-smb-dohash (in key forw)
-  "Return the hash value for a string IN and a string KEY.
-Length of IN and KEY are 64.  FORW non nill means forward, nil means
-backward."
-  (let (pk1				;string of length 56
-	c				;string of length 28
-	d				;string of length 28
-	cd				;string of length 56
-	(ki (make-vector 16 0))		;vector of string of length 48
-	pd1				;string of length 64
-	l				;string of length 32
-	r				;string of length 32
-	rl				;string of length 64
-	(i 0) (j 0) (k 0))
-    (setq pk1 (ntlm-string-permute key ntlm-smb-perm1 56))
-    (setq c (substring pk1 0 28))
-    (setq d (substring pk1 28 56))
-
-    (setq i 0)
-    (while (< i 16)
-      (setq c (ntlm-string-lshift c (aref ntlm-smb-sc i) 28))
-      (setq d (ntlm-string-lshift d (aref ntlm-smb-sc i) 28))
-      (setq cd (concat (substring c 0 28) (substring d 0 28)))
-      (aset ki i (ntlm-string-permute cd ntlm-smb-perm2 48))
-      (setq i (1+ i)))
-
-    (setq pd1 (ntlm-string-permute in ntlm-smb-perm3 64))
-
-    (setq l (substring pd1 0 32))
-    (setq r (substring pd1 32 64))
-
-    (setq i 0)
-    (let (er				;string of length 48
-	  erk				;string of length 48
-	  (b (make-vector 8 0))		;vector of strings of length 6
-	  cb				;string of length 32
-	  pcb				;string of length 32
-	  r2				;string of length 32
-	  jj m n bj sbox-jmn)
-      (while (< i 16)
-	(setq er (ntlm-string-permute r ntlm-smb-perm4 48))
-	(setq erk (ntlm-string-xor er
-		       (aref ki (if forw i (- 15 i)))
-		       48))
-	(setq j 0)
-	(while (< j 8)
-	  (setq jj (* 6 j))
-	  (aset b j (substring erk jj (+ jj 6)))
-	  (setq j (1+ j)))
-	(setq j 0)
-	(while (< j 8)
-	  (setq bj (aref b j))
-	  (setq m (logior (lsh (aref bj 0) 1) (aref bj 5)))
-	  (setq n (logior (lsh (aref bj 1) 3)
-			  (lsh (aref bj 2) 2)
-			  (lsh (aref bj 3) 1)
-			  (aref bj 4)))
-	  (setq k 0)
-	  (setq sbox-jmn (aref (aref (aref ntlm-smb-sbox j) m) n))
-	  (while (< k 4)
-	    (aset bj k
-		  (if (zerop (logand sbox-jmn (lsh 1 (- 3 k))))
-		      0 1))
-	    (setq k (1+ k)))
-	  (setq j (1+ j)))
-
-	(setq j 0)
-	(setq cb nil)
-	(while (< j 8)
-	  (setq cb (concat cb (substring (aref b j) 0 4)))
-	  (setq j (1+ j)))
-
-	(setq pcb (ntlm-string-permute cb ntlm-smb-perm5 32))
-	(setq r2 (ntlm-string-xor l pcb 32))
-	(setq l r)
-	(setq r r2)
-	(setq i (1+ i))))
-    (setq rl (concat r l))
-    (ntlm-string-permute rl ntlm-smb-perm6 64)))
-
-(defun ntlm-md4hash (passwd)
-  "Return the 16 bytes MD4 hash of a string PASSWD after converting it
-into a Unicode string.  PASSWD is truncated to 128 bytes if longer."
-  (let (len wpwd)
-    ;; Password cannot be longer than 128 characters
-    (setq len (length passwd))
-    (if (> len 128)
-	(setq len 128))
-    ;; Password must be converted to NT unicode
-    (setq wpwd (ntlm-ascii2unicode passwd len))
-    ;; Calculate length in bytes
-    (setq len (* len 2))
-    (md4 wpwd len)))
-
-(provide 'ntlm)
-
-;;; arch-tag: 348ace18-f8e2-4176-8fe9-d9ab4e96f296
-;;; ntlm.el ends here
diff --git a/lisp/gnus/password.el b/lisp/gnus/password.el
deleted file mode 100644
index 32ab76052d9..00000000000
--- a/lisp/gnus/password.el
+++ /dev/null
@@ -1,140 +0,0 @@
-;;; password.el --- Read passwords from user, possibly using a password cache.
-
-;; Copyright (C) 1999, 2000, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
-
-;; Author: Simon Josefsson <simon@josefsson.org>
-;; Created: 2003-12-21
-;; Keywords: password cache passphrase key
-
-;; 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, 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; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; Greatly influenced by pgg.el written by Daiki Ueno, with timer
-;; fixes for XEmacs by Katsumi Yamaoka.  In fact, this is mostly just
-;; a rip-off.
-;;
-;; (password-read "Password? " "test")
-;; ;; Minibuffer prompt for password.
-;;  => "foo"
-;;
-;; (password-cache-add "test" "foo")
-;;  => nil
-
-;; Note the previous two can be replaced with:
-;; (password-read-and-add "Password? " "test")
-;; ;; Minibuffer prompt for password.
-;; => "foo"
-;; ;; "foo" is now cached with key "test"
-
-
-;; (password-read "Password? " "test")
-;; ;; No minibuffer prompt
-;;  => "foo"
-;;
-;; (password-read "Password? " "test")
-;; ;; No minibuffer prompt
-;;  => "foo"
-;;
-;; ;; Wait `password-cache-expiry' seconds.
-;;
-;; (password-read "Password? " "test")
-;; ;; Minibuffer prompt for password is back.
-;;  => "foo"
-
-;;; Code:
-
-(eval-when-compile
-  (require 'cl))
-
-(defcustom password-cache t
-  "Whether to cache passwords."
-  :group 'password
-  :type 'boolean)
-
-(defcustom password-cache-expiry 16
-  "How many seconds passwords are cached, or nil to disable expiring.
-Whether passwords are cached at all is controlled by `password-cache'."
-  :group 'password
-  :type '(choice (const :tag "Never" nil)
-		 (integer :tag "Seconds")))
-
-(defvar password-data (make-vector 7 0))
-
-(defun password-read-from-cache (key)
-  "Obtain passphrase for KEY from time-limited passphrase cache.
-Custom variables `password-cache' and `password-cache-expiry'
-regulate cache behavior."
-  (and password-cache
-       key
-       (symbol-value (intern-soft key password-data))))
-
-(defun password-read (prompt &optional key)
-  "Read password, for use with KEY, from user, or from cache if wanted.
-KEY indicate the purpose of the password, so the cache can
-separate passwords.  The cache is not used if KEY is nil.  It is
-typically a string.
-The variable `password-cache' control whether the cache is used."
-  (or (password-read-from-cache key)
-      (read-passwd prompt)))
-
-(defun password-read-and-add (prompt &optional key)
-  "Read password, for use with KEY, from user, or from cache if wanted.
-Then store the password in the cache.  Uses `password-read' and
-`password-cache-add'.
-Custom variables `password-cache' and `password-cache-expiry'
-regulate cache behavior."
-  (let ((password (password-read prompt key)))
-    (when (and password key)
-      (password-cache-add key password))
-    password))
-
-(defun password-cache-remove (key)
-  "Remove password indexed by KEY from password cache.
-This is typically run be a timer setup from `password-cache-add',
-but can be invoked at any time to forcefully remove passwords
-from the cache.  This may be useful when it has been detected
-that a password is invalid, so that `password-read' query the
-user again."
-  (let ((password (symbol-value (intern-soft key password-data))))
-    (when password
-      (if (fboundp 'clear-string)
-	  (clear-string password)
-	(fillarray password ?_))
-      (unintern key password-data))))
-
-(defun password-cache-add (key password)
-  "Add password to cache.
-The password is removed by a timer after `password-cache-expiry'
-seconds."
-  (when (and password-cache-expiry (null (intern-soft key password-data)))
-    (run-at-time password-cache-expiry nil
-		 #'password-cache-remove
-		 key))
-  (set (intern key password-data) password)
-  nil)
-
-(defun password-reset ()
-  "Clear the password cache."
-  (interactive)
-  (fillarray password-data 0))
-
-(provide 'password)
-
-;;; arch-tag: ab160494-16c8-4c68-a4a1-73eebf6686e5
-;;; password.el ends here
diff --git a/lisp/gnus/pop3.el b/lisp/gnus/pop3.el
index c8e309d8c14..d152c2480ad 100644
--- a/lisp/gnus/pop3.el
+++ b/lisp/gnus/pop3.el
@@ -36,6 +36,7 @@
 ;;; Code:
 
 (require 'mail-utils)
+(defvar parse-time-months)
 
 (defgroup pop3 nil
   "Post Office Protocol."
@@ -241,16 +242,23 @@ Returns the process associated with the connection."
 					      mailhost port)))
 		(when process
 		  ;; There's a load of info printed that needs deleting.
-		  (while (when (memq (process-status process) '(open run))
-			   (pop3-accept-process-output process)
-			   (goto-char (point-max))
-			   (forward-line -1)
-			   (if (looking-at "\\+OK")
-			       (progn
-				 (delete-region (point-min) (point))
-				 nil)
+		  (let ((again 't))
+		    ;; repeat until
+		    ;; - either we received the +OK line
+		    ;; - or accept-process-output timed out without getting
+		    ;;   anything
+		    (while (and again
+				(setq again (memq (process-status process)
+						  '(open run))))
+		      (setq again (pop3-accept-process-output process))
+		      (goto-char (point-max))
+		      (forward-line -1)
+		      (cond ((looking-at "\\+OK")
+			     (setq again nil)
+			     (delete-region (point-min) (point)))
+			    ((not again)
 			     (pop3-quit process)
-			     (error "POP SSL connexion failed"))))
+			     (error "POP SSL connexion failed")))))
 		  process)))
 	     ((eq pop3-stream-type 'starttls)
 	      ;; gnutls-cli, openssl don't accept service names
@@ -327,8 +335,6 @@ Return the response string if optional second argument is non-nil."
       (forward-char)))
   (set-marker end nil))
 
-(eval-when-compile (defvar parse-time-months))
-
 ;; Copied from message-make-date.
 (defun pop3-make-date (&optional now)
   "Make a valid date header.
diff --git a/lisp/gnus/qp.el b/lisp/gnus/qp.el
index 5689a70f3ac..8ae34f193a1 100644
--- a/lisp/gnus/qp.el
+++ b/lisp/gnus/qp.el
@@ -31,7 +31,7 @@
 ;;; Code:
 
 (require 'mm-util)
-(eval-when-compile (defvar mm-use-ultra-safe-encoding))
+(defvar mm-use-ultra-safe-encoding)
 
 ;;;###autoload
 (defun quoted-printable-decode-region (from to &optional coding-system)
diff --git a/lisp/gnus/rfc2047.el b/lisp/gnus/rfc2047.el
index b789061853f..aa9999a7722 100644
--- a/lisp/gnus/rfc2047.el
+++ b/lisp/gnus/rfc2047.el
@@ -30,8 +30,8 @@
 ;;; Code:
 
 (eval-when-compile
-  (require 'cl)
-  (defvar message-posting-charset))
+  (require 'cl))
+(defvar message-posting-charset)
 
 (require 'qp)
 (require 'mm-util)
@@ -101,6 +101,40 @@ quoted-printable and base64 respectively.")
 (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
 ;;;
@@ -287,7 +321,6 @@ Should be called narrowed to the head of the message."
 
 ;; Fixme: This, and the require below may not be the Right Thing, but
 ;; should be safe just before release.  -- fx 2001-02-08
-(eval-when-compile (defvar message-posting-charset))
 
 (defun rfc2047-encodable-p ()
   "Return non-nil if any characters in current buffer need encoding in headers.
@@ -298,7 +331,7 @@ The buffer may be narrowed."
     (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))))))))
@@ -533,10 +566,19 @@ By default, the string is treated as containing addresses (see
     (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)
@@ -827,11 +869,6 @@ it, put the following line in your ~/.gnus.el file:
 ;;; 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.")
 
@@ -950,10 +987,12 @@ If ADDRESS-MIME is non-nil, strip backslashes which precede characters
 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
@@ -969,7 +1008,7 @@ other than `\"' and `\\' in quoted strings."
 	  (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.
diff --git a/lisp/gnus/sasl-cram.el b/lisp/gnus/sasl-cram.el
deleted file mode 100644
index b8b1ced82ac..00000000000
--- a/lisp/gnus/sasl-cram.el
+++ /dev/null
@@ -1,52 +0,0 @@
-;;; sasl-cram.el --- CRAM-MD5 module for the SASL client framework
-
-;; Copyright (C) 2000 Free Software Foundation, Inc.
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;;	Kenichi OKADA <okada@opaopa.org>
-;; Keywords: SASL, CRAM-MD5
-
-;; This file is part of FLIM (Faithful Library about Internet Message).
-
-;; This program 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, or (at
-;; your option) any later version.
-
-;; This program 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 this program; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-(require 'sasl)
-(require 'hmac-md5)
-
-(defconst sasl-cram-md5-steps
-  '(ignore				;no initial response
-    sasl-cram-md5-response))
-
-(defun sasl-cram-md5-response (client step)
-  (let ((passphrase
-	 (sasl-read-passphrase
-	  (format "CRAM-MD5 passphrase for %s: "
-		  (sasl-client-name client)))))
-    (unwind-protect
-	(concat (sasl-client-name client) " "
-		(encode-hex-string
-		 (hmac-md5 (sasl-step-data step) passphrase)))
-      (fillarray passphrase 0))))
-
-(put 'sasl-cram 'sasl-mechanism
-     (sasl-make-mechanism "CRAM-MD5" sasl-cram-md5-steps))
-
-(provide 'sasl-cram)
-
-;;; arch-tag: 46cb281b-975a-4fe0-a39f-3018691b1b05
-;;; sasl-cram.el ends here
diff --git a/lisp/gnus/sasl-digest.el b/lisp/gnus/sasl-digest.el
deleted file mode 100644
index c290c7524c8..00000000000
--- a/lisp/gnus/sasl-digest.el
+++ /dev/null
@@ -1,157 +0,0 @@
-;;; sasl-digest.el --- DIGEST-MD5 module for the SASL client framework
-
-;; Copyright (C) 2000 Free Software Foundation, Inc.
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;;	Kenichi OKADA <okada@opaopa.org>
-;; Keywords: SASL, DIGEST-MD5
-
-;; This file is part of FLIM (Faithful Library about Internet Message).
-
-;; This program 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, or (at
-;; your option) any later version.
-
-;; This program 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 this program; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;; This program is implemented from draft-leach-digest-sasl-05.txt.
-;;
-;; It is caller's responsibility to base64-decode challenges and
-;; base64-encode responses in IMAP4 AUTHENTICATE command.
-;;
-;; Passphrase should be longer than 16 bytes. (See RFC 2195)
-
-;;; Commentary:
-
-(require 'sasl)
-(require 'hmac-md5)
-
-(defvar sasl-digest-md5-nonce-count 1)
-(defvar sasl-digest-md5-unique-id-function
-  sasl-unique-id-function)
-
-(defvar sasl-digest-md5-syntax-table
-  (let ((table (make-syntax-table)))
-    (modify-syntax-entry ?= "." table)
-    (modify-syntax-entry ?, "." table)
-    table)
-  "A syntax table for parsing digest-challenge attributes.")
-
-(defconst sasl-digest-md5-steps
-  '(ignore				;no initial response
-    sasl-digest-md5-response
-    ignore))				;""
-
-(defun sasl-digest-md5-parse-string (string)
-  "Parse STRING and return a property list.
-The value is a cons cell of the form \(realm nonce qop-options stale maxbuf
-charset algorithm cipher-opts auth-param)."
-  (with-temp-buffer
-    (set-syntax-table sasl-digest-md5-syntax-table)
-    (save-excursion
-      (insert string)
-      (goto-char (point-min))
-      (insert "(")
-      (while (progn (forward-sexp) (not (eobp)))
-	(delete-char 1)
-	(insert " "))
-      (insert ")")
-      (read (point-min-marker)))))
-
-(defun sasl-digest-md5-digest-uri (serv-type host &optional serv-name)
-  (concat serv-type "/" host
-	  (if (and serv-name
-		   (not (string= host serv-name)))
-	      (concat "/" serv-name))))
-
-(defun sasl-digest-md5-cnonce ()
-  (let ((sasl-unique-id-function sasl-digest-md5-unique-id-function))
-    (sasl-unique-id)))
-
-(defun sasl-digest-md5-response-value (username
-				       realm
-				       nonce
-				       cnonce
-				       nonce-count
-				       qop
-				       digest-uri
-				       authzid)
-  (let ((passphrase
-	 (sasl-read-passphrase
-	  (format "DIGEST-MD5 passphrase for %s: "
-		  username))))
-    (unwind-protect
-	(encode-hex-string
-	 (md5-binary
-	  (concat
-	   (encode-hex-string
-	    (md5-binary (concat (md5-binary 
-				 (concat username ":" realm ":" passphrase))
-				":" nonce ":" cnonce
-				(if authzid 
-				    (concat ":" authzid)))))
-	   ":" nonce
-	   ":" (format "%08x" nonce-count) ":" cnonce ":" qop ":"
-	   (encode-hex-string
-	    (md5-binary
-	     (concat "AUTHENTICATE:" digest-uri
-		     (if (member qop '("auth-int" "auth-conf"))
-			 ":00000000000000000000000000000000")))))))
-      (fillarray passphrase 0))))
-
-(defun sasl-digest-md5-response (client step)
-  (let* ((plist
-	  (sasl-digest-md5-parse-string (sasl-step-data step)))
-	 (realm
-	  (or (sasl-client-property client 'realm)
-	      (plist-get plist 'realm))) ;need to check
-	 (nonce-count
-	  (or (sasl-client-property client 'nonce-count)
-	       sasl-digest-md5-nonce-count))
-	 (qop
-	  (or (sasl-client-property client 'qop)
-	      "auth"))
-	 (digest-uri
-	  (sasl-digest-md5-digest-uri
-	   (sasl-client-service client)(sasl-client-server client)))
-	 (cnonce
-	  (or (sasl-client-property client 'cnonce)
-	      (sasl-digest-md5-cnonce))))
-    (sasl-client-set-property client 'nonce-count (1+ nonce-count))
-    (unless (string= qop "auth")
-      (sasl-error (format "Unsupported \"qop-value\": %s" qop)))
-    (concat
-     "username=\"" (sasl-client-name client) "\","
-     "realm=\"" realm "\","
-     "nonce=\"" (plist-get plist 'nonce) "\","
-     "cnonce=\"" cnonce "\","
-     (format "nc=%08x," nonce-count)
-     "digest-uri=\"" digest-uri "\","
-     "qop=" qop ","
-     "response="
-     (sasl-digest-md5-response-value
-      (sasl-client-name client)
-      realm
-      (plist-get plist 'nonce)
-      cnonce
-      nonce-count
-      qop
-      digest-uri
-      (plist-get plist 'authzid)))))
-
-(put 'sasl-digest 'sasl-mechanism
-     (sasl-make-mechanism "DIGEST-MD5" sasl-digest-md5-steps))
-
-(provide 'sasl-digest)
-
-;;; arch-tag: 786e02ed-1bc4-4b3c-bf34-96c27e31084d
-;;; sasl-digest.el ends here
diff --git a/lisp/gnus/sasl-ntlm.el b/lisp/gnus/sasl-ntlm.el
deleted file mode 100644
index 784b373c056..00000000000
--- a/lisp/gnus/sasl-ntlm.el
+++ /dev/null
@@ -1,66 +0,0 @@
-;;; sasl-ntlm.el --- NTLM (NT Lan Manager) module for the SASL client framework
-
-;; Copyright (C) 2000 Free Software Foundation, Inc.
-
-;; Author: Taro Kawagishi <tarok@transpulse.org>
-;; Keywords: SASL, NTLM
-;; Version: 1.00
-;; Created: February 2001
-
-;; This program 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, or (at your option)
-;; any later version.
-;;
-;; This program 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 this program; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; This is a SASL interface layer for NTLM authentication message
-;; generation by ntlm.el
-
-;;; Code:
-
-(require 'sasl)
-(require 'ntlm)
-
-(defconst sasl-ntlm-steps
-  '(ignore				;nothing to do before making
-    sasl-ntlm-request			;authentication request
-    sasl-ntlm-response)			;response to challenge
-  "A list of functions to be called in sequnece for the NTLM
-authentication steps.  Ther are called by 'sasl-next-step.")
-
-(defun sasl-ntlm-request (client step)
-  "SASL step function to generate a NTLM authentication request to the server.
-Called from 'sasl-next-step.
-CLIENT is a vector [mechanism user service server sasl-client-properties]
-STEP is a vector [<previous step function> <result of previous step function>]"
-  (let ((user (sasl-client-name client)))
-    (ntlm-build-auth-request user)))
-
-(defun sasl-ntlm-response (client step)
-  "SASL step function to generate a NTLM response against the server
-challenge stored in the 2nd element of STEP.  Called from 'sasl-next-step."
-  (let* ((user (sasl-client-name client))
-	 (passphrase
-	  (sasl-read-passphrase (format "NTLM passphrase for %s: " user)))
-	 (challenge (sasl-step-data step)))
-    (ntlm-build-auth-response challenge user
-			      (ntlm-get-password-hashes passphrase))))
-
-(put 'sasl-ntlm 'sasl-mechanism
-     (sasl-make-mechanism "NTLM" sasl-ntlm-steps))
-
-(provide 'sasl-ntlm)
-
-;;; arch-tag: 1d9164c1-1df0-418f-b7ab-360157fd05dc
-;;; sasl-ntlm.el ends here
diff --git a/lisp/gnus/sasl.el b/lisp/gnus/sasl.el
deleted file mode 100644
index d730dddcb20..00000000000
--- a/lisp/gnus/sasl.el
+++ /dev/null
@@ -1,273 +0,0 @@
-;;; sasl.el --- SASL client framework
-
-;; Copyright (C) 2000 Free Software Foundation, Inc.
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Keywords: SASL
-
-;; This file is part of FLIM (Faithful Library about Internet Message).
-
-;; This program 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, or (at
-;; your option) any later version.
-
-;; This program 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 this program; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; This module provides common interface functions to share several
-;; SASL mechanism drivers.  The toplevel is designed to be mostly
-;; compatible with [Java-SASL].
-;;
-;; [SASL] J. Myers, "Simple Authentication and Security Layer (SASL)",
-;;	RFC 2222, October 1997.
-;;
-;; [Java-SASL] R. Weltman & R. Lee, "The Java SASL Application Program
-;;	Interface", draft-weltman-java-sasl-03.txt, March 2000.
-
-;;; Code:
-
-(defvar sasl-mechanisms
-  '("CRAM-MD5" "DIGEST-MD5" "PLAIN" "LOGIN" "ANONYMOUS"
-    "NTLM" "SCRAM-MD5"))
-
-(defvar sasl-mechanism-alist
-  '(("CRAM-MD5" sasl-cram)
-    ("DIGEST-MD5" sasl-digest)
-    ("PLAIN" sasl-plain)
-    ("LOGIN" sasl-login)
-    ("ANONYMOUS" sasl-anonymous)
-    ("NTLM" sasl-ntlm)
-    ("SCRAM-MD5" sasl-scram)))
-
-(defvar sasl-unique-id-function #'sasl-unique-id-function)
-
-(put 'sasl-error 'error-message "SASL error")
-(put 'sasl-error 'error-conditions '(sasl-error error))
-
-(defun sasl-error (datum)
-  (signal 'sasl-error (list datum)))
-
-;;; @ SASL client
-;;;
-
-(defun sasl-make-client (mechanism name service server)
-  "Return a newly allocated SASL client.
-NAME is name of the authorization.  SERVICE is name of the service desired.
-SERVER is the fully qualified host name of the server to authenticate to."
-  (vector mechanism name service server (make-symbol "sasl-client-properties")))
-
-(defun sasl-client-mechanism (client)
-  "Return the authentication mechanism driver of CLIENT."
-  (aref client 0))
-
-(defun sasl-client-name (client)
-  "Return the authorization name of CLIENT, a string."
-  (aref client 1))
-
-(defun sasl-client-service (client)
-  "Return the service name of CLIENT, a string."
-  (aref client 2))
-
-(defun sasl-client-server (client)
-  "Return the server name of CLIENT, a string."
-  (aref client 3))
-
-(defun sasl-client-set-properties (client plist)
-  "Destructively set the properties of CLIENT.
-The second argument PLIST is the new property list."
-  (setplist (aref client 4) plist))
-
-(defun sasl-client-set-property (client property value)
-  "Add the given property/value to CLIENT."
-  (put (aref client 4) property value))
-
-(defun sasl-client-property (client property)
-  "Return the value of the PROPERTY of CLIENT."
-  (get (aref client 4) property))
-
-(defun sasl-client-properties (client)
-  "Return the properties of CLIENT."
-  (symbol-plist (aref client 4)))
-
-;;; @ SASL mechanism
-;;;
-
-(defun sasl-make-mechanism (name steps)
-  "Make an authentication mechanism.
-NAME is a IANA registered SASL mechanism name.
-STEPS is list of continuation function."
-  (vector name
-	  (mapcar
-	   (lambda (step)
-	     (let ((symbol (make-symbol (symbol-name step))))
-	       (fset symbol (symbol-function step))
-	       symbol))
-	   steps)))
-
-(defun sasl-mechanism-name (mechanism)
-  "Return name of MECHANISM, a string."
-  (aref mechanism 0))
-
-(defun sasl-mechanism-steps (mechanism)
-  "Return the authentication steps of MECHANISM, a list of functions."
-  (aref mechanism 1))
-
-(defun sasl-find-mechanism (mechanisms)
-  "Retrieve an apropriate mechanism object from MECHANISMS hints."
-  (let* ((sasl-mechanisms sasl-mechanisms)
-	 (mechanism
-	  (catch 'done
-	    (while sasl-mechanisms
-	      (if (member (car sasl-mechanisms) mechanisms)
-		  (throw 'done (nth 1 (assoc (car sasl-mechanisms)
-					     sasl-mechanism-alist))))
-	      (setq sasl-mechanisms (cdr sasl-mechanisms))))))
-    (if mechanism
-	(require mechanism))
-    (get mechanism 'sasl-mechanism)))
-
-;;; @ SASL authentication step
-;;;
-
-(defun sasl-step-data (step)
-  "Return the data which STEP holds, a string."
-  (aref step 1))
-
-(defun sasl-step-set-data (step data)
-  "Store DATA string to STEP."
-  (aset step 1 data))
-
-(defun sasl-next-step (client step)
-  "Evaluate the challenge and prepare an appropriate next response.
-The data type of the value and optional 2nd argument STEP is nil or
-opaque authentication step which holds the reference to the next action
-and the current challenge.  At the first time STEP should be set to nil."
-  (let* ((steps
-	  (sasl-mechanism-steps
-	   (sasl-client-mechanism client)))
-	 (function
-	  (if (vectorp step)
-	      (nth 1 (memq (aref step 0) steps))
-	    (car steps))))
-    (if function
-	(vector function (funcall function client step)))))
-
-(defvar sasl-read-passphrase nil)
-(defun sasl-read-passphrase (prompt)
-  (if (not sasl-read-passphrase)
-      (if (functionp 'read-passwd)
-	  (setq sasl-read-passphrase 'read-passwd)
-	(if (load "passwd" t)
-	    (setq sasl-read-passphrase 'read-passwd)
-	  (autoload 'ange-ftp-read-passwd "ange-ftp")
-	  (setq sasl-read-passphrase 'ange-ftp-read-passwd))))
-  (funcall sasl-read-passphrase prompt))
-
-(defun sasl-unique-id ()
-  "Compute a data string which must be different each time.
-It contain at least 64 bits of entropy."
-  (concat (funcall sasl-unique-id-function)(funcall sasl-unique-id-function)))
-
-(defvar sasl-unique-id-char nil)
-
-;; stolen (and renamed) from message.el
-(defun sasl-unique-id-function ()
-  ;; Don't use microseconds from (current-time), they may be unsupported.
-  ;; Instead we use this randomly inited counter.
-  (setq sasl-unique-id-char
-	(% (1+ (or sasl-unique-id-char (logand (random t) (1- (lsh 1 20)))))
-	   ;; (current-time) returns 16-bit ints,
-	   ;; and 2^16*25 just fits into 4 digits i base 36.
-	   (* 25 25)))
-  (let ((tm (current-time)))
-    (concat
-     (sasl-unique-id-number-base36
-      (+ (car   tm)
-	 (lsh (% sasl-unique-id-char 25) 16)) 4)
-     (sasl-unique-id-number-base36
-      (+ (nth 1 tm)
-	 (lsh (/ sasl-unique-id-char 25) 16)) 4))))
-
-(defun sasl-unique-id-number-base36 (num len)
-  (if (if (< len 0)
-	  (<= num 0)
-	(= len 0))
-      ""
-    (concat (sasl-unique-id-number-base36 (/ num 36) (1- len))
-	    (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210"
-				  (% num 36))))))
-
-;;; PLAIN (RFC2595 Section 6)
-(defconst sasl-plain-steps
-  '(sasl-plain-response))
-
-(defun sasl-plain-response (client step)
-  (let ((passphrase
-	 (sasl-read-passphrase
-	  (format "PLAIN passphrase for %s: " (sasl-client-name client))))
-	(authenticator-name
-	 (sasl-client-property
-	  client 'authenticator-name))
-	(name (sasl-client-name client)))
-    (unwind-protect
-	(if (and authenticator-name
-		 (not (string= authenticator-name name)))
-	    (concat authenticator-name "\0" name "\0" passphrase)
-	  (concat "\0" name "\0" passphrase))
-      (fillarray passphrase 0))))
-
-(put 'sasl-plain 'sasl-mechanism
-     (sasl-make-mechanism "PLAIN" sasl-plain-steps))
-
-(provide 'sasl-plain)
-
-;;; LOGIN (No specification exists)
-(defconst sasl-login-steps
-  '(ignore				;no initial response
-    sasl-login-response-1
-    sasl-login-response-2))
-
-(defun sasl-login-response-1 (client step)
-;;;  (unless (string-match "^Username:" (sasl-step-data step))
-;;;    (sasl-error (format "Unexpected response: %s" (sasl-step-data step))))
-  (sasl-client-name client))
-
-(defun sasl-login-response-2 (client step)
-;;;  (unless (string-match "^Password:" (sasl-step-data step))
-;;;    (sasl-error (format "Unexpected response: %s" (sasl-step-data step))))
-  (sasl-read-passphrase
-   (format "LOGIN passphrase for %s: " (sasl-client-name client))))
-
-(put 'sasl-login 'sasl-mechanism
-     (sasl-make-mechanism "LOGIN" sasl-login-steps))
-
-(provide 'sasl-login)
-
-;;; ANONYMOUS (RFC2245)
-(defconst sasl-anonymous-steps
-  '(ignore				;no initial response
-    sasl-anonymous-response))
-
-(defun sasl-anonymous-response (client step)
-  (or (sasl-client-property client 'trace)
-      (sasl-client-name client)))
-
-(put 'sasl-anonymous 'sasl-mechanism
-     (sasl-make-mechanism "ANONYMOUS" sasl-anonymous-steps))
-
-(provide 'sasl-anonymous)
-
-(provide 'sasl)
-
-;;; arch-tag: 8b3326fa-4978-4fda-93e2-cb2c6255f887
-;;; sasl.el ends here
diff --git a/lisp/gnus/sha1.el b/lisp/gnus/sha1.el
deleted file mode 100644
index 146aa6374a0..00000000000
--- a/lisp/gnus/sha1.el
+++ /dev/null
@@ -1,442 +0,0 @@
-;;; sha1.el --- SHA1 Secure Hash Algorithm in Emacs-Lisp
-
-;; Copyright (C) 1999, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007 Free Software Foundation, Inc.
-
-;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
-;; Keywords: SHA1, FIPS 180-1
-
-;; This file is part of FLIM (Faithful Library about Internet Message).
-
-;; This program 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, or
-;; (at your option) any later version.
-
-;; This program 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 this program; see the file COPYING.  If not, write to
-;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; This program is implemented from the definition of SHA-1 in FIPS PUB
-;; 180-1 (Federal Information Processing Standards Publication 180-1),
-;; "Announcing the Standard for SECURE HASH STANDARD".
-;; <URL:http://www.itl.nist.gov/div897/pubs/fip180-1.htm>
-;; (EXCEPTION; two optimizations taken from GnuPG/cipher/sha1.c)
-;;
-;; Test cases from FIPS PUB 180-1.
-;;
-;; (sha1 "abc")
-;; => a9993e364706816aba3e25717850c26c9cd0d89d
-;;
-;; (sha1 "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq")
-;; => 84983e441c3bd26ebaae4aa1f95129e5e54670f1
-;;
-;; (sha1 (make-string 1000000 ?a))
-;; => 34aa973cd4c4daa4f61eeb2bdbad27316534016f
-;;
-;; BUGS:
-;;  * It is assumed that length of input string is less than 2^29 bytes.
-;;  * It is caller's responsibility to make string (or region) unibyte.
-;;
-;; TODO:
-;;  * Rewrite from scratch!
-;;    This version is much faster than Keiichi Suzuki's another sha1.el,
-;;    but it is too dirty.
-
-;;; Code:
-
-(require 'hex-util)
-
-;;;
-;;; external SHA1 function.
-;;;
-
-(defgroup sha1 nil
-  "Elisp interface for SHA1 hash computation."
-  :version "22.1"
-  :group 'extensions)
-
-(defcustom sha1-maximum-internal-length 500
-  "*Maximum length of message to use Lisp version of SHA1 function.
-If message is longer than this, `sha1-program' is used instead.
-
-If this variable is set to 0, use external program only.
-If this variable is set to nil, use internal function only."
-  :type 'integer
-  :group 'sha1)
-
-(defcustom sha1-program '("sha1sum")
-  "*Name of program to compute SHA1.
-It must be a string \(program name\) or list of strings \(name and its args\)."
-  :type '(repeat string)
-  :group 'sha1)
-
-(defcustom sha1-use-external (condition-case ()
-				 (executable-find (car sha1-program))
-			       (error))
-  "*Use external SHA1 program.
-If this variable is set to nil, use internal function only."
-  :type 'boolean
-  :group 'sha1)
-
-(defun sha1-string-external (string &optional binary)
-  (let (prog args digest default-enable-multibyte-characters)
-    (if (consp sha1-program)
-	(setq prog (car sha1-program)
-	      args (cdr sha1-program))
-      (setq prog sha1-program
-	    args nil))
-    (with-temp-buffer
-      (insert string)
-      (apply (function call-process-region)
-	     (point-min)(point-max)
-	     prog t t nil args)
-      ;; SHA1 is 40 bytes long in hexadecimal form.
-      (setq digest (buffer-substring (point-min)(+ (point-min) 40))))
-    (if binary
-	(decode-hex-string digest)
-      digest)))
-
-(defun sha1-region-external (beg end &optional binary)
-  (sha1-string-external (buffer-substring-no-properties beg end) binary))
-
-;;;
-;;; internal SHA1 function.
-;;;
-
-(eval-when-compile
-  ;; optional second arg of string-to-number is new in v20.
-  (defconst sha1-K0-high 23170)		; (string-to-number "5A82" 16)
-  (defconst sha1-K0-low  31129)		; (string-to-number "7999" 16)
-  (defconst sha1-K1-high 28377)		; (string-to-number "6ED9" 16)
-  (defconst sha1-K1-low  60321)		; (string-to-number "EBA1" 16)
-  (defconst sha1-K2-high 36635)		; (string-to-number "8F1B" 16)
-  (defconst sha1-K2-low  48348)		; (string-to-number "BCDC" 16)
-  (defconst sha1-K3-high 51810)		; (string-to-number "CA62" 16)
-  (defconst sha1-K3-low  49622)		; (string-to-number "C1D6" 16)
-
-  ;; original definition of sha1-F0.
-  ;; (defmacro sha1-F0 (B C D)
-  ;;   (` (logior (logand (, B) (, C))
-  ;; 	     (logand (lognot (, B)) (, D)))))
-  ;; a little optimization from GnuPG/cipher/sha1.c.
-  (defmacro sha1-F0 (B C D)
-    `(logxor ,D (logand ,B (logxor ,C ,D))))
-  (defmacro sha1-F1 (B C D)
-    `(logxor ,B ,C ,D))
-  ;; original definition of sha1-F2.
-  ;; (defmacro sha1-F2 (B C D)
-  ;;   (` (logior (logand (, B) (, C))
-  ;; 	     (logand (, B) (, D))
-  ;; 	     (logand (, C) (, D)))))
-  ;; a little optimization from GnuPG/cipher/sha1.c.
-  (defmacro sha1-F2 (B C D)
-    `(logior (logand ,B ,C)
-	       (logand ,D (logior ,B ,C))))
-  (defmacro sha1-F3 (B C D)
-    `(logxor ,B ,C ,D))
-
-  (defmacro sha1-S1  (W-high W-low)
-    `(let ((W-high ,W-high)
-           (W-low  ,W-low))
-	 (setq S1W-high (+ (% (* W-high 2) 65536)
-			   (/ W-low ,(/ 65536 2))))
-	 (setq S1W-low (+ (/ W-high ,(/ 65536 2))
-			  (% (* W-low 2) 65536)))))
-  (defmacro sha1-S5  (A-high A-low)
-    `(progn
-       (setq S5A-high (+ (% (* ,A-high 32) 65536)
-                         (/ ,A-low ,(/ 65536 32))))
-       (setq S5A-low  (+ (/ ,A-high ,(/ 65536 32))
-                         (% (* ,A-low 32) 65536)))))
-  (defmacro sha1-S30 (B-high B-low)
-    `(progn
-       (setq S30B-high (+ (/ ,B-high 4)
-                          (* (% ,B-low 4) ,(/ 65536 4))))
-       (setq S30B-low  (+ (/ ,B-low 4)
-                          (* (% ,B-high 4) ,(/ 65536 4))))))
-
-  (defmacro sha1-OP (round)
-    `(progn
-       (sha1-S5 sha1-A-high sha1-A-low)
-       (sha1-S30 sha1-B-high sha1-B-low)
-       (setq sha1-A-low (+ (,(intern (format "sha1-F%d" round))
-                            sha1-B-low sha1-C-low sha1-D-low)
-                           sha1-E-low
-                           ,(symbol-value
-                             (intern (format "sha1-K%d-low" round)))
-                           (aref block-low idx)
-                           (progn
-                             (setq sha1-E-low sha1-D-low)
-                             (setq sha1-D-low sha1-C-low)
-                             (setq sha1-C-low S30B-low)
-                             (setq sha1-B-low sha1-A-low)
-                             S5A-low)))
-       (setq carry (/ sha1-A-low 65536))
-       (setq sha1-A-low (% sha1-A-low 65536))
-       (setq sha1-A-high (% (+ (,(intern (format "sha1-F%d" round))
-                                sha1-B-high sha1-C-high sha1-D-high)
-                               sha1-E-high
-                               ,(symbol-value
-                                 (intern (format "sha1-K%d-high" round)))
-                               (aref block-high idx)
-                               (progn
-                                 (setq sha1-E-high sha1-D-high)
-                                 (setq sha1-D-high sha1-C-high)
-                                 (setq sha1-C-high S30B-high)
-                                 (setq sha1-B-high sha1-A-high)
-                                 S5A-high)
-                               carry)
-                            65536))))
-
-  (defmacro sha1-add-to-H (H X)
-    `(progn
-       (setq ,(intern (format "sha1-%s-low" H))
-             (+ ,(intern (format "sha1-%s-low" H))
-                ,(intern (format "sha1-%s-low" X))))
-       (setq carry (/ ,(intern (format "sha1-%s-low" H)) 65536))
-       (setq ,(intern (format "sha1-%s-low" H))
-             (% ,(intern (format "sha1-%s-low" H)) 65536))
-       (setq ,(intern (format "sha1-%s-high" H))
-             (% (+ ,(intern (format "sha1-%s-high" H))
-                   ,(intern (format "sha1-%s-high" X))
-                   carry)
-                65536))))
-  )
-
-;;; buffers (H0 H1 H2 H3 H4).
-(defvar sha1-H0-high)
-(defvar sha1-H0-low)
-(defvar sha1-H1-high)
-(defvar sha1-H1-low)
-(defvar sha1-H2-high)
-(defvar sha1-H2-low)
-(defvar sha1-H3-high)
-(defvar sha1-H3-low)
-(defvar sha1-H4-high)
-(defvar sha1-H4-low)
-
-(defun sha1-block (block-high block-low)
-  (let (;; step (c) --- initialize buffers (A B C D E).
-	(sha1-A-high sha1-H0-high) (sha1-A-low sha1-H0-low)
-	(sha1-B-high sha1-H1-high) (sha1-B-low sha1-H1-low)
-	(sha1-C-high sha1-H2-high) (sha1-C-low sha1-H2-low)
-	(sha1-D-high sha1-H3-high) (sha1-D-low sha1-H3-low)
-	(sha1-E-high sha1-H4-high) (sha1-E-low sha1-H4-low)
-	(idx 16))
-    ;; step (b).
-    (let (;; temporary variables used in sha1-S1 macro.
-	  S1W-high S1W-low)
-      (while (< idx 80)
-	(sha1-S1 (logxor (aref block-high (- idx 3))
-			 (aref block-high (- idx 8))
-			 (aref block-high (- idx 14))
-			 (aref block-high (- idx 16)))
-		 (logxor (aref block-low  (- idx 3))
-			 (aref block-low  (- idx 8))
-			 (aref block-low  (- idx 14))
-			 (aref block-low  (- idx 16))))
-	(aset block-high idx S1W-high)
-	(aset block-low  idx S1W-low)
-	(setq idx (1+ idx))))
-    ;; step (d).
-    (setq idx 0)
-    (let (;; temporary variables used in sha1-OP macro.
-	  S5A-high S5A-low S30B-high S30B-low carry)
-      (while (< idx 20) (sha1-OP 0) (setq idx (1+ idx)))
-      (while (< idx 40) (sha1-OP 1) (setq idx (1+ idx)))
-      (while (< idx 60) (sha1-OP 2) (setq idx (1+ idx)))
-      (while (< idx 80) (sha1-OP 3) (setq idx (1+ idx))))
-    ;; step (e).
-    (let (;; temporary variables used in sha1-add-to-H macro.
-	  carry)
-      (sha1-add-to-H H0 A)
-      (sha1-add-to-H H1 B)
-      (sha1-add-to-H H2 C)
-      (sha1-add-to-H H3 D)
-      (sha1-add-to-H H4 E))))
-
-(defun sha1-binary (string)
-  "Return the SHA1 of STRING in binary form."
-  (let (;; prepare buffers for a block. byte-length of block is 64.
-	;; input block is split into two vectors.
-	;;
-	;; input block: 00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F ...
-	;; block-high:  +-0-+       +-1-+       +-2-+       +-3-+
-	;; block-low:         +-0-+       +-1-+       +-2-+       +-3-+
-	;;
-	;; length of each vector is 80, and elements of each vector are
-	;; 16bit integers.  elements 0x10-0x4F of each vector are
-	;; assigned later in `sha1-block'.
-	(block-high (eval-when-compile (make-vector 80 nil)))
-	(block-low  (eval-when-compile (make-vector 80 nil))))
-    (unwind-protect
-	(let* (;; byte-length of input string.
-	       (len (length string))
-	       (lim (* (/ len 64) 64))
-	       (rem (% len 4))
-	       (idx 0)(pos 0))
-	  ;; initialize buffers (H0 H1 H2 H3 H4).
-	  (setq sha1-H0-high 26437	; (string-to-number "6745" 16)
-		sha1-H0-low  8961	; (string-to-number "2301" 16)
-		sha1-H1-high 61389	; (string-to-number "EFCD" 16)
-		sha1-H1-low  43913	; (string-to-number "AB89" 16)
-		sha1-H2-high 39098	; (string-to-number "98BA" 16)
-		sha1-H2-low  56574	; (string-to-number "DCFE" 16)
-		sha1-H3-high 4146	; (string-to-number "1032" 16)
-		sha1-H3-low  21622	; (string-to-number "5476" 16)
-		sha1-H4-high 50130	; (string-to-number "C3D2" 16)
-		sha1-H4-low  57840)	; (string-to-number "E1F0" 16)
-	  ;; loop for each 64 bytes block.
-	  (while (< pos lim)
-	    ;; step (a).
-	    (setq idx 0)
-	    (while (< idx 16)
-	      (aset block-high idx (+ (* (aref string pos) 256)
-				      (aref string (1+ pos))))
-	      (setq pos (+ pos 2))
-	      (aset block-low  idx (+ (* (aref string pos) 256)
-				      (aref string (1+ pos))))
-	      (setq pos (+ pos 2))
-	      (setq idx (1+ idx)))
-	    (sha1-block block-high block-low))
-	  ;; last block.
-	  (if (prog1
-		  (< (- len lim) 56)
-		(setq lim (- len rem))
-		(setq idx 0)
-		(while (< pos lim)
-		  (aset block-high idx (+ (* (aref string pos) 256)
-					  (aref string (1+ pos))))
-		  (setq pos (+ pos 2))
-		  (aset block-low  idx (+ (* (aref string pos) 256)
-					  (aref string (1+ pos))))
-		  (setq pos (+ pos 2))
-		  (setq idx (1+ idx)))
-		;; this is the last (at most) 32bit word.
-		(cond
-		 ((= rem 3)
-		  (aset block-high idx (+ (* (aref string pos) 256)
-					  (aref string (1+ pos))))
-		  (setq pos (+ pos 2))
-		  (aset block-low  idx (+ (* (aref string pos) 256)
-					  128)))
-		 ((= rem 2)
-		  (aset block-high idx (+ (* (aref string pos) 256)
-					  (aref string (1+ pos))))
-		  (aset block-low  idx 32768))
-		 ((= rem 1)
-		  (aset block-high idx (+ (* (aref string pos) 256)
-					  128))
-		  (aset block-low  idx 0))
-		 (t ;; (= rem 0)
-		  (aset block-high idx 32768)
-		  (aset block-low  idx 0)))
-		(setq idx (1+ idx))
-		(while (< idx 16)
-		  (aset block-high idx 0)
-		  (aset block-low  idx 0)
-		  (setq idx (1+ idx))))
-	      ;; last block has enough room to write the length of string.
-	      (progn
-		;; write bit length of string to last 4 bytes of the block.
-		(aset block-low  15 (* (% len 8192) 8))
-		(setq len (/ len 8192))
-		(aset block-high 15 (% len 65536))
-		;; XXX: It is not practical to compute SHA1 of
-		;;      such a huge message on emacs.
-		;; (setq len (/ len 65536))	; for 64bit emacs.
-		;; (aset block-low  14 (% len 65536))
-		;; (aset block-high 14 (/ len 65536))
-		(sha1-block block-high block-low))
-	    ;; need one more block.
-	    (sha1-block block-high block-low)
-	    (fillarray block-high 0)
-	    (fillarray block-low  0)
-	    ;; write bit length of string to last 4 bytes of the block.
-	    (aset block-low  15 (* (% len 8192) 8))
-	    (setq len (/ len 8192))
-	    (aset block-high 15 (% len 65536))
-	    ;; XXX: It is not practical to compute SHA1 of
-	    ;;      such a huge message on emacs.
-	    ;; (setq len (/ len 65536))		; for 64bit emacs.
-	    ;; (aset block-low  14 (% len 65536))
-	    ;; (aset block-high 14 (/ len 65536))
-	    (sha1-block block-high block-low))
-	  ;; make output string (in binary form).
-	  (let ((result (make-string 20 0)))
-	    (aset result  0 (/ sha1-H0-high 256))
-	    (aset result  1 (% sha1-H0-high 256))
-	    (aset result  2 (/ sha1-H0-low  256))
-	    (aset result  3 (% sha1-H0-low  256))
-	    (aset result  4 (/ sha1-H1-high 256))
-	    (aset result  5 (% sha1-H1-high 256))
-	    (aset result  6 (/ sha1-H1-low  256))
-	    (aset result  7 (% sha1-H1-low  256))
-	    (aset result  8 (/ sha1-H2-high 256))
-	    (aset result  9 (% sha1-H2-high 256))
-	    (aset result 10 (/ sha1-H2-low  256))
-	    (aset result 11 (% sha1-H2-low  256))
-	    (aset result 12 (/ sha1-H3-high 256))
-	    (aset result 13 (% sha1-H3-high 256))
-	    (aset result 14 (/ sha1-H3-low  256))
-	    (aset result 15 (% sha1-H3-low  256))
-	    (aset result 16 (/ sha1-H4-high 256))
-	    (aset result 17 (% sha1-H4-high 256))
-	    (aset result 18 (/ sha1-H4-low  256))
-	    (aset result 19 (% sha1-H4-low  256))
-	    result))
-      ;; do not leave a copy of input string.
-      (fillarray block-high nil)
-      (fillarray block-low  nil))))
-
-(defun sha1-string-internal (string &optional binary)
-  (if binary
-      (sha1-binary string)
-    (encode-hex-string (sha1-binary string))))
-
-(defun sha1-region-internal (beg end &optional binary)
-  (sha1-string-internal (buffer-substring-no-properties beg end) binary))
-
-;;;
-;;; application interface.
-;;;
-
-(defun sha1-region (beg end &optional binary)
-  (if (and sha1-use-external
-	   sha1-maximum-internal-length
-	   (> (abs (- end beg)) sha1-maximum-internal-length))
-      (sha1-region-external beg end binary)
-    (sha1-region-internal beg end binary)))
-
-(defun sha1-string (string &optional binary)
-  (if (and sha1-use-external
-	   sha1-maximum-internal-length
-	   (> (length string) sha1-maximum-internal-length))
-      (sha1-string-external string binary)
-    (sha1-string-internal string binary)))
-
-;;;###autoload
-(defun sha1 (object &optional beg end binary)
-  "Return the SHA1 (Secure Hash Algorithm) of an object.
-OBJECT is either a string or a buffer.
-Optional arguments BEG and END denote buffer positions for computing the
-hash of a portion of OBJECT.
-If BINARY is non-nil, return a string in binary form."
-  (if (stringp object)
-      (sha1-string object binary)
-    (with-current-buffer object
-      (sha1-region (or beg (point-min)) (or end (point-max)) binary))))
-
-(provide 'sha1)
-
-;; arch-tag: c0f9abd0-ffc1-4557-aac6-ece7f2d4c901
-;;; sha1.el ends here
diff --git a/lisp/gnus/sieve-manage.el b/lisp/gnus/sieve-manage.el
index d8bd965718d..5cf14f7eb32 100644
--- a/lisp/gnus/sieve-manage.el
+++ b/lisp/gnus/sieve-manage.el
@@ -76,7 +76,8 @@
 
 ;;; Code:
 
-(require 'password)
+(or (require 'password-cache nil t)
+    (require 'password))
 (eval-when-compile
   (require 'sasl)
   (require 'starttls))
diff --git a/lisp/gnus/smime-ldap.el b/lisp/gnus/smime-ldap.el
deleted file mode 100644
index 882f9f80c6f..00000000000
--- a/lisp/gnus/smime-ldap.el
+++ /dev/null
@@ -1,206 +0,0 @@
-;;; smime-ldap.el --- client interface to LDAP for Emacs
-
-;; Copyright (C) 1998, 1999, 2000, 2005 Free Software Foundation, Inc.
-
-;; Author: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
-;; Maintainer: Arne J,Ax(Brgensen <arne@arnested.dk>
-;; Created: February 2005
-;; Keywords: comm
-
-;; 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, 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; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; This file has a slightly changed implementation of Emacs 21.3's
-;; ldap-search and ldap-search-internal from ldap.el. The changes are
-;; made to achieve compatibility with OpenLDAP v2 and to make it
-;; possible to retrieve LDAP attributes that are tagged ie ";binary".
-
-;; The file also adds a compatibility layer for Emacs and XEmacs.
-
-;;; Code:
-
-(require 'ldap)
-
-(defun smime-ldap-search (filter &optional host attributes attrsonly withdn)
-  "Perform an LDAP search.
-FILTER is the search filter in RFC1558 syntax.
-HOST is the LDAP host on which to perform the search.
-ATTRIBUTES are the specific attributes to retrieve, nil means
-retrieve all.
-ATTRSONLY, if non-nil, retrieves the attributes only, without
-the associated values.
-If WITHDN is non-nil, each entry in the result will be prepended with
-its distinguished name WITHDN.
-Additional search parameters can be specified through
-`ldap-host-parameters-alist', which see."
-  (interactive "sFilter:")
-  ;; for XEmacs
-  (if (fboundp 'ldap-search-entries)
-      (ldap-search-entries filter host attributes attrsonly)
-    ;; for Emacs 22
-    (if (>= emacs-major-version 22)
-	(cdr (ldap-search filter host attributes attrsonly))
-      ;; for Emacs 21.x
-      (or host
-	  (setq host ldap-default-host)
-	  (error "No LDAP host specified"))
-      (let ((host-plist (cdr (assoc host ldap-host-parameters-alist)))
-	    result)
-	(setq result (smime-ldap-search-internal
-		      (append host-plist
-			      (list 'host host
-				    'filter filter
-				    'attributes attributes
-				    'attrsonly attrsonly
-				    'withdn withdn))))
-	(cdr (if ldap-ignore-attribute-codings
-		 result
-	       (mapcar (function
-			(lambda (record)
-			  (mapcar 'ldap-decode-attribute record)))
-		       result)))))))
-
-(defun smime-ldap-search-internal (search-plist)
-  "Perform a search on a LDAP server.
-SEARCH-PLIST is a property list describing the search request.
-Valid keys in that list are:
-`host' is a string naming one or more (blank-separated) LDAP servers to
-to try to connect to.  Each host name may optionally be of the form HOST:PORT.
-`filter' is a filter string for the search as described in RFC 1558.
-`attributes' is a list of strings indicating which attributes to retrieve
-for each matching entry. If nil, return all available attributes.
-`attrsonly', if non-nil, indicates that only attributes are retrieved,
-not their associated values.
-`base' is the base for the search as described in RFC 1779.
-`scope' is one of the three symbols `sub', `base' or `one'.
-`binddn' is the distinguished name of the user to bind as (in RFC 1779 syntax).
-`passwd' is the password to use for simple authentication.
-`deref' is one of the symbols `never', `always', `search' or `find'.
-`timelimit' is the timeout limit for the connection in seconds.
-`sizelimit' is the maximum number of matches to return.
-`withdn' if non-nil each entry in the result will be prepended with
-its distinguished name DN.
-The function returns a list of matching entries.  Each entry is itself
-an alist of attribute/value pairs."
-  (let ((buf (get-buffer-create " *ldap-search*"))
-	(bufval (get-buffer-create " *ldap-value*"))
-	(host (or (plist-get search-plist 'host)
-		  ldap-default-host))
-	(filter (plist-get search-plist 'filter))
-	(attributes (plist-get search-plist 'attributes))
-	(attrsonly (plist-get search-plist 'attrsonly))
-	(base (or (plist-get search-plist 'base)
-		  ldap-default-base))
-	(scope (plist-get search-plist 'scope))
-	(binddn (plist-get search-plist 'binddn))
-	(passwd (plist-get search-plist 'passwd))
-	(deref (plist-get search-plist 'deref))
-	(timelimit (plist-get search-plist 'timelimit))
-	(sizelimit (plist-get search-plist 'sizelimit))
-	(withdn (plist-get search-plist 'withdn))
-	(numres 0)
-	arglist dn name value record result)
-    (if (or (null filter)
-	    (equal "" filter))
-	(error "No search filter"))
-    (setq filter (cons filter attributes))
-    (save-excursion
-      (set-buffer buf)
-      (erase-buffer)
-      (if (and host
-	       (not (equal "" host)))
-	  (setq arglist (nconc arglist (list (format "-h%s" host)))))
-      (if (and attrsonly
-	       (not (equal "" attrsonly)))
-	  (setq arglist (nconc arglist (list "-A"))))
-      (if (and base
-	       (not (equal "" base)))
-	  (setq arglist (nconc arglist (list (format "-b%s" base)))))
-      (if (and scope
-	       (not (equal "" scope)))
-	  (setq arglist (nconc arglist (list (format "-s%s" scope)))))
-      (if (and binddn
-	       (not (equal "" binddn)))
-	  (setq arglist (nconc arglist (list (format "-D%s" binddn)))))
-      (if (and passwd
-	       (not (equal "" passwd)))
-	  (setq arglist (nconc arglist (list (format "-w%s" passwd)))))
-      (if (and deref
-	       (not (equal "" deref)))
-	  (setq arglist (nconc arglist (list (format "-a%s" deref)))))
-      (if (and timelimit
-	       (not (equal "" timelimit)))
-	  (setq arglist (nconc arglist (list (format "-l%s" timelimit)))))
-      (if (and sizelimit
-	       (not (equal "" sizelimit)))
-	  (setq arglist (nconc arglist (list (format "-z%s" sizelimit)))))
-      (eval `(call-process ldap-ldapsearch-prog
-			   nil
-			   buf
-			   nil
-			   ,@arglist
-			   "-tt"		; Write values to temp files
-			   "-x"
-			   "-LL"
-			   ;			   ,@ldap-ldapsearch-args
-			   ,@filter))
-      (insert "\n")
-      (goto-char (point-min))
-
-      (while (re-search-forward "[\t\n\f]+ " nil t)
-	(replace-match "" nil nil))
-      (goto-char (point-min))
-
-      (if (looking-at "usage")
-	  (error "Incorrect ldapsearch invocation")
-	(message "Parsing results... ")
-	(while (progn
-		 (skip-chars-forward " \t\n")
-		 (not (eobp)))
-	  (setq dn (buffer-substring (point) (save-excursion
-					       (end-of-line)
-					       (point))))
-	  (forward-line 1)
-	  (while (looking-at (concat "^\\(\\w*\\)\\(;\\w*\\)?[=:\t ]+"
-				     "\\(<[\t ]*file://\\)?\\(.*\\)$"))
-	    (setq name (match-string 1)
-		  value (match-string 4))
-	    (save-excursion
-	      (set-buffer bufval)
-	      (erase-buffer)
-	      (insert-file-contents-literally value)
-	      (delete-file value)
-	      (setq value (buffer-substring (point-min) (point-max))))
-	    (setq record (cons (list name value)
-			       record))
-	    (forward-line 1))
-	  (setq result (cons (if withdn
-				 (cons dn (nreverse record))
-			       (nreverse record)) result))
-	  (setq record nil)
-	  (skip-chars-forward " \t\n")
-	  (message "Parsing results... %d" numres)
-	  (1+ numres))
-	(message "Parsing results... done")
-	(nreverse result)))))
-
-(provide 'smime-ldap)
-
-;; arch-tag: 87e6bc44-21fc-4e9b-a89b-f55f031f78f8
-;;; smime-ldap.el ends here
diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el
index ee62fd8124b..31545c16044 100644
--- a/lisp/gnus/smime.el
+++ b/lisp/gnus/smime.el
@@ -122,8 +122,8 @@
 ;;; Code:
 
 (require 'dig)
-(require 'smime-ldap)
-(require 'password)
+(or (require 'password-cache nil t)
+    (require 'password))
 (eval-when-compile (require 'cl))
 
 (eval-and-compile
@@ -424,8 +424,7 @@ Any details (stdout and stderr) are left in the buffer specified by
     (insert-buffer-substring smime-details-buffer)
     nil))
 
-(eval-when-compile
-  (defvar from))
+(defvar from)
 
 (defun smime-decrypt-region (b e keyfile)
   "Decrypt S/MIME message in region between B and E with key in KEYFILE.
@@ -590,8 +589,17 @@ A string or a list of strings is returned."
 
 (defun smime-cert-by-ldap-1 (mail host)
   "Get cetificate for MAIL from the ldap server at HOST."
-  (let ((ldapresult (smime-ldap-search (concat "mail=" mail)
-				       host '("userCertificate") nil))
+  (let ((ldapresult
+	 (funcall
+	  (if (or (featurep 'xemacs)
+		  ;; For Emacs >= 22 we don't need smime-ldap.el
+		  (< emacs-major-version 22))
+	      (progn
+		(require 'smime-ldap)
+		'smime-ldap-search)
+	    'ldap-search)
+	  (concat "mail=" mail)
+	  host '("userCertificate") nil))
 	(retbuf (generate-new-buffer (format "*certificate for %s*" mail)))
 	cert)
     (if (and (>= (length ldapresult) 1)
diff --git a/lisp/gnus/spam-wash.el b/lisp/gnus/spam-wash.el
index d1be1816a4f..be9a822dd2f 100644
--- a/lisp/gnus/spam-wash.el
+++ b/lisp/gnus/spam-wash.el
@@ -1,21 +1,21 @@
 ;;; spam-wash.el --- wash spam before analysis
 
-;; Copyright (C) 2004 Free Software Foundation, Inc.
+;; Copyright (C) 2004, 2007  Free Software Foundation, Inc.
 
 ;; Author: Andrew Cohen <cohen@andy.bu.edu>
 ;; Keywords: mail
 
 ;; This file is part of GNU Emacs.
 
-;; This is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by
+;; 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, or (at your option)
 ;; any later version.
 
-;; This 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.
+;; 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; see the file COPYING.  If not, write to the
diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el
index 4164d3f718b..fddebb1d290 100644
--- a/lisp/gnus/spam.el
+++ b/lisp/gnus/spam.el
@@ -81,7 +81,7 @@
 ;;{{{ Main parameters.
 (defvar spam-backends nil
   "List of spam.el backends with all the pertinent data.
-Populated by spam-install-backend-super.")
+Populated by `spam-install-backend-super'.")
 
 (defgroup spam nil
   "Spam configuration."
@@ -91,13 +91,13 @@ Populated by spam-install-backend-super.")
 
 (defcustom spam-summary-exit-behavior 'default
   "Exit behavior at the time of summary exit.
-Note that setting the spam-use-move or spam-use-copy backends on
+Note that setting the `spam-use-move' or `spam-use-copy' backends on
 a group through group/topic parameters overrides this mechanism."
-  :type '(choice (const 'default :tag 
+  :type '(choice (const 'default :tag
 			"Move spam out of all groups.  Move ham out of spam groups.")
-		 (const 'move-all :tag 
+		 (const 'move-all :tag
 			"Move spam out of all groups.  Move ham out of all groups.")
-		 (const 'move-none :tag 
+		 (const 'move-none :tag
 			"Never move spam or ham out of any groups."))
   :group 'spam)
 
@@ -124,8 +124,7 @@ a group through group/topic parameters overrides this mechanism."
 
 (defcustom spam-split-symbolic-return-positive nil
   "Whether `spam-split' should ALWAYS work with symbols or group names.
-Do not set this if you use `spam-split' in a fancy split
-  method."
+Do not set this if you use `spam-split' in a fancy split method."
   :type 'boolean
   :group 'spam)
 
@@ -139,7 +138,7 @@ without losing it to the automatic spam-marking process."
 
 (defcustom spam-mark-ham-unread-before-move-from-spam-group nil
   "Whether ham should be marked unread before it's moved.
-The article is moved out of a spam group according to ham-process-destination.
+The article is moved out of a spam group according to `ham-process-destination'.
 This variable is an official entry in the international Longest Variable Name
 Competition."
   :type 'boolean
@@ -403,7 +402,7 @@ Only meaningful if you enable `spam-use-regex-body'."
   :group 'spam)
 
 (defcustom spam-summary-score-preferred-header nil
-  "Preferred header to use for spam-summary-score."
+  "Preferred header to use for `spam-summary-score'."
   :type '(choice :tag "Header name"
 	  (symbol :tag "SpamAssassin etc" X-Spam-Status)
 	  (symbol :tag "Bogofilter"       X-Bogosity)
@@ -621,17 +620,17 @@ order for SpamAssassin to recognize the new registered spam."
   :group 'spam-spamassassin)
 
 (defcustom spam-sa-learn-spam-switch "--spam"
-  "The switch that sa-learn uses to register spam messages"
+  "The switch that sa-learn uses to register spam messages."
   :type 'string
   :group 'spam-spamassassin)
 
 (defcustom spam-sa-learn-ham-switch "--ham"
-  "The switch that sa-learn uses to register ham messages"
+  "The switch that sa-learn uses to register ham messages."
   :type 'string
   :group 'spam-spamassassin)
 
 (defcustom spam-sa-learn-unregister-switch "--forget"
-  "The switch that sa-learn uses to unregister messages messages"
+  "The switch that sa-learn uses to unregister messages messages."
   :type 'string
   :group 'spam-spamassassin)
 
@@ -722,7 +721,7 @@ finds ham or spam.")
 ;;{{{ convenience functions
 
 (defun spam-clear-cache (symbol)
-  "Clear the spam-caches entry for a check."
+  "Clear the `spam-caches' entry for a check."
   (remhash symbol spam-caches))
 
 (defun spam-xor (a b)
@@ -730,7 +729,7 @@ finds ham or spam.")
   (and (or a b) (not (and a b))))
 
 (defun spam-set-difference (list1 list2)
-  "Return a set difference of LIST1 and LIST2.  
+  "Return a set difference of LIST1 and LIST2.
 When either list is nil, the other is returned."
   (if (and list1 list2)
       ;; we have two non-nil lists
@@ -837,15 +836,14 @@ Accepts incoming CHECK, ham registration function HRF, spam
 registration function SRF, ham unregistration function HUF, spam
 unregistration function SUF, and an indication whether the
 backend is STATISTICAL."
-
   (setq spam-backends (add-to-list 'spam-backends backend))
   (while properties
     (let ((property (pop properties))
 	  (value (pop properties)))
       (if (spam-backend-property-valid-p property)
 	  (put backend property value)
-	(gnus-error 
-	 5 
+	(gnus-error
+	 5
 	 "spam-install-backend-super got an invalid property %s"
 	 property)))))
 
@@ -875,7 +873,7 @@ The value nil means that the check does not yield a decision, and
 so, that further checks are needed.  The value t means that the
 message is definitely not spam, and that further spam checks
 should be inhibited.  Otherwise, a mailgroup name or the symbol
-'spam (depending on spam-split-symbolic-return) is returned where
+'spam (depending on `spam-split-symbolic-return') is returned where
 the mail should go, and further checks are also inhibited.  The
 usual mailgroup name is the value of `spam-split-group', meaning
 that the message is definitely a spam."
@@ -892,7 +890,7 @@ that the message is definitely a spam."
 	(setq info (format "Backend %s has the following properties:\n"
 			   backend))
 	(dolist (property (spam-backend-properties))
-	  (setq info (format "%s%s=%s\n" 
+	  (setq info (format "%s%s=%s\n"
 			     info
 			     property
 			     (get backend property))))
@@ -907,13 +905,13 @@ CLASSIFICATION is 'ham or 'spam."
   (if (and
        (spam-classification-valid-p classification)
        (spam-backend-function-type-valid-p type))
-      (let ((retrieval 
-	     (intern 
+      (let ((retrieval
+	     (intern
 	      (format "spam-backend-%s-%s-function"
 		      classification
 		      type))))
 	(funcall retrieval backend))
-    (gnus-error 
+    (gnus-error
      5
      "%s was passed invalid backend %s, classification %s, or type %s"
      "spam-backend-function"
@@ -921,21 +919,21 @@ CLASSIFICATION is 'ham or 'spam."
      classification
      type)))
 
-(defun spam-backend-article-list-property (classification 
+(defun spam-backend-article-list-property (classification
 					   &optional unregister)
   "Property name of article list with CLASSIFICATION and UNREGISTER."
   (let* ((r (if unregister "unregister" "register"))
 	 (prop (format "%s-%s" classification r)))
     prop))
 
-(defun spam-backend-get-article-todo-list (backend 
-					   classification 
+(defun spam-backend-get-article-todo-list (backend
+					   classification
 					   &optional unregister)
-  "Get the articles to be processed for BACKEND and CLASSIFICATION.  
+  "Get the articles to be processed for BACKEND and CLASSIFICATION.
 With UNREGISTER, get articles to be unregistered.
 This is a temporary storage function - nothing here persists."
   (get
-   backend 
+   backend
    (intern (spam-backend-article-list-property classification unregister))))
 
 (defun spam-backend-put-article-todo-list (backend classification list &optional unregister)
@@ -977,7 +975,7 @@ The previous backend settings for ALIAS are erased."
 
   ;; install alias with no properties at first
   (spam-install-backend-super alias)
-  
+
   (dolist (property (spam-backend-properties))
     (put alias property (get backend property))))
 
@@ -991,8 +989,8 @@ Accepts ham registration function HRF, spam registration function
 SRF, ham unregistration function HUF, spam unregistration
 function SUF.  The backend has no incoming check and can't be
 statistical."
-  (spam-install-backend-super 
-   backend 
+  (spam-install-backend-super
+   backend
    'hrf hrf 'srf srf 'huf huf 'suf suf 'mover t))
 
 (defun spam-install-nocheck-backend (backend hrf srf huf suf)
@@ -1001,7 +999,7 @@ Accepts ham registration function HRF, spam registration function
 SRF, ham unregistration function HUF, spam unregistration
 function SUF.  The backend has no incoming check and can't be
 statistical (it could be, but in practice that doesn't happen)."
-  (spam-install-backend-super 
+  (spam-install-backend-super
    backend
    'hrf hrf 'srf srf 'huf huf 'suf suf))
 
@@ -1010,8 +1008,8 @@ statistical (it could be, but in practice that doesn't happen)."
 Accepts incoming CHECK, ham registration function HRF, spam
 registration function SRF, ham unregistration function HUF, spam
 unregistration function SUF.  The backend won't be
-statistical (use spam-install-statistical-backend for that)."
-  (spam-install-backend-super 
+statistical (use `spam-install-statistical-backend' for that)."
+  (spam-install-backend-super
    backend
    'check check 'hrf hrf 'srf srf 'huf huf 'suf suf))
 
@@ -1020,15 +1018,15 @@ statistical (use spam-install-statistical-backend for that)."
 Accepts incoming CHECK, ham registration function HRF, spam
 registration function SRF, ham unregistration function HUF, spam
 unregistration function SUF.  The backend will be
-statistical (use spam-install-backend for non-statistical
+statistical (use `spam-install-backend' for non-statistical
 backends)."
-  (spam-install-backend-super 
+  (spam-install-backend-super
    backend
    'check check 'statistical t 'hrf hrf 'srf srf 'huf huf 'suf suf))
 
 (defun spam-install-statistical-checkonly-backend (backend check)
   "Install a statistical BACKEND than can only CHECK for spam."
-  (spam-install-backend-super 
+  (spam-install-backend-super
    backend
    'check check 'statistical t))
 
@@ -1084,7 +1082,7 @@ backends)."
 			      nil
 			      nil)
 
-(spam-install-backend 'spam-use-BBDB	 
+(spam-install-backend 'spam-use-BBDB
 		      'spam-check-BBDB
 		      'spam-BBDB-register-routine
 		      nil
@@ -1128,7 +1126,7 @@ backends)."
 				  'spam-stat-unregister-ham-routine
 				  'spam-stat-unregister-spam-routine)
 
-(spam-install-statistical-backend 'spam-use-spamassassin 
+(spam-install-statistical-backend 'spam-use-spamassassin
 				  'spam-check-spamassassin
 				  'spam-spamassassin-register-ham-routine
 				  'spam-spamassassin-register-spam-routine
@@ -1224,13 +1222,13 @@ Note this has to be fast."
 With SPECIFIC-HEADER, returns only that header's score.
 Will not return a nil score."
   (let (score)
-    (dolist (header 
+    (dolist (header
 	     (if specific-header
 		 (list specific-header)
 	       (spam-necessary-extra-headers)))
-      (setq score 
+      (setq score
 	    (spam-extra-header-to-number header headers))
-      (when score 
+      (when score
 	(return)))
     (or score 0)))
 
@@ -1258,7 +1256,7 @@ Will not return a nil score."
   (let (found)
     (dolist (backend (spam-backend-list))
       (when (and (spam-backend-statistical-p backend)
-		 (or (symbol-value backend) 
+		 (or (symbol-value backend)
 		     (memq backend force-symbols)))
 	(setq found backend)))
     found))
@@ -1287,14 +1285,14 @@ This list contains pairs associating the obsolete ham/spam exit
 processor variables with a classification and a spam-use-*
 variable.  When the processor variable is nil, just the
 classification and spam-use-* check variable are used.  This is
-superceded by the new spam backend code, so it's only consulted
+superseded by the new spam backend code, so it's only consulted
 for backwards compatibility.")
 
 (defun spam-group-processor-p (group backend &optional classification)
   "Checks if GROUP has a BACKEND with CLASSIFICATION registered.
 Also accepts the obsolete processors, which can be found in
 gnus.el and in spam-list-of-processors.  In the case of mover
-backends, checks the setting of spam-summary-exit-behavior in
+backends, checks the setting of `spam-summary-exit-behavior' in
 addition to the set values for the group."
   (if (and (stringp group)
 	   (symbolp backend))
@@ -1315,7 +1313,7 @@ addition to the set values for the group."
 	  ;; spam-summary-exit-behavior-logic for mover backends
 	  (unless found
 	    (when (spam-backend-mover-p backend)
-	      (setq 
+	      (setq
 	       found
 	       (cond
 		((eq spam-summary-exit-behavior 'move-all) t)
@@ -1325,7 +1323,7 @@ addition to the set values for the group."
 		     ;; move ham out of spam groups
 		     (and (eq classification 'ham)
 			  (spam-group-spam-contents-p group))))
-		(t (gnus-error 5 "Unknown spam-summary-exit-behavior: %s" 
+		(t (gnus-error 5 "Unknown spam-summary-exit-behavior: %s"
 			       spam-summary-exit-behavior))))))
 
 	  found))
@@ -1385,8 +1383,8 @@ addition to the set values for the group."
 	    ;; call spam-register-routine with specific articles to unregister,
 	    ;; when there are articles to unregister and the check is enabled
 	    (when (and unregister-list (symbol-value backend))
-	      (spam-backend-put-article-todo-list backend 
-						  classification 
+	      (spam-backend-put-article-todo-list backend
+						  classification
 						  unregister-list
 						  t))))))
 
@@ -1398,7 +1396,7 @@ addition to the set values for the group."
 		 gnus-newsgroup-name
 		 backend
 		 classification)
-	    (spam-backend-put-article-todo-list backend 
+	    (spam-backend-put-article-todo-list backend
 						classification
 						(spam-list-articles
 						 gnus-newsgroup-articles
@@ -1457,11 +1455,11 @@ addition to the set values for the group."
 			  article)
 	    (gnus-summary-mark-article article gnus-expirable-mark))
 	  (gnus-summary-set-process-mark article)
-	    
+
 	  (if respool		   ; respooling is with a "fake" group
 	      (let ((spam-split-disabled
 		     (or spam-split-disabled
-			 (and (eq classification 'ham) 
+			 (and (eq classification 'ham)
 			      spam-disable-spam-split-during-ham-respool))))
 		(gnus-message 9 "Respooling article %d with method %s"
 			      article respool-method)
@@ -1476,7 +1474,7 @@ addition to the set values for the group."
 	      (gnus-message 9 "Moving article %d to group %s"
 			    article group)
 	      (gnus-summary-move-article nil group)))))	; else move articles
-	
+
       ;; now delete the articles, unless a) copy is t, and there was a copy done
       ;;                                 b) a move was done to a single group
       ;;                                 c) backend-supports-deletions is nil
@@ -1488,33 +1486,33 @@ addition to the set values for the group."
 	  (when articles
 	    (let ((gnus-novice-user nil)) ; don't ask me if I'm sure
 	      (gnus-summary-delete-article nil)))))
-	
+
       (gnus-summary-yank-process-mark)
       (length articles))))
 
 (defun spam-copy-spam-routine (articles)
-  (spam-copy-or-move-routine 
-   t 
+  (spam-copy-or-move-routine
+   t
    (gnus-parameter-spam-process-destination gnus-newsgroup-name)
    articles
    'spam))
 
 (defun spam-move-spam-routine (articles)
-  (spam-copy-or-move-routine 
+  (spam-copy-or-move-routine
    nil
    (gnus-parameter-spam-process-destination gnus-newsgroup-name)
    articles
    'spam))
 
 (defun spam-copy-ham-routine (articles)
-  (spam-copy-or-move-routine 
-   t 
+  (spam-copy-or-move-routine
+   t
    (gnus-parameter-ham-process-destination gnus-newsgroup-name)
    articles
    'ham))
 
 (defun spam-move-ham-routine (articles)
-  (spam-copy-or-move-routine 
+  (spam-copy-or-move-routine
    nil
    (gnus-parameter-ham-process-destination gnus-newsgroup-name)
    articles
@@ -1570,9 +1568,9 @@ to find it out)."
 	 ((equal field 'extra)
 	  (mail-header-extra data-header))
 	 (t
-	  (gnus-error 
-	   5 
-	   "spam-fetch-field-fast: unknown field %s requested" 
+	  (gnus-error
+	   5
+	   "spam-fetch-field-fast: unknown field %s requested"
 	   field)
 	  nil))
 	(gnus-message 6 "Article %d has a nil data header" article)))))
@@ -1621,7 +1619,7 @@ to find it out)."
 This function can be used as an entry in the variable `nnmail-split-fancy',
 for example like this: (: spam-split).  It can take checks as
 parameters.  A string as a parameter will set the
-spam-split-group to that string.
+`spam-split-group' to that string.
 
 See the Info node `(gnus)Fancy Mail Splitting' for more details."
   (interactive)
@@ -1673,7 +1671,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
 		decision))))))))
 
 (defun spam-find-spam ()
-  "This function will detect spam in the current newsgroup using spam-split."
+  "Detect spam in the current newsgroup using `spam-split'."
   (interactive)
 
   (let* ((group gnus-newsgroup-name)
@@ -1685,7 +1683,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
 		     gnus-newsgroup-unseen))
 	 article-cannot-be-faked)
 
-    
+
     (dolist (backend methods)
       (when (spam-backend-statistical-p backend)
 	(setq article-cannot-be-faked t)
@@ -1702,10 +1700,10 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
 	       (subject (spam-fetch-field-subject-fast article))
 	       (sender (spam-fetch-field-from-fast article))
 	       registry-lookup)
-	   
+
 	   (unless id
 	     (gnus-message 6 "Article %d has no message ID!" article))
-	 
+
 	   (when (and id spam-log-to-registry)
 	     (setq registry-lookup (spam-log-registration-type id 'incoming))
 	     (when registry-lookup
@@ -1732,12 +1730,12 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
 			   (apply 'spam-split methods))))))
 	     (if (equal split-return 'spam)
 		 (gnus-summary-mark-article article gnus-spam-mark))
-	   
+
 	     (when (and id split-return spam-log-to-registry)
 	       (when (zerop (gnus-registry-group-count id))
 		 (gnus-registry-add-group
 		  id group subject sender))
-	       
+
 	       (unless registry-lookup
 		 (spam-log-processing-to-registry
 		  id
@@ -1763,11 +1761,11 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
 	      (delcount 0))
 
 	  ;; clear the old lists right away
-	  (spam-backend-put-article-todo-list backend 
+	  (spam-backend-put-article-todo-list backend
 					      classification
 					      nil
 					      nil)
-	  (spam-backend-put-article-todo-list backend 
+	  (spam-backend-put-article-todo-list backend
 					      classification
 					      nil
 					      t)
@@ -1778,29 +1776,29 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
 	      (incf delcount)
 	      (setq rlist (delq article rlist))
 	      (setq ulist (delq article ulist))))
-	  
+
 	  (unless (zerop delcount)
-	    (gnus-message 
-	     9 
+	    (gnus-message
+	     9
 	     "%d messages were saved the trouble of unregistering and then registering"
 	     delcount))
-	  
+
 	  ;; unregister articles
 	  (unless (zerop (length ulist))
 	    (let ((num (spam-unregister-routine classification backend ulist)))
 	      (when (> num 0)
-		(gnus-message 
+		(gnus-message
 		 6
 		 "%d %s messages were unregistered by backend %s."
 		 num
 		 classification
 		 backend))))
-	    
+
 	    ;; register articles
 	    (unless (zerop (length rlist))
 	      (let ((num (spam-register-routine classification backend rlist)))
 		(when (> num 0)
-		  (gnus-message 
+		  (gnus-message
 		   6
 		   "%d %s messages were registered by backend %s."
 		   num
@@ -1808,12 +1806,12 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
 		   backend)))))))))
 
 (defun spam-unregister-routine (classification
-				backend 
+				backend
 				specific-articles)
   (spam-register-routine classification backend specific-articles t))
 
 (defun spam-register-routine (classification
-			      backend 
+			      backend
 			      specific-articles
 			      &optional unregister)
   (when (and (spam-classification-valid-p classification)
@@ -2134,7 +2132,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
 	      (save-excursion
 		(save-window-excursion
 		  (bbdb-records nil t)
-		  (mapatoms 
+		  (mapatoms
 		   (lambda (symbol)
 		     (intern (downcase (symbol-name symbol)) bbdb-cache))
 		   bbdb-hashtable))))
@@ -2311,8 +2309,8 @@ With a non-nil REMOVE, remove them."
 
 (defun spam-enter-list (addresses file &optional remove)
   "Enter ADDRESSES into the given FILE.
-Either the whitelist or the blacklist files can be used.  With
-REMOVE not nil, remove the ADDRESSES."
+Either the whitelist or the blacklist files can be used.
+With a non-nil REMOVE, remove the ADDRESSES."
   (if (stringp addresses)
       (spam-enter-list (list addresses) file remove)
     ;; else, we have a list of addresses here
@@ -2467,7 +2465,7 @@ REMOVE not nil, remove the ADDRESSES."
   (spam-report-resend-register-routine articles t))
 
 (defun spam-report-resend-register-routine (articles &optional ham)
-  (let* ((resend-to-gp 
+  (let* ((resend-to-gp
 	  (if ham
 	      (gnus-parameter-ham-resend-to gnus-newsgroup-name)
 	    (gnus-parameter-spam-resend-to gnus-newsgroup-name)))
@@ -2492,7 +2490,7 @@ REMOVE not nil, remove the ADDRESSES."
 
 ;; return something sensible if the score can't be determined
 (defun spam-bogofilter-score (&optional recheck)
-  "Get the Bogofilter spamicity score"
+  "Get the Bogofilter spamicity score."
   (interactive "P")
   (save-window-excursion
     (gnus-summary-show-article t)
@@ -2509,10 +2507,10 @@ REMOVE not nil, remove the ADDRESSES."
   (when (eq spam-bogofilter-valid 'unknown)
     (setq spam-bogofilter-valid
 	  (not (string-match "^bogofilter version 0\\.\\([0-9]\\|1[01]\\)\\."
-			     (shell-command-to-string 
+			     (shell-command-to-string
 			      (format "%s -V" spam-bogofilter-program))))))
   spam-bogofilter-valid)
-  
+
 (defun spam-check-bogofilter (&optional score)
   "Check the Bogofilter backend for the classification of this message."
   (if (spam-verify-bogofilter)
@@ -2550,7 +2548,7 @@ REMOVE not nil, remove the ADDRESSES."
 	  (when (stringp article-string)
 	    (with-temp-buffer
 	      (insert article-string)
-	      
+
 	      (apply 'call-process-region
 		     (point-min) (point-max)
 		     spam-bogofilter-program
@@ -2736,7 +2734,7 @@ REMOVE not nil, remove the ADDRESSES."
 
 ;; return something sensible if the score can't be determined
 (defun spam-bsfilter-score (&optional recheck)
-  "Get the Bsfilter spamicity score"
+  "Get the Bsfilter spamicity score."
   (interactive "P")
   (save-window-excursion
     (gnus-summary-show-article t)
@@ -2749,7 +2747,7 @@ REMOVE not nil, remove the ADDRESSES."
       (or score "0"))))
 
 (defun spam-check-bsfilter (&optional score)
-  "Check the Bsfilter backend for the classification of this message"
+  "Check the Bsfilter backend for the classification of this message."
   (let ((article-buffer-name (buffer-name))
 	(dir spam-bsfilter-database-directory)
 	return)
@@ -2823,7 +2821,7 @@ REMOVE not nil, remove the ADDRESSES."
 
 ;; return something sensible if the score can't be determined
 (defun spam-crm114-score ()
-  "Get the CRM114 Mailfilter pR"
+  "Get the CRM114 Mailfilter pR."
   (interactive)
   (save-window-excursion
     (gnus-summary-show-article t)
@@ -2835,7 +2833,7 @@ REMOVE not nil, remove the ADDRESSES."
       (or score "0"))))
 
 (defun spam-check-crm114 (&optional score)
-  "Check the CRM114 Mailfilter backend for the classification of this message"
+  "Check the CRM114 Mailfilter backend for the classification of this message."
   (let ((article-buffer-name (buffer-name))
 	(db spam-crm114-database-directory)
 	return)
@@ -2897,9 +2895,9 @@ REMOVE not nil, remove the ADDRESSES."
 (defun spam-initialize (&rest symbols)
   "Install the spam.el hooks and do other initialization.
 When SYMBOLS is given, set those variables to t.  This is so you
-can call spam-initialize before you set spam-use-* variables on
+can call `spam-initialize' before you set spam-use-* variables on
 explicitly, and matters only if you need the extra headers
-installed through spam-necessary-extra-headers."
+installed through `spam-necessary-extra-headers'."
   (interactive)
 
   (dolist (var symbols)
@@ -2923,7 +2921,7 @@ installed through spam-necessary-extra-headers."
   (add-hook 'gnus-summary-prepared-hook 'spam-find-spam))
 
 (defun spam-unload-hook ()
-  "Uninstall the spam.el hooks"
+  "Uninstall the spam.el hooks."
   (interactive)
   (remove-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save)
   (remove-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load)
diff --git a/lisp/gnus/utf7.el b/lisp/gnus/utf7.el
index dbe749cad69..deba6d131e4 100644
--- a/lisp/gnus/utf7.el
+++ b/lisp/gnus/utf7.el
@@ -209,20 +209,26 @@ Characters are in raw byte pairs in narrowed buffer."
 
 (defun utf7-encode (string &optional for-imap)
   "Encode UTF-7 STRING.  Use IMAP modification if FOR-IMAP is non-nil."
-  (let ((default-enable-multibyte-characters t))
-    (with-temp-buffer
-      (insert string)
-      (utf7-encode-internal for-imap)
-      (buffer-string))))
+  (if (and (coding-system-p 'utf-7) (coding-system-p 'utf-7-imap))
+      ;; Emacs 23 with proper support for IMAP
+      (encode-coding-string string (if for-imap 'utf-7-imap 'utf-7))
+    (let ((default-enable-multibyte-characters t))
+      (with-temp-buffer
+	(insert string)
+	(utf7-encode-internal for-imap)
+	(buffer-string)))))
 
 (defun utf7-decode (string &optional for-imap)
   "Decode UTF-7 STRING.  Use IMAP modification if FOR-IMAP is non-nil."
-  (let ((default-enable-multibyte-characters nil))
-    (with-temp-buffer
-      (insert string)
-      (utf7-decode-internal for-imap)
-      (mm-enable-multibyte)
-      (buffer-string))))
+  (if (and (coding-system-p 'utf-7) (coding-system-p 'utf-7-imap))
+      ;; Emacs 23 with proper support for IMAP
+      (decode-coding-string string (if for-imap 'utf-7-imap 'utf-7))
+    (let ((default-enable-multibyte-characters nil))
+      (with-temp-buffer
+	(insert string)
+	(utf7-decode-internal for-imap)
+	(mm-enable-multibyte)
+	(buffer-string)))))
 
 (provide 'utf7)
 
diff --git a/lisp/gnus/uudecode.el b/lisp/gnus/uudecode.el
deleted file mode 100644
index 74abeff6621..00000000000
--- a/lisp/gnus/uudecode.el
+++ /dev/null
@@ -1,237 +0,0 @@
-;;; uudecode.el -- elisp native uudecode
-
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007 Free Software Foundation, Inc.
-
-;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
-;; Keywords: uudecode news
-
-;; 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, 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; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(eval-and-compile
-  (defalias 'uudecode-char-int
-    (if (fboundp 'char-int)
-	'char-int
-      'identity)))
-
-(defcustom uudecode-decoder-program "uudecode"
-  "*Non-nil value should be a string that names a uu decoder.
-The program should expect to read uu data on its standard
-input and write the converted data to its standard output."
-  :type 'string
-  :group 'gnus-extract)
-
-(defcustom uudecode-decoder-switches nil
-  "*List of command line flags passed to `uudecode-decoder-program'."
-  :group 'gnus-extract
-  :type '(repeat string))
-
-(defcustom uudecode-use-external
-  (executable-find uudecode-decoder-program)
-  "*Use external uudecode program."
-  :version "22.1"
-  :group 'gnus-extract
-  :type 'boolean)
-
-(defconst uudecode-alphabet "\040-\140")
-
-(defconst uudecode-begin-line "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$")
-(defconst uudecode-end-line "^end[ \t]*$")
-
-(defconst uudecode-body-line
-  (let ((i 61) (str "^M"))
-    (while (> (setq i (1- i)) 0)
-      (setq str (concat str "[^a-z]")))
-    (concat str ".?$")))
-
-(defvar uudecode-temporary-file-directory
-  (cond ((fboundp 'temp-directory) (temp-directory))
-	((boundp 'temporary-file-directory) temporary-file-directory)
-	("/tmp")))
-
-;;;###autoload
-(defun uudecode-decode-region-external (start end &optional file-name)
-  "Uudecode region between START and END using external program.
-If FILE-NAME is non-nil, save the result to FILE-NAME.  The program
-used is specified by `uudecode-decoder-program'."
-  (interactive "r\nP")
-  (let ((cbuf (current-buffer)) tempfile firstline status)
-    (save-excursion
-      (goto-char start)
-      (when (re-search-forward uudecode-begin-line nil t)
-	(forward-line 1)
-	(setq firstline (point))
-	(cond ((null file-name))
-	      ((stringp file-name))
-	      (t
-	       (setq file-name (read-file-name "File to Name:"
-					       nil nil nil
-					       (match-string 1)))))
-	(setq tempfile (if file-name
-			   (expand-file-name file-name)
-			   (if (fboundp 'make-temp-file)
-			       (let ((temporary-file-directory
-				      uudecode-temporary-file-directory))
-				 (make-temp-file "uu"))
-			     (expand-file-name
-			      (make-temp-name "uu")
-			      uudecode-temporary-file-directory))))
-	(let ((cdir default-directory)
-	      (default-process-coding-system
-		(if (featurep 'xemacs)
-		    ;; In XEmacs, `nil' is not a valid coding system.
-		    '(binary . binary)
-		  nil)))
-	  (unwind-protect
-	      (with-temp-buffer
-		(insert "begin 600 " (file-name-nondirectory tempfile) "\n")
-		(insert-buffer-substring cbuf firstline end)
-		(cd (file-name-directory tempfile))
-		(apply 'call-process-region
-		       (point-min)
-		       (point-max)
-		       uudecode-decoder-program
-		       nil
-		       nil
-		       nil
-		       uudecode-decoder-switches))
-	    (cd cdir) (set-buffer cbuf)))
-	(if (file-exists-p tempfile)
-	    (unless file-name
-	      (goto-char start)
-	      (delete-region start end)
-	      (let (format-alist)
-		(insert-file-contents-literally tempfile)))
-	  (message "Can not uudecode")))
-      (ignore-errors (or file-name (delete-file tempfile))))))
-
-(eval-and-compile
-  (defalias 'uudecode-string-to-multibyte
-    (cond
-     ((featurep 'xemacs)
-      'identity)
-     ((fboundp 'string-to-multibyte)
-      'string-to-multibyte)
-     (t
-      (lambda (string)
-	"Return a multibyte string with the same individual chars as string."
-	(mapconcat
-	 (lambda (ch) (string-as-multibyte (char-to-string ch)))
-	 string ""))))))
-
-;;;###autoload
-(defun uudecode-decode-region-internal (start end &optional file-name)
-  "Uudecode region between START and END without using an external program.
-If FILE-NAME is non-nil, save the result to FILE-NAME."
-  (interactive "r\nP")
-  (let ((done nil)
-	(counter 0)
-	(remain 0)
-	(bits 0)
-	(lim 0) inputpos result
-	(non-data-chars (concat "^" uudecode-alphabet)))
-    (save-excursion
-      (goto-char start)
-      (when (re-search-forward uudecode-begin-line nil t)
-	(cond ((null file-name))
-	      ((stringp file-name))
-	      (t
-	       (setq file-name (expand-file-name
-				(read-file-name "File to Name:"
-						nil nil nil
-						(match-string 1))))))
-	(forward-line 1)
-	(skip-chars-forward non-data-chars end)
-	(while (not done)
-	  (setq inputpos (point))
-	  (setq remain 0 bits 0 counter 0)
-	  (cond
-	   ((> (skip-chars-forward uudecode-alphabet end) 0)
-	    (setq lim (point))
-	    (setq remain
-		  (logand (- (uudecode-char-int (char-after inputpos)) 32)
-			  63))
-	    (setq inputpos (1+ inputpos))
-	    (if (= remain 0) (setq done t))
-	    (while (and (< inputpos lim) (> remain 0))
-	      (setq bits (+ bits
-			    (logand
-			     (-
-			      (uudecode-char-int (char-after inputpos)) 32)
-			     63)))
-	      (if (/= counter 0) (setq remain (1- remain)))
-	      (setq counter (1+ counter)
-		    inputpos (1+ inputpos))
-	      (cond ((= counter 4)
-		     (setq result (cons
-				   (concat
-				    (char-to-string (lsh bits -16))
-				    (char-to-string (logand (lsh bits -8) 255))
-				    (char-to-string (logand bits 255)))
-				   result))
-		     (setq bits 0 counter 0))
-		    (t (setq bits (lsh bits 6)))))))
-	  (cond
-	   (done)
-	   ((> 0 remain)
-	    (error "uucode line ends unexpectly")
-	    (setq done t))
-	   ((and (= (point) end) (not done))
-	    ;;(error "uucode ends unexpectly")
-	    (setq done t))
-	   ((= counter 3)
-	    (setq result (cons
-			  (concat
-			   (char-to-string (logand (lsh bits -16) 255))
-			   (char-to-string (logand (lsh bits -8) 255)))
-			  result)))
-	   ((= counter 2)
-	    (setq result (cons
-			  (char-to-string (logand (lsh bits -10) 255))
-			  result))))
-	  (skip-chars-forward non-data-chars end))
-	(if file-name
-	    (let (default-enable-multibyte-characters)
-	      (with-temp-file file-name
-		(insert (apply 'concat (nreverse result)))))
-	  (or (markerp end) (setq end (set-marker (make-marker) end)))
-	  (goto-char start)
-	  (if enable-multibyte-characters
-	      (mapc #'(lambda (x) (insert (uudecode-string-to-multibyte x)))
-		    (nreverse result))
-	    (insert (apply 'concat (nreverse result))))
-	  (delete-region (point) end))))))
-
-;;;###autoload
-(defun uudecode-decode-region (start end &optional file-name)
-  "Uudecode region between START and END.
-If FILE-NAME is non-nil, save the result to FILE-NAME."
-  (if uudecode-use-external
-      (uudecode-decode-region-external start end file-name)
-    (uudecode-decode-region-internal start end file-name)))
-
-(provide 'uudecode)
-
-;;; arch-tag: e1f09ed5-62b4-4677-9f13-4e81c4fe8ce3
-;;; uudecode.el ends here
diff --git a/lisp/gnus/yenc.el b/lisp/gnus/yenc.el
index 7550186b35e..7843f6a9aa0 100644
--- a/lisp/gnus/yenc.el
+++ b/lisp/gnus/yenc.el
@@ -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."