Merge remote-tracking branch 'origin/no-gnus'
authorLars Ingebrigtsen <larsi@gnus.org>
Mon, 20 Feb 2012 07:20:52 +0000 (08:20 +0100)
committerLars Ingebrigtsen <larsi@gnus.org>
Mon, 20 Feb 2012 07:20:52 +0000 (08:20 +0100)
32 files changed:
.gitignore
GNUS-NEWS
lisp/ChangeLog
lisp/gnus-agent.el
lisp/gnus-art.el
lisp/gnus-compat.el [new file with mode: 0644]
lisp/gnus-group.el
lisp/gnus-msg.el
lisp/gnus-registry.el
lisp/gnus-start.el
lisp/gnus-sum.el
lisp/gnus-sync.el
lisp/gnus-util.el
lisp/gnus.el
lisp/imap.el [deleted file]
lisp/lpath.el
lisp/message.el
lisp/mm-archive.el [new file with mode: 0644]
lisp/mm-decode.el
lisp/mm-util.el
lisp/nnfolder.el
lisp/nnimap.el
lisp/nnmail.el
lisp/nnml.el
lisp/nntp.el
lisp/registry.el
lisp/shr.el
lisp/tests/gnustest-registry.el [new file with mode: 0644]
makepub
texi/ChangeLog
texi/gnus.texi
texi/message.texi

index 840562a..6445f33 100644 (file)
@@ -16,6 +16,7 @@ contrib/gnus-mdrtn.el
 contrib/on-loginfo
 contrib/request-assign.future
 etc/Makefile
+.gitattributes
 lisp/.gitattributes
 lisp/*.elc
 lisp/*.rej
@@ -27,6 +28,7 @@ lisp/gnus-load.el
 lisp/old
 lisp/semantic.cache
 lisp/version
+texi/.gitattributes
 texi/Makefile
 texi/auth
 texi/emacs-mime
index 12e4c62..8645500 100644 (file)
--- a/GNUS-NEWS
+++ b/GNUS-NEWS
@@ -7,257 +7,33 @@ Please send Gnus bug reports to bugs@gnus.org.
 For older news, see Gnus info node "New Features".
 
 \f
-* Installation changes
+* New features
 
-** Upgrading from previous (stable) version if you have used No Gnus.
+** If you have the "tnef" program installed, Gnus will display ms-tnef
+   files, aka "winmail.dat".
 
-If you have tried No Gnus (the unstable Gnus branch leading to this
-release) but went back to a stable version, be careful when upgrading to
-this version.  In particular, you will probably want to remove the
-`~/News/marks' directory (perhaps selectively), so that flags are read
-from your `~/.newsrc.eld' instead of from the stale marks file, where
-this release will store flags for nntp.  See a later entry for more
-information about nntp marks.  Note that downgrading isn't safe in
-general.
+** Archives (like tar and zip files) will be automatically unpacked,
+   and the files inside the packages will be displayed as MIME parts.
 
-** Incompatibility when switching from Emacs 23 to Emacs 22 In Emacs 23,
-Gnus uses Emacs' new internal coding system `utf-8-emacs' for saving
-articles drafts and `~/.newsrc.eld'.  These files may not be read
-correctly in Emacs 22 and below.  If you want to use Gnus across
-different Emacs versions, you may set `mm-auto-save-coding-system' to
-`emacs-mule'.
+** shr has a new command `z' that cycles through image sizes.
 
-** Lisp files are now installed in `.../site-lisp/gnus/' by default.  It
-defaulted to `.../site-lisp/' formerly.  In addition to this, the new
-installer issues a warning if other Gnus installations which will shadow
-the latest one are detected.  You can then remove those shadows manually
-or remove them using `make remove-installed-shadows'.
+** `backtab' in the summary buffer now selects the previous link in
+   the article buffer.
 
-** The installation directory name is allowed to have spaces and/or tabs.
-
-\f
-* New packages and libraries within Gnus
-
-** Gnus includes the Emacs Lisp SASL library.
-
-This provides a clean API to SASL mechanisms from within Emacs.  The
-user visible aspects of this, compared to the earlier situation, include
-support for DIGEST-MD5 and NTLM.   *Note Emacs SASL: (sasl)Top.
-
-** ManageSieve connections uses the SASL library by default.
-
-The primary change this brings is support for DIGEST-MD5 and NTLM, when
-the server supports it.
-
-** Gnus includes a password cache mechanism in password-cache.el.
-
-It is enabled by default (see `password-cache'), with a short timeout of
-16 seconds (see `password-cache-expiry').  If PGG is used as the PGP
-back end, the PGP passphrase is managed by this mechanism.  Passwords
-for ManageSieve connections are managed by this mechanism, after
-querying the user about whether to do so.
-
-** Using EasyPG with Gnus When EasyPG, is available, Gnus will use it
-instead of PGG.  EasyPG is an Emacs user interface to GNU Privacy Guard.
- *Note EasyPG Assistant user's manual: (epa)Top.  EasyPG is included in
-Emacs 23 and available separately as well.
-
-\f
-* Changes in group mode
-
-** Old intermediate incoming mail files (`Incoming*') are deleted after a
-couple of days, not immediately.  *Note Mail Source Customization::.
-(New in Gnus 5.10.10 / No Gnus 0.8)
-
-
-\f
-* Changes in summary and article mode
-
-** Gnus now supports sticky article buffers.  Those are article buffers
-that are not reused when you select another article.  *Note Sticky
-Articles::.
-
-** Gnus can selectively display `text/html' articles with a WWW browser
-with `K H'.  *Note MIME Commands::.
-
-** International host names (IDNA) can now be decoded inside article bodies
-using `W i' (`gnus-summary-idna-message').  This requires that GNU Libidn
-(`http://www.gnu.org/software/libidn/') has been installed.
-
-** The non-ASCII group names handling has been much improved.  The back
-ends that fully support non-ASCII group names are now `nntp', `nnml',
-and `nnrss'.  Also the agent, the cache, and the marks features work
-with those back ends.  *Note Non-ASCII Group Names::.
-
-** Gnus now displays DNS master files sent as text/dns using dns-mode.
-
-** Gnus supports new limiting commands in the Summary buffer: `/ r'
-(`gnus-summary-limit-to-replied') and `/ R'
-(`gnus-summary-limit-to-recipient').  *Note Limiting::.
-
-** You can now fetch all ticked articles from the server using `Y t'
-(`gnus-summary-insert-ticked-articles').  *Note Summary Generation
-Commands::.
-
-** Gnus supports a new sort command in the Summary buffer: `C-c C-s C-t'
-(`gnus-summary-sort-by-recipient').  *Note Summary Sorting::.
-
-** S/MIME now features LDAP user certificate searches.  You need to
-configure the server in `smime-ldap-host-list'.
-
-** URLs inside OpenPGP headers are retrieved and imported to your PGP key
-ring when you click on them.
-
-** Picons can be displayed right from the textual address, see
-`gnus-picon-style'.  *Note Picons::.
-
-** ANSI SGR control sequences can be transformed using `W A'.
-
-ANSI sequences are used in some Chinese hierarchies for highlighting
-articles (`gnus-article-treat-ansi-sequences').
-
-** Gnus now MIME decodes articles even when they lack "MIME-Version" header.
-This changes the default of `gnus-article-loose-mime'.
-
-** `gnus-decay-scores' can be a regexp matching score files.  For example,
-set it to `\\.ADAPT\\'' and only adaptive score files will be decayed.
- *Note Score Decays::.
-
-** Strings prefixing to the `To' and `Newsgroup' headers in summary lines
-when using `gnus-ignored-from-addresses' can be customized with
-`gnus-summary-to-prefix' and `gnus-summary-newsgroup-prefix'.  *Note To
-From Newsgroups::.
-
-** You can replace MIME parts with external bodies.  See
-`gnus-mime-replace-part' and `gnus-article-replace-part'.  *Note MIME
-Commands::, *note Using MIME::.
-
-** The option `mm-fill-flowed' can be used to disable treatment of
-format=flowed messages.  Also, flowed text is disabled when sending
-inline PGP signed messages.  *Note Flowed text: (emacs-mime)Flowed text.
-(New in Gnus 5.10.7)
-
-** Now the new command `S W' (`gnus-article-wide-reply-with-original') for
-a wide reply in the article buffer yanks a text that is in the active
-region, if it is set, as well as the `R'
-(`gnus-article-reply-with-original') command.  Note that the `R' command
-in the article buffer no longer accepts a prefix argument, which was
-used to make it do a wide reply.  *Note Article Keymap::.
-
-** The new command `C-h b' (`gnus-article-describe-bindings') used in the
-article buffer now shows not only the article commands but also the real
-summary commands that are accessible from the article buffer.
+** Using the "X-Message-SMTP-Method" header in Message buffers now
+   allows specifying how messages are to be sent.  For example:
 
+   X-Message-SMTP-Method: smtp smtp.fsf.org 587
 
-\f
-* Changes in Message mode
-
-** Gnus now supports the "hashcash" client puzzle anti-spam mechanism.  Use
-`(setq message-generate-hashcash t)' to enable.  *Note Hashcash::.
-
-** You can now drag and drop attachments to the Message buffer.  See
-`mml-dnd-protocol-alist' and `mml-dnd-attach-options'.  *Note MIME:
-(message)MIME.
-
-** The option `message-yank-empty-prefix' now controls how empty lines are
-prefixed in cited text.  *Note Insertion Variables: (message)Insertion
-Variables.
-
-** Gnus uses narrowing to hide headers in Message buffers.  The
-`References' header is hidden by default.  To make all headers visible,
-use `(setq message-hidden-headers nil)'.  *Note Message Headers:
-(message)Message Headers.
-
-** You can highlight different levels of citations like in the article
-buffer.  See `gnus-message-highlight-citation'.
-
-** `auto-fill-mode' is enabled by default in Message mode.  See
-`message-fill-column'.  *Note Message Headers: (message)Various Message
-Variables.
-
-** You can now store signature files in a special directory named
-`message-signature-directory'.
-
-** The option `message-citation-line-format' controls the format of the
-"Whomever writes:" line.  You need to set
-`message-citation-line-function' to
-`message-insert-formatted-citation-line' as well.
-
-\f
-* Changes in back ends
-
-** The nntp back end stores article marks in `~/News/marks'.
-
-The directory can be changed using the (customizable) variable
-`nntp-marks-directory', and marks can be disabled using the (back end)
-variable `nntp-marks-is-evil'.  The advantage of this is that you can
-copy `~/News/marks' (using rsync, scp or whatever) to another Gnus
-installation, and it will realize what articles you have read and
-marked.  The data in `~/News/marks' has priority over the same data in
-`~/.newsrc.eld'.
-
-** You can import and export your RSS subscriptions from OPML files.  *Note
-RSS::.
-
-** IMAP identity (RFC 2971) is supported.
-
-By default, Gnus does not send any information about itself, but you can
-customize it using the variable `nnimap-id'.
-
-** The `nnrss' back end now supports multilingual text.  Non-ASCII group
-names for the `nnrss' groups are also supported.  *Note RSS::.
-
-** Retrieving mail with POP3 is supported over SSL/TLS and with StartTLS.
+** Gnus keeps track of non-existent articles for nnimap groups, so
+   that sparse IMAP folders now list a correct number of messages in
+   them.
 
-** The nnml back end allows other compression programs beside `gzip' for
-compressed message files.  *Note Mail Spool::.
-
-** The nnml back end supports group compaction.
-
-This feature, accessible via the functions `gnus-group-compact-group'
-(`G z' in the group buffer) and `gnus-server-compact-server' (`z' in the
-server buffer) renumbers all articles in a group, starting from 1 and
-removing gaps.  As a consequence, you get a correct total article count
-(until messages are deleted again).
-
-
-\f
-* Appearance
-
-** The tool bar has been updated to use GNOME icons.  You can also
-customize the tool bars: `M-x customize-apropos RET -tool-bar$' should
-get you started.  (Only for Emacs, not in XEmacs.)
-
-** The tool bar icons are now (de)activated correctly in the group buffer,
-see the variable `gnus-group-update-tool-bar'.  Its default value
-depends on your Emacs version.
-
-** You can change the location of XEmacs' toolbars in Gnus buffers.  See
-`gnus-use-toolbar' and `message-use-toolbar'.
-
-
-\f
-* Miscellaneous changes
-
-** Having edited the select-method for the foreign server in the server
-buffer is immediately reflected to the subscription of the groups which
-use the server in question.  For instance, if you change
-`nntp-via-address' into `bar.example.com' from `foo.example.com', Gnus
-will connect to the news host by way of the intermediate host
-`bar.example.com' from next time.
-
-** The `all.SCORE' file can be edited from the group buffer using `W e'.
-
-** You can set `gnus-mark-copied-or-moved-articles-as-expirable' to a
-non-`nil' value so that articles that have been read may be marked as
-expirable automatically when copying or moving them to a group that has
-auto-expire turned on.  The default is `nil' and copying and moving of
-articles behave as before; i.e., the expirable marks will be unchanged
-except that the marks will be removed when copying or moving articles to
-a group that has not turned auto-expire on.  *Note Expiring Mail::.
-
-
-\f
+** Gnus will guess the real type of MIME parts of type
+   application/octet-stream based on the file suffix.  So an
+   application/octet-stream with a name of "rms.jpg" will be displayed
+   as an image/jpeg type by default, for instance.
+   
 * For older news, see Gnus info node "New Features".
 
 ----------------------------------------------------------------------
index d631b8b..69fd5ae 100644 (file)
@@ -1,3 +1,8 @@
+2012-02-19  Vida Gábor  <vidagabor@gmail.com>  (tiny change)
+
+       * gnus-demon.el (gnus-demon-init): Don't multiply time twice.
+       Reported by Peter Münster.
+
 2012-02-20  Lars Ingebrigtsen  <larsi@gnus.org>
 
        * nnimap.el (nnimap-log-command): Add the IMAP address to the log
 
 2012-02-15  Lars Ingebrigtsen  <larsi@gnus.org>
 
-       * shr.el (shr-remove-trailing-whitespace): Really delete the padding on
-       too-wide lines.
+       * imap.el: Remove.
+
+       * nntp.el (nntp-coding-system-for-read): Remove.
+       (nntp-coding-system-for-write): Ditto.
+       (nntp-open-connection): Just use `binary' directly.
+
+       * gnus-start.el (gnus-clean-old-newsrc): Delete `unexist' from pre-Ma
+       Gnus 0.3.
+
+2012-02-16  Lars Ingebrigtsen  <larsi@gnus.org>
+
+       * mm-decode.el (mm-dissect-singlepart): Guess what the type of
+       application/octet-stream parts really is.
+
+       * gnus-sum.el (gnus-propagate-marks): Remove.
 
 2012-02-15  Paul Eggert  <eggert@cs.ucla.edu>
 
        * shr.el (shr-rescale-image): Undo previous change; see
        <http://lists.gnu.org/archive/html/emacs-devel/2012-02/msg00540.html>.
 
+2012-02-15  Lars Magne Ingebrigtsen  <lars@ingebrigtsen.no>
+
+       * gnus.el: Ma Gnus v0.3 is released.
+
+2012-02-15  Lars Ingebrigtsen  <larsi@gnus.org>
+
+       * gnus-sum.el (gnus-summary-local-variables): Make
+       `gnus-newsgroup-unexist' into a local variable.
+
+2012-02-14  Teodor Zlatanov  <tzz@lifelogs.com>
+
+       * registry.el (registry-usage-test, registry-persistence-test): Move to
+       tests/gnustest-registry.el.
+       (registry-make-testable-db, registry-match-test)
+       (registry-instantiation-test): Move to tests/gnustest-registry.el.
+
+       * gnus-registry.el (gnus-registry-misc-test)
+       (gnus-registry-usage-test): Move to tests/gnustest-registry.el.
+
+       * tests/gnustest-registry.el: New file with the registry and
+       gnus-registry ERT tests.
+
+2012-02-13  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+       * gnus-msg.el (gnus-summary-resend-message): Make
+       gnus-summary-resend-message-insert-gcc be last item in
+       message-header-setup-hook.
+
+2012-02-13  Lars Ingebrigtsen  <larsi@gnus.org>
+
+       * nnfolder.el (nnfolder-marks-directory, nnfolder-marks-is-evil)
+       (nnfolder-marks, nnfolder-marks-file-suffix, nnfolder-marks-modtime):
+       Remove.
+       (nnfolder-open-server): Don't use marks.
+       (nnfolder-request-delete-group): Ditto.
+       (nnfolder-request-rename-group): Ditto.
+       (nnfolder-request-set-mark, nnfolder-request-marks)
+       (nnfolder-group-marks-pathname, nnfolder-marks-changed-p)
+       (nnfolder-save-marks, nnfolder-open-marks): Remove.
+
+       * nnml.el (nnml-marks-is-evil, nnml-marks-file-name, nnml-marks)
+       (nnml-marks-modtime): Remove.
+       (nnml-request-delete-group): Don't use marks.
+       (nnml-request-rename-group): Ditto.
+       (nnml-request-set-mark, nnml-request-marks, nnml-marks-changed-p)
+       (nnml-save-marks, nnml-open-marks): Remove.
+
+       * nntp.el (nntp-marks-is-evil, nntp-marks-file-name, nntp-marks)
+       (nntp-marks-modtime, nntp-marks-directory, nntp-request-set-mark)
+       (nntp-request-marks, nntp-marks-directory, nntp-marks-changed-p)
+       (nntp-save-marks, nntp-open-marks, nntp-possibly-create-directory)
+       (nntp-server-to-method-cache): Remove.
+
+       * shr.el (shr-rescale-image): Fix wrong merge.
+
+2012-02-15  Lars Ingebrigtsen  <larsi@gnus.org>
+
+       * shr.el (shr-remove-trailing-whitespace): Really delete the padding on
+       too-wide lines.
+
 2012-02-13  Lars Ingebrigtsen  <larsi@gnus.org>
 
        * nnimap.el (nnimap-record-commands): New variable.
        * auth-source.el (auth-source-cache-expiry):
        Add missing :version tags to new defcustoms and defgroups.
 
+2012-02-11  Lars Ingebrigtsen  <larsi@gnus.org>
+
+       * gnus-sum.el (gnus-adjust-marked-articles): Add to
+       `gnus-newsgroup-unexist'.
+
+       * gnus.el (gnus-article-mark-lists): Add `unexist' to the list of
+       marks.
+       (gnus-article-special-mark-lists): Put the `unexist' in the special
+       marks list instead.
+
+       * gnus-sum.el (gnus-articles-to-read): Don't include unexisting
+       articles in the list of articles to be selected.
+
+       * nnimap.el (nnimap-retrieve-group-data-early): Query for unexisting
+       articles.
+       (nnimap-update-info): Keep track of unexisting articles.
+       (nnimap-update-qresync-info): Ditto.
+
 2012-02-10  Lars Ingebrigtsen  <larsi@gnus.org>
 
        * message.el (message-default-send-mail-function): Made into own
        * gnus.el (gnus-method-ephemeral-p): Move after declaration of defsubst
        `gnus-sloppily-equal-method-parameters' to avoid a warning.
 
+2012-02-09  Lars Ingebrigtsen  <larsi@gnus.org>
+
+       * mm-archive.el (mm-archive-dissect-and-inline): New function.
+       (mm-archive-dissect-and-inline): Fix up the undisplayer.
+
+       * gnus-compat.el: Define `timer-set-function'.
+
+       * mm-decode.el (mm-display-external): Output the text from the command
+       in the buffer after the command finished.  This makes text-based
+       commands behave better.
+
+2012-02-08  Lars Ingebrigtsen  <larsi@gnus.org>
+
+       * gnus-compat.el: Add a compat for the old `url-retrieve'.
+
+2012-02-07  Lars Ingebrigtsen  <larsi@gnus.org>
+
+       * gnus-compat.el: Make `help-function-arglist' be compatible on Emacs
+       23.1.
+
+2012-02-07  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+       * gnus-sum.el (gnus-summary-show-thread): Revert last two changes.
+
+2012-02-07  Lars Ingebrigtsen  <larsi@gnus.org>
+
+       * message.el (smtpmail-smtp-user): Silence compiler warning.
+
+2012-02-06  Lars Ingebrigtsen  <larsi@gnus.org>
+
+       * message.el (message-multi-smtp-send-mail): Also allow specifying the
+       SMTP user name.
+
+2012-02-06  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+       * gnus-sum.el (gnus-summary-show-thread):
+       next-single-char-property-change may return nil in XEmacs.
+       (gnus-summary-article-map): Fix typo.
+
 2012-02-09  Lars Ingebrigtsen  <larsi@gnus.org>
 
        * gnus-msg.el (gnus-msg-mail): Use `message-mail' if Gnus isn't
        lines that are narrower than the window width.  Otherwise background
        "blocks" will look less readable.
 
-2012-02-07  Katsumi Yamaoka  <yamaoka@jpl.org>
-
-       * gnus-sum.el (gnus-summary-show-thread): Revert last two changes.
-
 2012-02-07  Lars Ingebrigtsen  <larsi@gnus.org>
 
        * nnimap.el (nnimap-transform-headers): Remove unused variable.
        * gnus-sum.el (gnus-summary-exit-no-update): Really deaden the summary
        buffer if `gnus-kill-summary-on-exit' is nil.
 
-2012-02-06  Katsumi Yamaoka  <yamaoka@jpl.org>
-
-       * gnus-sum.el (gnus-summary-show-thread):
-       next-single-char-property-change may return nil in XEmacs.
-
 2012-02-06  Lars Ingebrigtsen  <larsi@gnus.org>
 
        * gnus-sum.el (gnus-handle-ephemeral-exit): Allow exiting from Gnus
        * gnus-sum.el (gnus-summary-show-thread):
        next-single-char-property-change never returns nil (Bug#8657).
 
+2012-02-02  Lars Ingebrigtsen  <larsi@gnus.org>
+
+       * message.el (message-multi-smtp-send-mail): New function.
+       (message-multi-smtp-send-mail): Respect the X-Message-SMTP-Method
+       header to implement multi-SMTP functionality.
+
+       * gnus-agent.el (gnus-agent-send-mail-function): Removed.
+       (gnus-agentize): Don't set it.
+       (gnus-agent-send-mail): Don't use it.
+
+       * gnus-sum.el (gnus-summary-widget-backward): New function and
+       keystroke.
+
+       * gnus-compat.el: More the compat functions more compatible.
+
+       * shr.el (shr-put-image): Remove underlines from sliced images.
+       (shr-zoom-image): Compute the region to be replaced more correctly.
+
+2012-02-02  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+       * gnus-msg.el (gnus-gcc-self-resent-messages): New user option.
+       (gnus-summary-resend-message-insert-gcc): New function.
+       (gnus-summary-resend-message): Modify message-header-setup-hook and
+       message-sent-hook to make it work for Gcc.
+       (gnus-inews-do-gcc): Update the number of unread articles of groups
+       that messages are Gcc'd to.
+
+       * message.el (message-resend): Run message-sent-hook to do Gcc.
+
+2012-02-01  Lars Ingebrigtsen  <larsi@gnus.org>
+
+       * lpath.el: Fix an XEmacs compilation warning.
+
+       * gnus-compat.el: Require `help-fns' to fix compilation error.
+
+       * gnus-registry.el (gnus-registry-fixup-registry): Move the message to
+       a higher level to silence compilation.
+
+       * gnus-art.el (gnus-shr-put-image): Take and pass on a `flags'
+       parameter to allow controlling the scaling.
+
+       * shr.el (shr-zoom-image): New command and keystroke.
+       (shr-put-image): Take a `size' flag to say how to scale the image.
+
+       * gnus-compat.el: Redefine `delete-directory' to provide recursive
+       deletion unless already defined.
+
+       * gnus.el (gnus-compat): Require it.
+
+       * gnus-compat.el: New file.
+
+       * gnus-start.el (gnus-clean-old-newsrc): New function.
+       (gnus-read-newsrc-file): Use it.
+
+       * mm-archive.el (mm-dissect-archive): Use it to get all file names.
+       Use recursive deletion.
+       (mm-dissect-archive): Add support for zip files.
+
+       * gnus-util.el (gnus-recursive-directory-files): New function.
+
+       * mm-archive.el (mm-archive-list-files): Inline text and image parts.
+       (mm-archive-decoders): Add tgz support.
+
+       * mm-decode.el (mm-shr): Make sure that the HTML ends with a newline.
+       Otherwise inserting text into the Gnus buffer can look odd.
+
+       * gnus-art.el (gnus-mime-inline-part): Slight clean-up.
+
+       * mm-archive.el (mm-archive-decoders): Add support for tar.
+
+       * gnus.el (gnus-logo-color-alist): Change the colours for Ma Gnus.
+
+       * nnmail.el (nnmail-extra-headers): Add Cc to the default.
+
+2012-01-31  Lars Ingebrigtsen  <larsi@gnus.org>
+
+       * mm-decode.el (mm-dissect-singlepart): Check that the decoder exists.
+
+       * mm-archive.el: New file.
+
+       * mm-decode.el (mm-dissect-singlepart): Use it to decode ms-tnef files.
+
+       * mm-util.el (mm-find-buffer-file-coding-system): Comment fix.
+
+       * message.el (message-goto-*): Make all the `message-goto-*' commands
+       push the mark before moving point.  This makes it easier to go back to
+       where you came from after editing whatever you jumped to.
+
+2012-01-31  Lars Magne Ingebrigtsen  <lars@ingebrigtsen.no>
+
+       * gnus.el: Ma Gnus v0.1 is released.
+
 2012-02-05  Lars Ingebrigtsen  <larsi@gnus.org>
 
        * nnimap.el (nnimap-open-server): Allow switching the nnoo server
 2012-01-31  Jim Meyering  <jim@meyering.net>
 
        * gnus-agent.el (gnus-agent-expire-unagentized-dirs):
-        Correct a comment (insert "not") and hide nominally-doubled "to".
+       Correct a comment (insert "not") and hide nominally-doubled "to".
 
-2012-01-31  Lars Magne Ingebrigtsen  <lars@ingebrigtsen.no>
+2012-01-31  Lars Ingebrigtsen  <larsi@gnus.org>
 
-       * gnus.el: No Gnus v0.19 is released.
+       * gnus.el (gnus-version): Change name to "Ma Gnus".
 
 2012-01-30  Philipp Haselwarter  <philipp.haselwarter@gmx.de>  (tiny change)
 
index 5178220..284a378 100644 (file)
@@ -242,7 +242,6 @@ NOTES:
 (defvar gnus-category-group-cache nil)
 (defvar gnus-agent-spam-hashtb nil)
 (defvar gnus-agent-file-name nil)
-(defvar gnus-agent-send-mail-function nil)
 (defvar gnus-agent-file-coding-system 'raw-text)
 (defvar gnus-agent-file-loading-cache nil)
 (defvar gnus-agent-total-fetched-hashtb nil)
@@ -683,11 +682,7 @@ This will modify the `gnus-setup-news-hook', and
 minor mode in all Gnus buffers."
   (interactive)
   (gnus-open-agent)
-  (unless gnus-agent-send-mail-function
-    (setq gnus-agent-send-mail-function
-         (or message-send-mail-real-function
-             (function (lambda () (funcall message-send-mail-function))))
-         message-send-mail-real-function 'gnus-agent-send-mail))
+  (setq message-send-mail-real-function 'gnus-agent-send-mail)
 
   ;; If the servers file doesn't exist, auto-agentize some servers and
   ;; save the servers file so this auto-agentizing isn't invoked
@@ -723,7 +718,7 @@ Optional arg GROUP-NAME allows to specify another group."
 (defun gnus-agent-send-mail ()
   (if (or (not gnus-agent-queue-mail)
          (and gnus-plugged (not (eq gnus-agent-queue-mail 'always))))
-      (funcall gnus-agent-send-mail-function)
+      (message-multi-smtp-send-mail)
     (goto-char (point-min))
     (re-search-forward
      (concat "^" (regexp-quote mail-header-separator) "\n"))
index 048f895..32399e1 100644 (file)
@@ -5327,9 +5327,8 @@ Compressed files like .gz and .bz2 are decompressed."
                (or (cdr (assq arg
                               gnus-summary-show-article-charset-alist))
                    (mm-read-coding-system "Charset: "))))
-        (t
-         (if (mm-handle-undisplayer handle)
-             (mm-remove-part handle))))
+        ((mm-handle-undisplayer handle)
+         (mm-remove-part handle)))
        (forward-line 2)
         (mm-display-inline handle)
        (goto-char b)))))
@@ -6198,12 +6197,13 @@ Provided for backwards compatibility."
             (not gnus-inhibit-hiding))
     (gnus-article-hide-headers)))
 
-(declare-function shr-put-image "shr" (data alt))
+(declare-function shr-put-image "shr" (data alt &optional flags))
 
-(defun gnus-shr-put-image (data alt)
+(defun gnus-shr-put-image (data alt &optional flags)
   "Put image DATA with a string ALT.  Enable image to be deleted."
   (let ((image (shr-put-image data (propertize (or alt "*")
-                                              'gnus-image-category 'shr))))
+                                              'gnus-image-category 'shr)
+                             flags)))
     (when image
       (gnus-add-image 'shr image))))
 
diff --git a/lisp/gnus-compat.el b/lisp/gnus-compat.el
new file mode 100644 (file)
index 0000000..1307488
--- /dev/null
@@ -0,0 +1,102 @@
+;;; gnus-compat.el --- Compatability functions for Gnus
+
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; Keywords: compat
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This package defines and redefines a bunch of functions for Gnus
+;; usage.  The basic (and somewhat unsound) idea is to make all
+;; Emacsen look like the current trunk of Emacs.  So it will define
+;; functions "missing" in other Emacs instances, and redefine other
+;; functions to work like the Emacs trunk versions.
+
+(eval-when-compile (require 'cl))
+
+(ignore-errors
+  (require 'help-fns))
+
+;; XEmacs doesn't have this function.
+(when (and (not (fboundp 'help-function-arglist))
+          (fboundp 'function-arglist))
+  (defun help-function-arglist (def &optional preserve-names)
+    "Return a formal argument list for the function DEF.
+PRESERVE-NAMES is ignored."
+    (cdr (car (read-from-string (downcase (function-arglist def)))))))
+
+;; Modify this function on Emacs 23.1 and earlier to always return the
+;; right answer.
+(when (and (fboundp 'help-function-arglist)
+          (eq (help-function-arglist 'car) t))
+  (defvar gnus-compat-original-help-function-arglist
+    (symbol-function 'help-function-arglist))
+  (defun help-function-arglist (def &optional preserve-names)
+    "Return a formal argument list for the function DEF.
+PRESERVE-NAMES is ignored."
+    (let ((orig (funcall gnus-compat-original-help-function-arglist def)))
+      (if (not (eq orig t))
+         orig
+       ;; Built-in subrs have the arglist hidden in the doc string.
+       (let ((doc (documentation def)))
+         (when (and doc
+                    (string-match "\n\n\\((fn\\( .*\\)?)\\)\\'" doc))
+           (cdr (car (read-from-string (downcase (match-string 1 doc)))))))))))
+
+(when (= (length (help-function-arglist 'delete-directory)) 1)
+  (defvar gnus-compat-original-delete-directory
+    (symbol-function 'delete-directory))
+  (defun delete-directory (directory &optional recursive trash)
+    "Delete the directory named DIRECTORY.  Does not follow symlinks.
+If RECURSIVE is non-nil, all files in DIRECTORY are deleted as well.
+TRASH is ignored."
+    (interactive "DDirectory: ")
+    (if (not recursive)
+       (funcall gnus-compat-original-delete-directory directory)
+      (dolist (file (directory-files directory t))
+       (unless (member (file-name-nondirectory file) '("." ".."))
+         (if (file-directory-p file)
+             (delete-directory file t)
+           (delete-file file))))
+      (delete-directory directory))))
+
+;; Emacs 24.0.93
+(require 'url)
+(when (= (length (help-function-arglist 'url-retrieve)) 5)
+  (defvar gnus-compat-original-url-retrieve
+    (symbol-function 'url-retrieve))
+  (defun url-retrieve (url callback &optional cbargs silent inhibit-cookies)
+    "Retrieve URL asynchronously and call CALLBACK with CBARGS when finished."
+    (funcall gnus-compat-original-url-retrieve
+            url callback cbargs silent)))
+
+;; XEmacs
+(when (and (not (fboundp 'timer-set-function))
+          (fboundp 'set-itimer-function))
+  (defun timer-set-function (timer function &optional args)
+    "Make TIMER call FUNCTION with optional ARGS when triggering."
+    (lexical-let ((function function)
+                 (args args))
+      (set-itimer-function timer
+                          (lambda (process status)
+                            (apply function process status args))))))
+
+(provide 'gnus-compat)
+
+;; gnus-compat.el ends here
index 5165e9c..f75ef37 100644 (file)
@@ -56,7 +56,7 @@
 
 (autoload 'gnus-group-make-nnir-group "nnir")
 
-(defcustom gnus-no-groups-message "No Gnus is good news"
+(defcustom gnus-no-groups-message "No news is good news"
   "*Message displayed by Gnus when no groups are available."
   :group 'gnus-start
   :type 'string)
index f92dc5e..ecad92f 100644 (file)
@@ -163,6 +163,22 @@ if nil, attach files as normal parts."
                 (const all :tag "Any")
                 (string :tag "Regexp")))
 
+(defcustom gnus-gcc-self-resent-messages 'no-gcc-self
+  "Like `gcc-self' group parameter, only for unmodified resent messages.
+Applied to messages sent by `gnus-summary-resend-message'.  Non-nil
+value of this variable takes precedence over any existing Gcc header.
+
+If this is `none', no Gcc copy will be made.  If this is t, messages
+resent will be Gcc'd to the current group.  If this is a string, it
+specifies a group to which resent messages will be Gcc'd.  If this is
+nil, Gcc will be done according to existing Gcc header(s), if any.
+If this is `no-gcc-self', resent messages will be Gcc'd to groups that
+existing Gcc header specifies, except for the current group."
+  :version "24.2"
+  :group 'gnus-message
+  :type '(choice (const none) (const t) string (const nil)
+                (const no-gcc-self)))
+
 (gnus-define-group-parameter
  posting-charset-alist
  :type list
@@ -1268,6 +1284,43 @@ For the \"inline\" alternatives, also see the variable
            (set-buffer gnus-original-article-buffer)
            (message-forward post)))))))
 
+(defun gnus-summary-resend-message-insert-gcc ()
+  "Insert Gcc header according to `gnus-gcc-self-resent-messages'."
+  (gnus-inews-insert-gcc)
+  (let ((gcc (mapcar
+             (lambda (group)
+               (mm-encode-coding-string
+                group
+                (gnus-group-name-charset (gnus-inews-group-method group)
+                                         group)))
+             (message-unquote-tokens
+              (message-tokenize-header (mail-fetch-field "gcc" nil t)
+                                       " ,")))))
+    (message-remove-header "gcc")
+    (when gcc
+      (goto-char (point-max))
+      (cond ((eq gnus-gcc-self-resent-messages 'none))
+           ((eq gnus-gcc-self-resent-messages t)
+            (insert "Gcc: \"" gnus-newsgroup-name "\"\n"))
+           ((stringp gnus-gcc-self-resent-messages)
+            (insert "Gcc: "
+                    (mm-encode-coding-string
+                     (if (string-match " " gnus-gcc-self-resent-messages)
+                         (concat "\"" gnus-gcc-self-resent-messages "\"")
+                       gnus-gcc-self-resent-messages)
+                     (gnus-group-name-charset
+                      (gnus-inews-group-method gnus-gcc-self-resent-messages)
+                      gnus-gcc-self-resent-messages))
+                    "\n"))
+           ((null gnus-gcc-self-resent-messages)
+            (insert "Gcc: " (mapconcat 'identity gcc ", ") "\n"))
+           ((eq gnus-gcc-self-resent-messages 'no-gcc-self)
+            (when (setq gcc (delete
+                             gnus-newsgroup-name
+                             (delete (concat "\"" gnus-newsgroup-name "\"")
+                                     gcc)))
+              (insert "Gcc: " (mapconcat 'identity gcc ", ") "\n")))))))
+
 (defun gnus-summary-resend-message (address n)
   "Resend the current article to ADDRESS."
   (interactive
@@ -1281,12 +1334,21 @@ For the \"inline\" alternatives, also see the variable
            (with-current-buffer gnus-original-article-buffer
              (nnmail-fetch-field "to"))))
         current-prefix-arg))
-  (dolist (article (gnus-summary-work-articles n))
-    (gnus-summary-select-article nil nil nil article)
-    (with-current-buffer gnus-original-article-buffer
-      (let ((gnus-gcc-externalize-attachments nil))
-       (message-resend address)))
-    (gnus-summary-mark-article-as-forwarded article)))
+  (let ((message-header-setup-hook (copy-sequence message-header-setup-hook))
+       (message-sent-hook (copy-sequence message-sent-hook)))
+    ;; `gnus-summary-resend-message-insert-gcc' must run last.
+    (add-hook 'message-header-setup-hook
+             'gnus-summary-resend-message-insert-gcc t)
+    (add-hook 'message-sent-hook (if gnus-agent
+                                    'gnus-agent-possibly-do-gcc
+                                  'gnus-inews-do-gcc))
+    (dolist (article (gnus-summary-work-articles n))
+      (gnus-summary-select-article nil nil nil article)
+      (with-current-buffer gnus-original-article-buffer
+       (let ((gnus-gcc-externalize-attachments nil)
+             (message-inhibit-body-encoding t))
+         (message-resend address)))
+      (gnus-summary-mark-article-as-forwarded article))))
 
 ;; From: Matthieu Moy <Matthieu.Moy@imag.fr>
 (defun gnus-summary-resend-message-edit ()
@@ -1628,12 +1690,16 @@ this is a reply."
              (when (and group-art
                         ;; FIXME: Should gcc-mark-as-read work when
                         ;; Gnus is not running?
-                        (gnus-alive-p)
-                        (or gnus-gcc-mark-as-read
-                            (and
-                             (boundp 'gnus-inews-mark-gcc-as-read)
-                             (symbol-value 'gnus-inews-mark-gcc-as-read))))
-               (gnus-group-mark-article-read group (cdr group-art)))
+                        (gnus-alive-p))
+               (if (or gnus-gcc-mark-as-read
+                       (and (boundp 'gnus-inews-mark-gcc-as-read)
+                            (symbol-value 'gnus-inews-mark-gcc-as-read)))
+                   (gnus-group-mark-article-read group (cdr group-art))
+                 (with-current-buffer gnus-group-buffer
+                   (let ((gnus-group-marked (list group))
+                         (gnus-get-new-news-hook nil)
+                         (inhibit-read-only t))
+                     (gnus-group-get-new-news-this-group nil t)))))
              (setq options message-options)
              (with-current-buffer cur (setq message-options options))
              (kill-buffer (current-buffer)))))))))
index f1618b3..4221af6 100644 (file)
 
 (eval-when-compile (require 'cl))
 
-(eval-when-compile
-  (when (null (ignore-errors (require 'ert)))
-    (defmacro* ert-deftest (name () &body docstring-keys-and-body))))
-
-(ignore-errors
-  (require 'ert))
 (require 'gnus)
 (require 'gnus-int)
 (require 'gnus-sum)
@@ -267,7 +261,7 @@ the Bit Bucket."
             (append gnus-registry-track-extra
                     '(mark group keyword)))
       (when (not (equal old (oref db :tracked)))
-        (gnus-message 4 "Reindexing the Gnus registry (tracked change)")
+        (gnus-message 9 "Reindexing the Gnus registry (tracked change)")
         (registry-reindex db))))
   db)
 
@@ -1078,79 +1072,6 @@ only the last one's marks are returned."
             (gnus-registry-set-id-key id key val))))
       (message "Import done, collected %d entries" count))))
 
-(ert-deftest gnus-registry-misc-test ()
-  (should-error (gnus-registry-extract-addresses '("" "")))
-
-  (should (equal '("Ted Zlatanov <tzz@lifelogs.com>"
-                   "noname <ed@you.me>"
-                   "noname <cyd@stupidchicken.com>"
-                   "noname <tzz@lifelogs.com>")
-                 (gnus-registry-extract-addresses
-                  (concat "Ted Zlatanov <tzz@lifelogs.com>, "
-                          "ed <ed@you.me>, " ; "ed" is not a valid name here
-                          "cyd@stupidchicken.com, "
-                          "tzz@lifelogs.com")))))
-
-(ert-deftest gnus-registry-usage-test ()
-  (let* ((n 100)
-         (tempfile (make-temp-file "gnus-registry-persist"))
-         (db (gnus-registry-make-db tempfile))
-         (gnus-registry-db db)
-         back size)
-    (message "Adding %d keys to the test Gnus registry" n)
-    (dotimes (i n)
-      (let ((id (number-to-string i)))
-        (gnus-registry-handle-action id
-                                     (if (>= 50 i) "fromgroup" nil)
-                                     "togroup"
-                                     (when (>= 70 i)
-                                       (format "subject %d" (mod i 10)))
-                                     (when (>= 80 i)
-                                       (format "sender %d" (mod i 10))))))
-    (message "Testing Gnus registry size is %d" n)
-    (should (= n (registry-size db)))
-    (message "Looking up individual keys (registry-lookup)")
-    (should (equal (loop for e
-                         in (mapcar 'cadr
-                                    (registry-lookup db '("20" "83" "72")))
-                         collect (assq 'subject e)
-                         collect (assq 'sender e)
-                         collect (assq 'group e))
-                   '((subject "subject 0") (sender "sender 0") (group "togroup")
-                     (subject) (sender) (group "togroup")
-                     (subject) (sender "sender 2") (group "togroup"))))
-
-    (message "Looking up individual keys (gnus-registry-id-key)")
-    (should (equal (gnus-registry-get-id-key "34" 'group) '("togroup")))
-    (should (equal (gnus-registry-get-id-key "34" 'subject) '("subject 4")))
-    (message "Trying to insert a duplicate key")
-    (should-error (gnus-registry-insert db "55" '()))
-    (message "Looking up individual keys (gnus-registry-get-or-make-entry)")
-    (should (gnus-registry-get-or-make-entry "22"))
-    (message "Saving the Gnus registry to %s" tempfile)
-    (should (gnus-registry-save tempfile db))
-    (setq size (nth 7 (file-attributes tempfile)))
-    (message "Saving the Gnus registry to %s: size %d" tempfile size)
-    (should (< 0 size))
-    (with-temp-buffer
-      (insert-file-contents-literally tempfile)
-      (should (looking-at (concat ";; Object "
-                                  "Gnus Registry"
-                                  "\n;; EIEIO PERSISTENT OBJECT"))))
-    (message "Reading Gnus registry back")
-    (setq back (eieio-persistent-read tempfile))
-    (should back)
-    (message "Read Gnus registry back: %d keys, expected %d==%d"
-             (registry-size back) n (registry-size db))
-    (should (= (registry-size back) n))
-    (should (= (registry-size back) (registry-size db)))
-    (delete-file tempfile)
-    (message "Pruning Gnus registry to 0 by setting :max-soft")
-    (oset db :max-soft 0)
-    (registry-prune db)
-    (should (= (registry-size db) 0)))
-  (message "Done with Gnus registry usage testing."))
-
 ;;;###autoload
 (defun gnus-registry-initialize ()
 "Initialize the Gnus registry."
index ad2d713..c4603b5 100644 (file)
@@ -1504,8 +1504,6 @@ backend check whether the group actually exists."
             ;; Return the new active info.
             active)))))
 
-(defvar gnus-propagate-marks)          ; gnus-sum
-
 (defun gnus-get-unread-articles-in-group (info active &optional update)
   (when (and info active)
     ;; Allow the backend to update the info in the group.
@@ -1515,13 +1513,6 @@ backend check whether the group actually exists."
                              (gnus-info-group info)))))
       (gnus-activate-group (gnus-info-group info) nil t))
 
-    ;; Allow backends to update marks,
-    (when gnus-propagate-marks
-      (let ((method (inline (gnus-find-method-for-group
-                            (gnus-info-group info)))))
-       (when (gnus-check-backend-function 'request-marks (car method))
-         (gnus-request-marks info method))))
-
     (let* ((range (gnus-info-read info))
           (num 0))
 
@@ -2303,7 +2294,19 @@ If FORCE is non-nil, the .newsrc file is read."
          (gnus-message 5 "Reading %s...done" newsrc-file)))
 
       ;; Convert old to new.
-      (gnus-convert-old-newsrc))))
+      (gnus-convert-old-newsrc)
+      (gnus-clean-old-newsrc))))
+
+(defun gnus-clean-old-newsrc ()
+  (when gnus-newsrc-file-version
+    (when (< (gnus-continuum-version gnus-newsrc-file-version)
+            (gnus-continuum-version "Ma Gnus v0.03"))
+      ;; Remove old `exist' marks from old nnimap groups.
+      (dolist (info (cdr gnus-newsrc-alist))
+       (let ((exist (assoc 'unexist (gnus-info-marks info))))
+         (when exist
+           (gnus-info-set-marks
+            info (delete exist (gnus-info-marks info)))))))))
 
 (defun gnus-convert-old-newsrc ()
   "Convert old newsrc formats into the current format, if needed."
index 8ae8d0b..7033573 100644 (file)
@@ -1243,13 +1243,6 @@ For example: ((1 . cn-gb-2312) (2 . big5))."
   :type 'boolean
   :group 'gnus-summary-marks)
 
-(defcustom gnus-propagate-marks nil
-  "If non-nil, Gnus will store and retrieve marks from the backends.
-This means that marks will be stored both in .newsrc.eld and in
-the backend, and will slow operation down somewhat."
-  :type 'boolean
-  :group 'gnus-summary-marks)
-
 (defcustom gnus-alter-articles-to-read-function nil
   "Function to be called to alter the list of articles to be selected."
   :type '(choice (const nil) function)
@@ -1530,6 +1523,9 @@ This list will always be a subset of gnus-newsgroup-undownloaded.")
 (defvar gnus-newsgroup-seen nil
   "Range of seen articles in the current newsgroup.")
 
+(defvar gnus-newsgroup-unexist nil
+  "Range of unexistent articles in the current newsgroup.")
+
 (defvar gnus-newsgroup-articles nil
   "List of articles in the current newsgroup.")
 
@@ -1577,6 +1573,7 @@ This list will always be a subset of gnus-newsgroup-undownloaded.")
     gnus-newsgroup-killed
     gnus-newsgroup-unseen
     gnus-newsgroup-seen
+    gnus-newsgroup-unexist
     gnus-newsgroup-cached
     gnus-newsgroup-downloadable
     gnus-newsgroup-undownloaded
@@ -1918,6 +1915,7 @@ increase the score of each group you read."
   "x" gnus-summary-limit-to-unread
   "s" gnus-summary-isearch-article
   [tab] gnus-summary-widget-forward
+  [backtab] gnus-summary-widget-backward
   "t" gnus-summary-toggle-header
   "g" gnus-summary-show-article
   "l" gnus-summary-goto-last-article
@@ -2082,6 +2080,7 @@ increase the score of each group you read."
   "g" gnus-summary-show-article
   "s" gnus-summary-isearch-article
   [tab] gnus-summary-widget-forward
+  [backtab] gnus-summary-widget-backward
   "P" gnus-summary-print-article
   "S" gnus-sticky-article
   "M" gnus-mailing-list-insinuate
@@ -5673,7 +5672,7 @@ If SELECT-ARTICLES, only select those articles from GROUP."
        (setq gnus-newsgroup-unselected
              (gnus-sorted-difference gnus-newsgroup-unreads articles))
       (setq articles (gnus-articles-to-read group read-all)))
-
+    
     (cond
      ((null articles)
       ;;(gnus-message 3 "Couldn't select newsgroup -- no articles to display")
@@ -5812,6 +5811,7 @@ If SELECT-ARTICLES, only select those articles from GROUP."
   "Find out what articles the user wants to read."
   (let* ((only-read-p t)
         (articles
+         (gnus-list-range-difference
          ;; Select all articles if `read-all' is non-nil, or if there
          ;; are no unread articles.
          (if (or read-all
@@ -5838,7 +5838,8 @@ If SELECT-ARTICLES, only select those articles from GROUP."
            (setq only-read-p nil)
            (gnus-sorted-nunion
             (gnus-sorted-union gnus-newsgroup-dormant gnus-newsgroup-marked)
-            gnus-newsgroup-unreads)))
+            gnus-newsgroup-unreads))
+         (cdr (assq 'unexist (gnus-info-marks (gnus-get-info group))))))
         (scored-list (gnus-killed-articles gnus-newsgroup-killed articles))
         (scored (length scored-list))
         (number (length articles))
@@ -5965,7 +5966,6 @@ If SELECT-ARTICLES, only select those articles from GROUP."
       (setq mark (car marks)
            mark-type (gnus-article-mark-to-type mark)
            var (intern (format "gnus-newsgroup-%s" (car (rassq mark types)))))
-
       ;; We set the variable according to the type of the marks list,
       ;; and then adjust the marks to a subset of the active articles.
       (cond
@@ -6020,7 +6020,9 @@ If SELECT-ARTICLES, only select those articles from GROUP."
                          (and (numberp (car articles))
                               (> min (car articles)))))
            (pop articles))
-         (set var articles))))))))
+         (set var articles))
+        ((eq mark 'unexist)
+         (set var (cdr marks)))))))))
 
 (defun gnus-update-missing-marks (missing)
   "Go through the list of MISSING articles and remove them from the mark lists."
@@ -6285,10 +6287,9 @@ The resulting hash table is returned, or nil if no Xrefs were found."
         (info (nth 2 entry))
         (active (gnus-active group))
         (set-marks
-         (or gnus-propagate-marks
-             (gnus-method-option-p
-              (gnus-find-method-for-group group)
-              'server-marks)))
+         (gnus-method-option-p
+          (gnus-find-method-for-group group)
+          'server-marks))
         range)
     (if (not entry)
        ;; Group that Gnus doesn't know exists, but still allow the
@@ -9266,6 +9267,17 @@ With optional ARG, move across that many fields."
   (select-window (gnus-get-buffer-window gnus-article-buffer))
   (widget-forward arg))
 
+(defun gnus-summary-widget-backward (arg)
+  "Move point to the previous field or button in the article.
+With optional ARG, move across that many fields."
+  (interactive "p")
+  (gnus-summary-select-article)
+  (gnus-configure-windows 'article)
+  (select-window (gnus-get-buffer-window gnus-article-buffer))
+  (unless (widget-at (point))
+    (goto-char (point-max)))
+  (widget-backward arg))
+
 (defun gnus-summary-isearch-article (&optional regexp-p)
   "Do incremental search forward on the current article.
 If REGEXP-P (the prefix) is non-nil, do regexp isearch."
@@ -10076,10 +10088,9 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
                   to-group 'expire (list to-article) info))
 
                (when (and to-marks
-                          (or gnus-propagate-marks
-                              (gnus-method-option-p
-                               (gnus-find-method-for-group to-group)
-                               'server-marks)))
+                          (gnus-method-option-p
+                           (gnus-find-method-for-group to-group)
+                           'server-marks))
                  (gnus-request-set-mark
                   to-group (list (list (list to-article) 'add to-marks)))))
 
@@ -12561,10 +12572,9 @@ UNREAD is a sorted list."
        (save-excursion
          (let (setmarkundo)
            ;; Propagate the read marks to the backend.
-           (when (and (or gnus-propagate-marks
-                          (gnus-method-option-p
-                           (gnus-find-method-for-group group)
-                           'server-marks))
+           (when (and (gnus-method-option-p
+                       (gnus-find-method-for-group group)
+                       'server-marks)
                       (gnus-check-backend-function 'request-set-mark group))
              (let ((del (gnus-remove-from-range (gnus-info-read info) read))
                    (add (gnus-remove-from-range read (gnus-info-read info))))
index 57c834a..6a45c67 100644 (file)
@@ -172,14 +172,11 @@ and `gnus-topic-alist'.  Also see `gnus-variable-list'."
 (defun gnus-sync-lesync-call (url method headers &optional kvdata)
   "Make an access request to URL using KVDATA and METHOD.
 KVDATA must be an alist."
-  ;;(debug (json-encode kvdata))
-  ;; (when (string-match-p "gmane.emacs.devel" url) (debug kvdata))
   (flet ((json-alist-p (list) (gnus-sync-json-alist-p list))) ; temp patch
     (let ((url-request-method method)
           (url-request-extra-headers headers)
           (url-request-data (if kvdata (json-encode kvdata) nil)))
       (with-current-buffer (url-retrieve-synchronously url)
-        ;;(debug (buffer-string))
         (let ((data (gnus-sync-lesync-parse)))
           (gnus-message 12 "gnus-sync-lesync-call: %s URL %s sent %S got %S"
                         method url `((headers . ,headers) (data ,kvdata)) data)
index da899f4..fef67cd 100644 (file)
@@ -1927,6 +1927,19 @@ Sizes are in pixels."
                    image)))
       image)))
 
+(defun gnus-recursive-directory-files (dir)
+  "Return all regular files below DIR."
+  (let (files)
+    (dolist (file (directory-files dir t))
+      (when (and (not (member (file-name-nondirectory file) '("." "..")))
+                (file-readable-p file))
+       (cond
+        ((file-regular-p file)
+         (push file files))
+        ((file-directory-p file)
+         (setq files (append (gnus-recursive-directory-files file) files))))))
+    files))
+
 (defun gnus-list-memq-of-list (elements list)
   "Return non-nil if any of the members of ELEMENTS are in LIST."
   (let ((found nil))
index f2b2982..8548474 100644 (file)
@@ -36,6 +36,7 @@
 (require 'wid-edit)
 (require 'mm-util)
 (require 'nnheader)
+(require 'gnus-compat)
 
 ;; These are defined afterwards with gnus-define-group-parameter
 (defvar gnus-ham-process-destinations)
@@ -293,10 +294,10 @@ is restarted, and sometimes reloaded."
   :link '(custom-manual "(gnus)Exiting Gnus")
   :group 'gnus)
 
-(defconst gnus-version-number "0.20"
+(defconst gnus-version-number "0.4"
   "Version number for this version of Gnus.")
 
-(defconst gnus-version (format "No Gnus v%s" gnus-version-number)
+(defconst gnus-version (format "Ma Gnus v%s" gnus-version-number)
   "Version string for this version of Gnus.")
 
 (defcustom gnus-inhibit-startup-message nil
@@ -1008,10 +1009,11 @@ be set in `.emacs' instead."
     (purp "#9999cc" "#666699")
     (no "#ff0000" "#ffff00")
     (neutral "#b4b4b4" "#878787")
+    (ma "#2020e0" "#8080ff")
     (september "#bf9900" "#ffcc00"))
   "Color alist used for the Gnus logo.")
 
-(defcustom gnus-logo-color-style 'no
+(defcustom gnus-logo-color-style 'ma
   "*Color styles used for the Gnus logo."
   :type `(choice ,@(mapcar (lambda (elem) (list 'const (car elem)))
                           gnus-logo-color-alist))
@@ -2618,10 +2620,11 @@ a string, be sure to use a valid format, see RFC 2616."
     (scored . score) (saved . save)
     (cached . cache) (downloadable . download)
     (unsendable . unsend) (forwarded . forward)
-    (seen . seen)))
+    (seen . seen) (unexist . unexist)))
 
 (defconst gnus-article-special-mark-lists
   '((seen range)
+    (unexist range)
     (killed range)
     (bookmark tuple)
     (uid tuple)
@@ -2636,7 +2639,7 @@ a string, be sure to use a valid format, see RFC 2616."
 ;; `score' is not a proper mark
 ;; `bookmark': don't propagated it, or fix the bug in update-mark.
 (defconst gnus-article-unpropagated-mark-lists
-  '(seen cache download unsend score bookmark)
+  '(seen cache download unsend score bookmark unexist)
   "Marks that shouldn't be propagated to back ends.
 Typical marks are those that make no sense in a standalone back end,
 such as a mark that says whether an article is stored in the cache
diff --git a/lisp/imap.el b/lisp/imap.el
deleted file mode 100644 (file)
index 6a25be7..0000000
+++ /dev/null
@@ -1,3056 +0,0 @@
-;;; imap.el --- imap library
-
-;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
-
-;; Author: Simon Josefsson <simon@josefsson.org>
-;; 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 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; imap.el is an 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 supports RFC1730/2060/RFC3501 (IMAP4/IMAP4rev1).  The 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'), and 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 a 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 it 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.
-;;   Use IEEE floats (which are effectively exact)?  -- fx
-;; 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 committed to pgnus
-;;
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-(eval-and-compile
-  ;; For Emacs <22.2 and XEmacs.
-  (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))
-  (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, shell, and SSL.
-The `process-connection-type' variable controls the 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 an 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, an 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 buffer.
-It is not written to disk, however.  Do not enable this
-variable unless you are comfortable with that.
-
-See also `imap-debug'."
-  :group 'imap
-  :type 'boolean)
-
-(defcustom imap-debug nil
-  "If non-nil, trace imap- functions into `imap-debug-buffer'.
-Uses `trace-function-background', so you can turn it off with,
-say, `untrace-all'.
-
-Note that username, passwords and other privacy sensitive
-information (such as e-mail) may be stored in the buffer.
-It is not written to disk, however.  Do not enable this
-variable unless you are comfortable with that.
-
-This variable only takes effect when loading the `imap' library.
-See also `imap-log'."
-  :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\\|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 prompting."
-  :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-last-authenticator 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.")
-
-(defvar imap-enable-exchange-bug-workaround nil
-  "Send FETCH UID commands as *:* instead of *.
-
-When non-nil, use an alternative UIDS form.  Enabling appears to
-be required for some servers (e.g., Microsoft Exchange 2007)
-which otherwise would trigger a response 'BAD The specified
-message set is invalid.'.  We don't unconditionally use this
-form, since this is said to be significantly inefficient.
-
-This variable is set to t automatically per server if the
-canonical form fails.")
-
-\f
-;; Utility functions:
-
-(defun imap-remassoc (key alist)
-  "Delete by side effect any elements of ALIST whose car is `equal' to KEY.
-The modified ALIST is returned.  If the first member
-of ALIST 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)))
-
-(defmacro imap-disable-multibyte ()
-  "Enable multibyte in the current buffer."
-  (unless (featurep 'xemacs)
-    '(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))))
-
-\f
-;; Server functions; stream stuff:
-
-(defun imap-log (string-or-buffer)
-  (when imap-log
-    (with-current-buffer (get-buffer-create imap-log-buffer)
-      (imap-disable-multibyte)
-      (buffer-disable-undo)
-      (goto-char (point-max))
-      (if (bufferp string-or-buffer)
-         (insert-buffer-substring string-or-buffer)
-       (insert string-or-buffer)))))
-
-(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))
-           (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))
-           (imap-log 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 an 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))
-           (imap-log 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))
-                 ;; FIXME: Per the "blue moon" comment, the process/buffer
-                 ;; handling here, and elsewhere in functions which open
-                 ;; streams, looks confused.  Obviously we can change buffers
-                 ;; if a different process handler kicks in from
-                 ;; `accept-process-output' or `sit-for' below, and TRT seems
-                 ;; to be to `save-buffer' around those calls.  (I wonder why
-                 ;; `sit-for' is used with a non-zero wait.)  -- fx
-                 (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-log 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))
-      (imap-log 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-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
-                        ?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))
-         (imap-log 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))
-      (imap-log 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
-               (message "imap: Login successful...")
-               (setq ret t
-                     imap-username user)
-               (when (and (not imap-password)
-                          (or imap-store-password
-                              (y-or-n-p "imap: Store password for this IMAP session? ")))
-                 (setq imap-password passwd)))
-           (message "imap: 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))
-
-(declare-function sasl-find-mechanism "sasl" (mechanism))
-(declare-function sasl-mechanism-name "sasl" (mechanism))
-(declare-function sasl-make-client    "sasl" (mechanism name service server))
-(declare-function sasl-next-step      "sasl" (client step))
-(declare-function sasl-step-data      "sasl" (step))
-(declare-function sasl-step-set-data  "sasl" (step data))
-
-(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 an 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)
-                       ;; set the passed buffer to the current one,
-                       ;; so that (imap-opened buffer) later will work
-                       (setq buffer (current-buffer)))
-                     (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)))
-      ;; (debug "opened+state+auth+buffer" (imap-opened buffer) imap-state imap-auth buffer)
-      (when imap-stream
-       buffer))))
-
-(defcustom imap-ping-server t
-  "If non-nil, check if IMAP is open.
-See the function `imap-ping-server'."
-  :version "23.1" ;; No Gnus
-  :group 'imap
-  :type 'boolean)
-
-(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))
-             (if imap-ping-server
-                 (imap-ping-server)
-               t)))))
-
-(defun imap-ping-server (&optional buffer)
-  "Ping the IMAP server in BUFFER with a \"NOOP\" command.
-Return non-nil if the server responds, and nil if it does not
-respond.  If BUFFER is nil, the current buffer is used."
-  (condition-case ()
-      (imap-ok-p (imap-send-command-wait "NOOP" buffer))
-    (error nil)))
-
-(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)
-      (make-local-variable 'imap-last-authenticator)
-      (when user (setq imap-username user))
-      (when passwd (setq imap-password passwd))
-      (if imap-auth
-         (and (setq imap-last-authenticator
-                    (assq imap-auth imap-authenticator-alist))
-              (funcall (nth 2 imap-last-authenticator) (current-buffer))
-              (setq imap-state 'auth))
-       ;; Choose authenticator.
-       (let ((auths imap-authenticators)
-             auth)
-         (while (setq auth (pop auths))
-           ;; OK to use authenticator?
-           (setq imap-last-authenticator
-                 (assq auth imap-authenticator-alist))
-           (when (funcall (nth 1 imap-last-authenticator) (current-buffer))
-             (message "imap: Authenticating to `%s' using `%s'..."
-                      imap-server auth)
-             (setq imap-auth auth)
-             (if (funcall (nth 2 imap-last-authenticator) (current-buffer))
-                 (progn
-                   (message "imap: Authenticating to `%s' using `%s'...done"
-                            imap-server auth)
-                   ;; set imap-state correctly on successful auth attempt
-                   (setq imap-state 'auth)
-                   ;; stop iterating through the authenticator list
-                   (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)))
-
-\f
-;; 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 successful 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 successful 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 -- i.e. `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 -- i.e. '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)
-                            "\" "
-                            (upcase
-                             (format "%s"
-                                     (if (listp items)
-                                         items
-                                       (list items))))))))
-
-(defun imap-mailbox-acl-get (&optional mailbox buffer)
-  "Get ACL on MAILBOX from server in BUFFER."
-  (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)
-  "Remove 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))))))
-
-\f
-;; 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 message 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)))
-
-;; FIXME: Should this try to use CHARSET?  -- fx
-(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 ")"))))))
-
-;; Cf. http://thread.gmane.org/gmane.emacs.gnus.general/65317/focus=65343
-;; Signal an error if we'd get an integer overflow.
-;;
-;; FIXME: Identify relevant calls to `string-to-number' and replace them with
-;; `imap-string-to-integer'.
-(defun imap-string-to-integer (string &optional base)
-  (let ((number (string-to-number string base)))
-    (if (> number most-positive-fixnum)
-       (error
-        (format "String %s cannot be converted to a Lisp integer" number))
-      number)))
-
-(defun imap-fetch-safe (uids props &optional receive nouidfetch buffer)
-  "Like `imap-fetch', but DTRT with Exchange 2007 bug.
-However, UIDS here is a cons, where the car is the canonical form
-of the UIDS specification, and the cdr is the one which works with
-Exchange 2007 or, potentially, other buggy servers.
-See `imap-enable-exchange-bug-workaround'."
-  ;; The first time we get here for a given, we'll try the canonical
-  ;; form.  If we get the known error from the buggy server, set the
-  ;; flag buffer-locally (to account for connections to multiple
-  ;; servers), then re-try with the alternative UIDS spec.  We don't
-  ;; unconditionally use the alternative form, since the
-  ;; currently-used alternatives are seriously inefficient with some
-  ;; servers (although they are valid).
-  ;;
-  ;; FIXME:  Maybe it would be cleaner to have a flag to not signal
-  ;; the error (which otherwise gives a message), and test
-  ;; `imap-failed-tags'.  Also, Other IMAP clients use other forms of
-  ;; request which work with Exchange, e.g. Claws does "UID FETCH 1:*
-  ;; (UID)" rather than "FETCH UID 1,*".  Is there a good reason not
-  ;; to do the same?
-  (condition-case data
-      ;; Binding `debug-on-error' allows us to get the error from
-      ;; `imap-parse-response' -- it's normally caught by Emacs around
-      ;; execution of a process filter.
-      (let ((debug-on-error t))
-       (imap-fetch (if imap-enable-exchange-bug-workaround
-                       (cdr uids)
-                     (car uids))
-                   props receive nouidfetch buffer))
-    (error
-     (if (and (not imap-enable-exchange-bug-workaround)
-             ;; This is the Exchange 2007 response.  It may be more
-             ;; robust just to check for a BAD response to the
-             ;; attempted fetch.
-             (string-match "The specified message set is invalid"
-                           (cadr data)))
-        (with-current-buffer (or buffer (current-buffer))
-          (set (make-local-variable 'imap-enable-exchange-bug-workaround)
-               t)
-          (imap-fetch (cdr uids) props receive nouidfetch))
-       (signal (car data) (cdr data))))))
-
-(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-safe '("*" . "*:*") "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 to MAILBOX on server in BUFFER.
-ARTICLES is a string message set.  Create mailbox if it doesn't exist,
-unless DONT-CREATE is non-nil.  On success, return a list with
-the UIDVALIDITY of the mailbox the article(s) was copied to as the
-first element.  The rest of list contains 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)))))))
-
-;; FIXME: Amalgamate with imap-message-copyuid-1, using an extra arg, since it
-;; shares most of the code?  -- fx
-(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-safe '("*" . "*:*") "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) ">"))))
-
-\f
-;; 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))
-  (imap-log 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
-                          (imap-log 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
-                  (setq command
-                        (if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE))
-                            nil ;; abort command if no cont-req
-                          (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 (/ (buffer-size) 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)
-      (imap-log string)
-      (let (end)
-       (goto-char (point-min))
-       (while (setq end (imap-find-next-line))
-         (save-restriction
-           (narrow-to-region (point-min) end)
-           (delete-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)))))))))
-
-\f
-;; 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 an 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)
-      ;; Courier can insert spurious blank characters which will
-      ;; confuse `read', so skip past them.
-      (while (let ((moved (skip-chars-forward " \t")))
-              (prog1 (not (eq (char-after) ?\)))
-                (unless (= moved 0) (backward-char))))
-       (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 (upcase (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 1")
-    (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 2")
-    (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 inserts 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 regards body-fld-enc as a
-       ;; nstring and returns nil instead of defaulting back to 7BIT
-       ;; as the standard says.
-       ;; Exchange (2007, at least) does this as well.
-       (push (or (imap-parse-nstring) "7BIT") body) ;; body-fld-enc
-       (imap-forward)
-       ;; Exchange 2007 can return -1, contrary to the spec...
-       (if (eq (char-after) ?-)
-           (progn
-             (skip-chars-forward "-0-9")
-             (push nil body))
-         (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-ping-server
-         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-fetch-safe
-         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)
-
-;;; imap.el ends here
index 857a536..91613a2 100644 (file)
@@ -26,7 +26,7 @@
     (defun netrc-machine-user-or-password (mode authinfo-file-or-list machines
                                                ports defaults))
     (defun netrc-parse (file))
-    (defun shr-put-image (data alt))
+    (defun shr-put-image (data alt &optional flags))
     (maybe-fbind
      '(Info-index
        Info-index-next Info-menu bbdb-complete-name bookmark-default-handler
@@ -52,7 +52,7 @@
                                              ports defaults))
   (defun netrc-parse (file))
   (defun split-line (&optional arg))
-  (defun shr-put-image (data alt))
+  (defun shr-put-image (data alt &optional flags))
   (eval-after-load "rmail"
     '(defun rmail-toggle-header (&optional arg)))
   (maybe-fbind
index 416a4c8..f32981f 100644 (file)
@@ -3101,66 +3101,79 @@ M-RET    `message-newline-and-reformat' (break the line and reformat)."
 (defun message-goto-to ()
   "Move point to the To header."
   (interactive)
+  (push-mark)
   (message-position-on-field "To"))
 
 (defun message-goto-from ()
   "Move point to the From header."
   (interactive)
+  (push-mark)
   (message-position-on-field "From"))
 
 (defun message-goto-subject ()
   "Move point to the Subject header."
   (interactive)
+  (push-mark)
   (message-position-on-field "Subject"))
 
 (defun message-goto-cc ()
   "Move point to the Cc header."
   (interactive)
+  (push-mark)
   (message-position-on-field "Cc" "To"))
 
 (defun message-goto-bcc ()
   "Move point to the Bcc  header."
   (interactive)
+  (push-mark)
   (message-position-on-field "Bcc" "Cc" "To"))
 
 (defun message-goto-fcc ()
   "Move point to the Fcc header."
   (interactive)
+  (push-mark)
   (message-position-on-field "Fcc" "To" "Newsgroups"))
 
 (defun message-goto-reply-to ()
   "Move point to the Reply-To header."
   (interactive)
+  (push-mark)
   (message-position-on-field "Reply-To" "Subject"))
 
 (defun message-goto-newsgroups ()
   "Move point to the Newsgroups header."
   (interactive)
+  (push-mark)
   (message-position-on-field "Newsgroups"))
 
 (defun message-goto-distribution ()
   "Move point to the Distribution header."
   (interactive)
+  (push-mark)
   (message-position-on-field "Distribution"))
 
 (defun message-goto-followup-to ()
   "Move point to the Followup-To header."
   (interactive)
+  (push-mark)
   (message-position-on-field "Followup-To" "Newsgroups"))
 
 (defun message-goto-mail-followup-to ()
   "Move point to the Mail-Followup-To header."
   (interactive)
+  (push-mark)
   (message-position-on-field "Mail-Followup-To" "To"))
 
 (defun message-goto-keywords ()
   "Move point to the Keywords header."
   (interactive)
+  (push-mark)
   (message-position-on-field "Keywords" "Subject"))
 
 (defun message-goto-summary ()
   "Move point to the Summary header."
   (interactive)
+  (push-mark)
   (message-position-on-field "Summary" "Subject"))
 
 (eval-when-compile
@@ -3181,6 +3194,7 @@ M-RET    `message-newline-and-reformat' (break the line and reformat)."
   (when (and (message-called-interactively-p 'any)
             (looking-at "[ \t]*\n"))
     (expand-abbrev))
+  (push-mark)
   (goto-char (point-min))
   (or (search-forward (concat "\n" mail-header-separator "\n") nil t)
       (search-forward-regexp "[^:]+:\\([^\n]\\|\n[ \t]\\)+\n\n" nil t)))
@@ -3201,6 +3215,7 @@ M-RET    `message-newline-and-reformat' (break the line and reformat)."
 If there is no signature in the article, go to the end and
 return nil."
   (interactive)
+  (push-mark)
   (goto-char (point-min))
   (if (re-search-forward message-signature-separator nil t)
       (forward-line 1)
@@ -4523,8 +4538,9 @@ This function could be useful in `message-setup-hook'."
              (end-of-line)
              (insert (format " (%d/%d)" n total))
              (widen)
-              (funcall (or message-send-mail-real-function
-                           message-send-mail-function)))
+             (if message-send-mail-real-function
+                 (funcall message-send-mail-real-function)
+               (message-multi-smtp-send-mail)))
            (setq n (+ n 1))
            (setq p (pop plist))
            (erase-buffer)))
@@ -4678,8 +4694,9 @@ If you always want Gnus to send messages in one piece, set
 ")))
              (progn
                (message "Sending via mail...")
-               (funcall (or message-send-mail-real-function
-                            message-send-mail-function)))
+               (if message-send-mail-real-function
+                   (funcall message-send-mail-real-function)
+                 (message-multi-smtp-send-mail)))
            (message-send-mail-partially))
          (setq options message-options))
       (kill-buffer tembuf))
@@ -4688,6 +4705,28 @@ If you always want Gnus to send messages in one piece, set
     (push 'mail message-sent-message-via)))
 
 (defvar sendmail-program)
+(defvar smtpmail-smtp-user)
+
+(defun message-multi-smtp-send-mail ()
+  "Send the current buffer to `message-send-mail-function'.
+Or, if there's a header that specifies a different method, use
+that instead."
+  (let ((method (message-field-value "X-Message-SMTP-Method")))
+    (if (not method)
+       (funcall message-send-mail-function)
+      (message-remove-header "X-Message-SMTP-Method")
+      (setq method (split-string method))
+      (cond
+       ((equal (car method) "sendmail")
+       (message-send-mail-with-sendmail))
+       ((equal (car method) "smtp")
+       (require 'smtpmail)
+       (let ((smtpmail-smtp-server (nth 1 method))
+             (smtpmail-smtp-service (nth 2 method))
+             (smtpmail-smtp-user (or (nth 3 method) smtpmail-smtp-user)))
+         (message-smtpmail-send-it)))
+       (t
+       (error "Unknown method %s" method))))))
 
 (defun message-send-mail-with-sendmail ()
   "Send off the prepared buffer with sendmail."
@@ -7574,7 +7613,7 @@ is for the internal use."
   (message "Resending message to %s..." address)
   (save-excursion
     (let ((cur (current-buffer))
-         beg)
+         gcc beg)
       ;; We first set up a normal mail buffer.
       (unless (message-mail-user-agent)
        (set-buffer (get-buffer-create " *message resend*"))
@@ -7587,6 +7626,8 @@ is for the internal use."
       ;; Insert our usual headers.
       (message-generate-headers '(From Date To Message-ID))
       (message-narrow-to-headers)
+      (when (setq gcc (mail-fetch-field "gcc" nil t))
+       (message-remove-header "gcc"))
       ;; Remove X-Draft-From header etc.
       (message-remove-header message-ignored-mail-headers t)
       ;; Rename them all to "Resent-*".
@@ -7628,6 +7669,10 @@ is for the internal use."
            message-generate-hashcash
            rfc2047-encode-encoded-words)
        (message-send-mail))
+      (when gcc
+       (message-goto-eoh)
+       (insert "Gcc: " gcc "\n"))
+      (run-hooks 'message-sent-hook)
       (kill-buffer (current-buffer)))
     (message "Resending message to %s...done" address)))
 
diff --git a/lisp/mm-archive.el b/lisp/mm-archive.el
new file mode 100644 (file)
index 0000000..5ca6616
--- /dev/null
@@ -0,0 +1,100 @@
+;;; mm-archive.el --- Functions for parsing archive files as MIME
+
+;; Copyright (C) 2012  Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(defvar mm-archive-decoders
+  '(("application/ms-tnef" t "tnef" "-f" "-" "-C")
+    ("application/zip" nil "unzip" "-j" "-x" "%f" "-d")
+    ("application/x-gtar-compressed" nil "tar" "xzf" "-" "-C")
+    ("application/x-tar" nil "tar" "xf" "-" "-C")))
+
+(defun mm-dissect-archive (handle)
+  (let ((decoder (cddr (assoc (car (mm-handle-type handle))
+                             mm-archive-decoders)))
+       (dir (mm-make-temp-file
+             (expand-file-name "emm." mm-tmp-directory) 'dir)))
+    (set-file-modes dir #o700)
+    (unwind-protect
+       (progn
+         (mm-with-unibyte-buffer
+           (mm-insert-part handle)
+           (if (member "%f" decoder)
+               (let ((file (expand-file-name "mail.zip" dir)))
+                 (write-region (point-min) (point-max) file nil 'silent)
+                 (setq decoder (copy-sequence decoder))
+                 (setcar (member "%f" decoder) file)
+                 (apply 'call-process (car decoder) nil nil nil
+                        (append (cdr decoder) (list dir)))
+                 (delete-file file))
+             (apply 'call-process-region (point-min) (point-max) (car decoder)
+                    nil (get-buffer-create "*tnef*")
+                    nil (append (cdr decoder) (list dir)))))
+         `("multipart/mixed"
+           ,handle
+           ,@(mm-archive-list-files (gnus-recursive-directory-files dir))))
+      (delete-directory dir t))))
+
+(defun mm-archive-list-files (files)
+  (let ((handles nil)
+       type disposition)
+    (dolist (file files)
+      (with-temp-buffer
+       (when (string-match "\\.\\([^.]+\\)$" file)
+         (setq type (mailcap-extension-to-mime (match-string 1 file))))
+       (unless type
+         (setq type "application/octet-stream"))
+       (setq disposition
+             (if (string-match "^image/\\|^text/" type)
+                 "inline"
+               "attachment"))
+       (insert (format "Content-type: %s\n" type))
+       (insert "Content-Transfer-Encoding: 8bit\n\n")
+       (insert-file-contents file)
+       (push
+        (mm-make-handle (mm-copy-to-buffer)
+                        (list type)
+                        '8bit nil
+                        `(,disposition (filename . ,file))
+                        nil nil nil)
+        handles)))
+    handles))
+
+(defun mm-archive-dissect-and-inline (handle)
+  (let ((start (point-marker)))
+    (save-restriction
+      (narrow-to-region (point) (point))
+      (dolist (handle (cddr (mm-dissect-archive handle)))
+       (goto-char (point-max))
+       (mm-display-inline handle))
+      (goto-char (point-max))
+      (mm-handle-set-undisplayer
+       handle
+       `(lambda ()
+         (let ((inhibit-read-only t)
+               (end ,(point-marker)))
+           (remove-images ,start end)
+           (delete-region ,start end)))))))
+
+(provide 'mm-archive)
+
+;; mm-archive.el ends here
index dd3eb6c..5f5d06d 100644 (file)
@@ -29,6 +29,7 @@
 
 (require 'mail-parse)
 (require 'mm-bodies)
+(require 'mm-archive)
 (eval-when-compile (require 'cl)
                   (require 'term))
 
@@ -248,6 +249,8 @@ before the external MIME handler is invoked."
     ("message/partial" mm-inline-partial identity)
     ("message/external-body" mm-inline-external-body identity)
     ("text/.*" mm-inline-text identity)
+    ("application/x-.?tar\\(-.*\\)?" mm-archive-dissect-and-inline identity)
+    ("application/zip" mm-archive-dissect-and-inline identity)
     ("audio/wav" mm-inline-audio
      (lambda (handle)
        (and (or (featurep 'nas-sound) (featurep 'native-sound))
@@ -297,6 +300,9 @@ before the external MIME handler is invoked."
     "application/pgp-signature" "application/x-pkcs7-signature"
     "application/pkcs7-signature" "application/x-pkcs7-mime"
     "application/pkcs7-mime"
+    "application/x-gtar-compressed"
+    "application/x-tar"
+    "application/zip"
     ;; Mutt still uses this even though it has already been withdrawn.
     "application/pgp")
   "List of media types that are to be displayed inline.
@@ -653,8 +659,25 @@ Postpone undisplaying of viewers for types in
            (if (equal "text/plain" (car ctl))
                (assoc 'format ctl)
              t))
-    (mm-make-handle
-     (mm-copy-to-buffer) ctl cte nil cdl description nil id)))
+    ;; Guess what the type of application/octet-stream parts should
+    ;; really be.
+    (let ((filename (cdr (assq 'filename (cdr cdl)))))
+      (when (and (equal (car ctl) "application/octet-stream")
+                filename
+                (string-match "\\.\\([^.]+\\)$" filename))
+       (let ((new-type (mailcap-extension-to-mime (match-string 1 filename))))
+         (when new-type
+           (setcar ctl new-type)))))
+    (let ((handle
+          (mm-make-handle
+           (mm-copy-to-buffer) ctl cte nil cdl description nil id))
+         (decoder (assoc (car ctl) mm-archive-decoders)))
+      (if (and decoder
+              ;; Do automatic decoding
+              (cadr decoder)
+              (executable-find (caddr decoder)))
+         (mm-dissect-archive handle)
+       handle))))
 
 (defun mm-dissect-multipart (ctl from)
   (goto-char (point-min))
@@ -918,46 +941,38 @@ external if displayed external."
                                   shell-command-switch command)
                    (set-process-sentinel
                     (get-buffer-process buffer)
-                    (lexical-let ;; Don't use `let'.
-                        ;; Function used to remove temp file and directory.
-                        ((fn `(lambda nil
-                                ;; Don't use `ignore-errors'.
-                                (condition-case nil
-                                    (delete-file ,file)
-                                  (error))
-                                (condition-case nil
-                                    (delete-directory
-                                     ,(file-name-directory file))
-                                  (error))))
-                         ;; Form uses to kill the process buffer and
-                         ;; remove the undisplayer.
-                         (fm `(progn
-                                (kill-buffer ,buffer)
-                                ,(macroexpand
-                                  (list 'mm-handle-set-undisplayer
-                                        (list 'quote handle)
-                                        nil))))
-                         ;; Message to be issued when the process exits.
-                         (done (format "Displaying %s...done" command))
-                         ;; In particular, the timer object (which is
-                         ;; a vector in Emacs but is a list in XEmacs)
-                         ;; requires that it is lexically scoped.
-                         (timer (run-at-time 30.0 nil 'ignore)))
-                      (if (featurep 'xemacs)
-                          (lambda (process state)
-                            (when (eq 'exit (process-status process))
-                              (if (memq timer itimer-list)
-                                  (set-itimer-function timer fn)
-                                (funcall fn))
-                              (ignore-errors (eval fm))
-                              (message "%s" done)))
-                        (lambda (process state)
-                          (when (eq 'exit (process-status process))
-                            (if (memq timer timer-list)
-                                (timer-set-function timer fn)
-                              (funcall fn))
-                            (ignore-errors (eval fm))
-                            (message "%s" done)))))))
+                    (lexical-let ((outbuf outbuf)
+                                  (file file)
+                                  (buffer buffer)
+                                  (command command)
+                                  (handle handle))
+                      (run-at-time
+                       30.0 nil
+                       (lambda ()
+                         (ignore-errors
+                           (delete-file file))
+                         (ignore-errors
+                           (delete-directory (file-name-directory file)))))
+                      (lambda (process state)
+                        (when (eq (process-status process) 'exit)
+                          (condition-case nil
+                              (delete-file file)
+                            (error))
+                          (condition-case nil
+                              (delete-directory (file-name-directory file))
+                            (error))
+                          (when (buffer-live-p outbuf)
+                            (with-current-buffer outbuf
+                              (let ((buffer-read-only nil)
+                                    (point (point)))
+                                (forward-line 2)
+                                (mm-insert-inline
+                                 handle (with-current-buffer buffer
+                                          (buffer-string)))
+                                (goto-char point))))
+                          (when (buffer-live-p buffer)
+                            (kill-buffer buffer)))
+                        (message "Displaying %s...done" command)))))
                (mm-handle-set-external-undisplayer
                 handle (cons file buffer)))
              (message "Displaying %s..." command))
@@ -1758,6 +1773,8 @@ If RECURSIVE, search recursively."
                                  mm-extra-numeric-entities)))
             (replace-match (char-to-string char))))
         (libxml-parse-html-region (point-min) (point-max))))
+      (unless (bobp)
+       (insert "\n"))
       (mm-handle-set-undisplayer
        handle
        `(lambda ()
index e911928..4fb5ea7 100644 (file)
@@ -1592,7 +1592,7 @@ gzip, bzip2, etc. are allowed."
   (unless filename
     (setq filename buffer-file-name))
   (save-excursion
-    (let ((decomp (unless ;; No worth to examine charset of tar files.
+    (let ((decomp (unless ;; Not worth it to examine charset of tar files.
                      (and filename
                           (string-match
                            "\\.\\(?:tar\\.[^.]+\\|tbz\\|tgz\\)\\'"
index 89961dc..0245ff8 100644 (file)
@@ -2,7 +2,7 @@
 
 ;; Copyright (C) 1995-2012 Free Software Foundation, Inc.
 
-;; Author: Simon Josefsson <simon@josefsson.org> (adding MARKS)
+;; Author: Simon Josefsson <simon@josefsson.org>
 ;;      ShengHuo Zhu <zsh@cs.rochester.edu> (adding NOV)
 ;;      Scott Byer <byer@mv.us.adobe.com>
 ;;     Lars Magne Ingebrigtsen <larsi@gnus.org>
   "The name of the nnfolder NOV directory.
 If nil, `nnfolder-directory' is used.")
 
-(defvoo nnfolder-marks-directory nil
-  "The name of the nnfolder MARKS directory.
-If nil, `nnfolder-directory' is used.")
-
 (defvoo nnfolder-active-file
     (nnheader-concat nnfolder-directory "active")
   "The name of the active file.")
@@ -134,21 +130,6 @@ all.  This may very well take some time.")
 
 (defvar nnfolder-nov-buffer-file-name nil)
 
-(defvoo nnfolder-marks-is-evil nil
-  "If non-nil, Gnus will never generate and use marks file for mail groups.
-Using marks files makes it possible to backup and restore mail groups
-separately from `.newsrc.eld'.  If you have, for some reason, set
-this to t, and want to set it to nil again, you should always remove
-the corresponding marks file (usually base nnfolder file name
-concatenated with `.mrk', but see `nnfolder-marks-file-suffix') for
-the group.  Then the marks file will be regenerated properly by Gnus.")
-
-(defvoo nnfolder-marks nil)
-
-(defvoo nnfolder-marks-file-suffix ".mrk")
-
-(defvar nnfolder-marks-modtime (gnus-make-hashtable))
-
 \f
 
 ;;; Interface functions
@@ -231,9 +212,6 @@ the group.  Then the marks file will be regenerated properly by Gnus.")
   (unless (or gnus-nov-is-evil nnfolder-nov-is-evil)
     (and nnfolder-nov-directory
         (gnus-make-directory nnfolder-nov-directory)))
-  (unless nnfolder-marks-is-evil
-    (and nnfolder-marks-directory
-        (gnus-make-directory nnfolder-marks-directory)))
   (cond
    ((not (file-exists-p nnfolder-directory))
     (nnfolder-close-server)
@@ -607,11 +585,9 @@ the group.  Then the marks file will be regenerated properly by Gnus.")
       ()                               ; Don't delete the articles.
     ;; Delete the file that holds the group.
     (let ((data (nnfolder-group-pathname group))
-         (nov (nnfolder-group-nov-pathname group))
-         (mrk (nnfolder-group-marks-pathname group)))
+         (nov (nnfolder-group-nov-pathname group)))
       (ignore-errors (delete-file data))
-      (ignore-errors (delete-file nov))
-      (ignore-errors (delete-file mrk))))
+      (ignore-errors (delete-file nov))))
   ;; Remove the group from all structures.
   (setq nnfolder-group-alist
        (delq (assoc group nnfolder-group-alist) nnfolder-group-alist)
@@ -632,11 +608,7 @@ the group.  Then the marks file will be regenerated properly by Gnus.")
             (when (file-exists-p (nnfolder-group-nov-pathname group))
               (setq new-file (nnfolder-group-nov-pathname new-name))
               (gnus-make-directory (file-name-directory new-file))
-              (rename-file (nnfolder-group-nov-pathname group) new-file))
-            (when (file-exists-p (nnfolder-group-marks-pathname group))
-              (setq new-file (nnfolder-group-marks-pathname new-name))
-              (gnus-make-directory (file-name-directory new-file))
-              (rename-file (nnfolder-group-marks-pathname group) new-file)))
+              (rename-file (nnfolder-group-nov-pathname group) new-file)))
           t)
         ;; That went ok, so we change the internal structures.
         (let ((entry (assoc group nnfolder-group-alist)))
@@ -1182,100 +1154,6 @@ This command does not work if you use short group names."
     (mail-header-set-number headers article)
     (nnheader-insert-nov headers)))
 
-(deffoo nnfolder-request-set-mark (group actions &optional server)
-  (when (and server
-            (not (nnfolder-server-opened server)))
-    (nnfolder-open-server server))
-  (unless nnfolder-marks-is-evil
-    (nnfolder-open-marks group server)
-    (setq nnfolder-marks (nnheader-update-marks-actions nnfolder-marks actions))
-    (nnfolder-save-marks group server))
-  nil)
-
-(deffoo nnfolder-request-marks (group info &optional server)
-  ;; Change servers.
-  (when (and server
-            (not (nnfolder-server-opened server)))
-    (nnfolder-open-server server))
-  (when (and (not nnfolder-marks-is-evil) (nnfolder-marks-changed-p group))
-    (nnheader-message 8 "Updating marks for %s..." group)
-    (nnfolder-open-marks group server)
-    ;; Update info using `nnfolder-marks'.
-    (mapc (lambda (pred)
-           (unless (memq (cdr pred) gnus-article-unpropagated-mark-lists)
-             (gnus-info-set-marks
-              info
-              (gnus-update-alist-soft
-               (cdr pred)
-               (cdr (assq (cdr pred) nnfolder-marks))
-               (gnus-info-marks info))
-              t)))
-         gnus-article-mark-lists)
-    (let ((seen (cdr (assq 'read nnfolder-marks))))
-      (gnus-info-set-read info
-                         (if (and (integerp (car seen))
-                                  (null (cdr seen)))
-                             (list (cons (car seen) (car seen)))
-                           seen)))
-    (nnheader-message 8 "Updating marks for %s...done" group))
-  info)
-
-(defun nnfolder-group-marks-pathname (group)
-  "Make pathname for GROUP NOV."
-  (let ((nnfolder-directory (or nnfolder-marks-directory nnfolder-directory)))
-    (concat (nnfolder-group-pathname group) nnfolder-marks-file-suffix)))
-
-(defun nnfolder-marks-changed-p (group)
-  (let ((file (nnfolder-group-marks-pathname group)))
-    (if (null (gnus-gethash file nnfolder-marks-modtime))
-       t ;; never looked at marks file, assume it has changed
-      (not (equal (gnus-gethash file nnfolder-marks-modtime)
-                 (nth 5 (file-attributes file)))))))
-
-(defun nnfolder-save-marks (group server)
-  (let ((file-name-coding-system nnmail-pathname-coding-system)
-       (file (nnfolder-group-marks-pathname group)))
-    (condition-case err
-       (progn
-         (with-temp-file file
-           (erase-buffer)
-           (gnus-prin1 nnfolder-marks)
-           (insert "\n"))
-         (gnus-sethash file
-                       (nth 5 (file-attributes file))
-                       nnfolder-marks-modtime))
-      (error (or (gnus-yes-or-no-p
-                 (format "Could not write to %s (%s).  Continue? " file err))
-                (error "Cannot write to %s (%s)" file err))))))
-
-(defun nnfolder-open-marks (group server)
-  (let ((file (nnfolder-group-marks-pathname group)))
-    (if (file-exists-p file)
-       (condition-case err
-           (with-temp-buffer
-             (gnus-sethash file (nth 5 (file-attributes file))
-                           nnfolder-marks-modtime)
-             (nnheader-insert-file-contents file)
-             (setq nnfolder-marks (read (current-buffer)))
-             (dolist (el gnus-article-unpropagated-mark-lists)
-               (setq nnfolder-marks (gnus-remassoc el nnfolder-marks))))
-         (error (or (gnus-yes-or-no-p
-                     (format "Error reading nnfolder marks file %s (%s).  Continuing will use marks from .newsrc.eld.  Continue? " file err))
-                    (error "Cannot read nnfolder marks file %s (%s)" file err))))
-      ;; User didn't have a .marks file.  Probably first time
-      ;; user of the .marks stuff.  Bootstrap it from .newsrc.eld.
-      (let ((info (gnus-get-info
-                  (gnus-group-prefixed-name
-                   group
-                   (gnus-server-to-method (format "nnfolder:%s" server))))))
-       (nnheader-message 7 "Bootstrapping marks for %s..." group)
-       (setq nnfolder-marks (gnus-info-marks info))
-       (push (cons 'read (gnus-info-read info)) nnfolder-marks)
-       (dolist (el gnus-article-unpropagated-mark-lists)
-         (setq nnfolder-marks (gnus-remassoc el nnfolder-marks)))
-       (nnfolder-save-marks group server)
-       (nnheader-message 7 "Bootstrapping marks for %s...done" group)))))
-
 (provide 'nnfolder)
 
 ;;; nnfolder.el ends here
index b02edf5..eaf0f5c 100644 (file)
@@ -1233,7 +1233,8 @@ textual parts.")
       (setf (nnimap-group nnimap-object) nil)
       (setf (nnimap-initial-resync nnimap-object) 0)
       (let ((qresyncp (nnimap-capability "QRESYNC"))
-           params groups sequences active uidvalidity modseq group)
+           params groups sequences active uidvalidity modseq group
+           unexist)
        ;; Go through the infos and gather the data needed to know
        ;; what and how to request the data.
        (dolist (info infos)
@@ -1241,13 +1242,15 @@ textual parts.")
                group (nnimap-decode-gnus-group
                       (gnus-group-real-name (gnus-info-group info)))
                active (cdr (assq 'active params))
+               unexist (assq 'unexist (gnus-info-marks info))
                uidvalidity (cdr (assq 'uidvalidity params))
                modseq (cdr (assq 'modseq params)))
          (setf (nnimap-examined nnimap-object) group)
          (if (and qresyncp
                   uidvalidity
                   active
-                  modseq)
+                  modseq
+                  unexist)
              (push
               (list (nnimap-send-command "EXAMINE %S (%s (%s %s))"
                                          (utf7-encode group t)
@@ -1266,11 +1269,10 @@ textual parts.")
                     ;; is read-only or not.
                     "SELECT"))
                  start)
-             (if (and active uidvalidity)
+             (if (and active uidvalidity unexist)
                  ;; Fetch the last 100 flags.
                  (setq start (max 1 (- (cdr active) 100)))
-               (setf (nnimap-initial-resync nnimap-object)
-                     (1+ (nnimap-initial-resync nnimap-object)))
+               (incf (nnimap-initial-resync nnimap-object))
                (setq start 1))
              (push (list (nnimap-send-command "%s %S" command
                                               (utf7-encode group t))
@@ -1447,6 +1449,20 @@ textual parts.")
                      (setq new-marks (gnus-range-nconcat old-marks new-marks)))
                    (when new-marks
                      (push (cons (car type) new-marks) marks)))))
+             ;; Keep track of non-existing articles.
+             (let* ((old-unexists (assq 'unexist marks))
+                    (unexists
+                     (if completep
+                         (gnus-range-difference
+                          (gnus-active group)
+                          (gnus-compress-sequence existing))
+                       (gnus-add-to-range
+                        (cdr old-unexists)
+                        (gnus-list-range-difference
+                         existing (gnus-active group))))))
+               (if old-unexists
+                   (setcdr old-unexists unexists)
+                 (push (cons 'unexist unexists) marks)))
              (gnus-info-set-marks info marks t))))
        ;; Tell Gnus whether there are any \Recent messages in any of
        ;; the groups.
@@ -1490,6 +1506,14 @@ textual parts.")
                      (gnus-sorted-complement existing new-marks))))
        (when ticks
          (push (cons (car type) ticks) marks)))
+      (gnus-info-set-marks info marks t))
+    ;; Add vanished to the list of unexisting articles.
+    (when vanished
+      (let* ((old-unexists (assq 'unexist marks))
+            (unexists (gnus-range-add (cdr old-unexists) vanished)))
+       (if old-unexists
+           (setcdr old-unexists unexists)
+         (push (cons 'unexist unexists) marks)))
       (gnus-info-set-marks info marks t))))
 
 (defun nnimap-imap-ranges-to-gnus-ranges (irange)
index 9c3a814..988e1cd 100644 (file)
@@ -553,11 +553,11 @@ parameter.  It should return nil, `warn' or `delete'."
                 (const warn)
                 (const delete)))
 
-(defcustom nnmail-extra-headers '(To Newsgroups)
+(defcustom nnmail-extra-headers '(To Newsgroups Cc)
   "Extra headers to parse.
 In addition to the standard headers, these extra headers will be
 included in NOV headers (and the like) when backends parse headers."
-  :version "21.1"
+  :version "24.2"
   :group 'nnmail
   :type '(repeat symbol))
 
index b865260..600a0d2 100644 (file)
@@ -4,7 +4,7 @@
 ;;   Foundation, Inc.
 
 ;; Authors: Didier Verna <didier@xemacs.org> (adding compaction)
-;;     Simon Josefsson <simon@josefsson.org> (adding MARKS)
+;;     Simon Josefsson <simon@josefsson.org>
 ;;     Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;     Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
 ;; Keywords: news, mail
@@ -67,15 +67,6 @@ the `nnml-generate-nov-databases' command.  The function will go
 through all nnml directories and generate nov databases for them
 all.  This may very well take some time.")
 
-(defvoo nnml-marks-is-evil nil
-  "If non-nil, Gnus will never generate and use marks file for mail spools.
-Using marks files makes it possible to backup and restore mail groups
-separately from `.newsrc.eld'.  If you have, for some reason, set this
-to t, and want to set it to nil again, you should always remove the
-corresponding marks file (usually named `.marks' in the nnml group
-directory, but see `nnml-marks-file-name') for the group.  Then the
-marks file will be regenerated properly by Gnus.")
-
 (defvoo nnml-prepare-save-mail-hook nil
   "Hook run narrowed to an article before saving.")
 
@@ -102,7 +93,6 @@ non-nil.")
   "nnml version.")
 
 (defvoo nnml-nov-file-name ".overview")
-(defvoo nnml-marks-file-name ".marks")
 
 (defvoo nnml-current-directory nil)
 (defvoo nnml-current-group nil)
@@ -118,10 +108,6 @@ non-nil.")
 
 (defvoo nnml-file-coding-system nnmail-file-coding-system)
 
-(defvoo nnml-marks nil)
-
-(defvar nnml-marks-modtime (gnus-make-hashtable))
-
 \f
 ;;; Interface functions.
 
@@ -513,8 +499,7 @@ non-nil.")
                        nnml-current-directory t
                        (concat
                         nnheader-numerical-short-files
-                        "\\|" (regexp-quote nnml-nov-file-name) "$"
-                        "\\|" (regexp-quote nnml-marks-file-name) "$")))
+                        "\\|" (regexp-quote nnml-nov-file-name) "$")))
                      (decoded (nnml-decoded-group-name group server)))
                  (dolist (article articles)
                    (when (file-writable-p article)
@@ -554,10 +539,6 @@ non-nil.")
       (let ((overview (concat old-dir nnml-nov-file-name)))
        (when (file-exists-p overview)
          (rename-file overview (concat new-dir nnml-nov-file-name))))
-      ;; Move .marks file.
-      (let ((marks (concat old-dir nnml-marks-file-name)))
-       (when (file-exists-p marks)
-         (rename-file marks (concat new-dir nnml-marks-file-name))))
       (when (<= (length (directory-files old-dir)) 2)
        (ignore-errors (delete-directory old-dir)))
       ;; That went ok, so we change the internal structures.
@@ -1033,99 +1014,6 @@ Use the nov database for the current group if available."
          (forward-line 1))
        alist))))
 
-(deffoo nnml-request-set-mark (group actions &optional server)
-  (nnml-possibly-change-directory group server)
-  (unless nnml-marks-is-evil
-    (nnml-open-marks group server)
-    (setq nnml-marks (nnheader-update-marks-actions nnml-marks actions))
-    (nnml-save-marks group server))
-  nil)
-
-(deffoo nnml-request-marks (group info &optional server)
-  (nnml-possibly-change-directory group server)
-  (when (and (not nnml-marks-is-evil) (nnml-marks-changed-p group server))
-    (nnheader-message 8 "Updating marks for %s..." group)
-    (nnml-open-marks group server)
-    ;; Update info using `nnml-marks'.
-    (mapc (lambda (pred)
-           (unless (memq (cdr pred) gnus-article-unpropagated-mark-lists)
-             (gnus-info-set-marks
-              info
-              (gnus-update-alist-soft
-               (cdr pred)
-               (cdr (assq (cdr pred) nnml-marks))
-               (gnus-info-marks info))
-              t)))
-         gnus-article-mark-lists)
-    (let ((seen (cdr (assq 'read nnml-marks))))
-      (gnus-info-set-read info
-                         (if (and (integerp (car seen))
-                                  (null (cdr seen)))
-                             (list (cons (car seen) (car seen)))
-                           seen)))
-    (nnheader-message 8 "Updating marks for %s...done" group))
-  info)
-
-(defun nnml-marks-changed-p (group server)
-  (let ((file (nnml-group-pathname group nnml-marks-file-name server)))
-    (if (null (gnus-gethash file nnml-marks-modtime))
-       t ;; never looked at marks file, assume it has changed
-      (not (equal (gnus-gethash file nnml-marks-modtime)
-                 (nth 5 (file-attributes file)))))))
-
-(defun nnml-save-marks (group server)
-  (let ((file-name-coding-system nnmail-pathname-coding-system)
-       (file (nnml-group-pathname group nnml-marks-file-name server)))
-    (condition-case err
-       (progn
-         (nnml-possibly-create-directory group server)
-         (with-temp-file file
-           (erase-buffer)
-           (gnus-prin1 nnml-marks)
-           (insert "\n"))
-         (gnus-sethash file
-                       (nth 5 (file-attributes file))
-                       nnml-marks-modtime))
-      (error (or (gnus-yes-or-no-p
-                 (format "Could not write to %s (%s).  Continue? " file err))
-                (error "Cannot write to %s (%s)" file err))))))
-
-(defun nnml-open-marks (group server)
-  (let* ((decoded (nnml-decoded-group-name group server))
-        (file (nnmail-group-pathname decoded nnml-directory
-                                     nnml-marks-file-name))
-        (file-name-coding-system nnmail-pathname-coding-system))
-    (if (file-exists-p file)
-       (condition-case err
-           (with-temp-buffer
-             (gnus-sethash file (nth 5 (file-attributes file))
-                           nnml-marks-modtime)
-             (nnheader-insert-file-contents file)
-             (setq nnml-marks (read (current-buffer)))
-             (dolist (el gnus-article-unpropagated-mark-lists)
-               (setq nnml-marks (gnus-remassoc el nnml-marks))))
-         (error (or (gnus-yes-or-no-p
-                     (format "Error reading nnml marks file %s (%s).  Continuing will use marks from .newsrc.eld.  Continue? " file err))
-                    (error "Cannot read nnml marks file %s (%s)" file err))))
-      ;; User didn't have a .marks file.  Probably first time
-      ;; user of the .marks stuff.  Bootstrap it from .newsrc.eld.
-      (let ((info (gnus-get-info
-                  (gnus-group-prefixed-name
-                   group
-                   (gnus-server-to-method
-                    (format "nnml:%s" (or server "")))))))
-       (setq decoded (if (member server '(nil ""))
-                         (concat "nnml:" decoded)
-                       (format "nnml+%s:%s" server decoded)))
-       (nnheader-message 7 "Bootstrapping marks for %s..." decoded)
-       (setq nnml-marks (gnus-info-marks info))
-       (push (cons 'read (gnus-info-read info)) nnml-marks)
-       (dolist (el gnus-article-unpropagated-mark-lists)
-         (setq nnml-marks (gnus-remassoc el nnml-marks)))
-       (nnml-save-marks group server)
-       (nnheader-message 7 "Bootstrapping marks for %s...done" decoded)))))
-
-
 ;;;
 ;;; Group and server compaction. -- dvl
 ;;;
@@ -1275,19 +1163,11 @@ Use the nov database for the current group if available."
          (gnus-set-active group-full-name active))
        ;; 1 bis/
        ;; #### NOTE: normally, we should save the overview (NOV) file
-       ;; #### here, just like we save the marks file. However, there is no
-       ;; #### such function as nnml-save-nov for a single group. Only for
-       ;; #### all groups. Gnus inconsistency is getting worse every day...
-       ;; 2/ Rebuild marks file:
-       (unless nnml-marks-is-evil
-         ;; #### NOTE: this constant use of global variables everywhere is
-         ;; #### truly disgusting. Gnus really needs a *major* cleanup.
-         (setq nnml-marks (gnus-info-marks info))
-         (push (cons 'read (gnus-info-read info)) nnml-marks)
-         (dolist (el gnus-article-unpropagated-mark-lists)
-           (setq nnml-marks (gnus-remassoc el nnml-marks)))
-         (nnml-save-marks group server))
-       ;; 3/ Save everything if this was not part of a bigger operation:
+       ;; #### here. However, there is no such function as
+       ;; #### nnml-save-nov for a single group. Only for all
+       ;; #### groups. Gnus inconsistency is getting worse every
+       ;; #### day...  ;; 3/ Save everything if this was not part of
+       ;; #### a bigger operation:
        (if (not save)
            ;; Nothing to save (yet):
            t
@@ -1298,9 +1178,6 @@ Use the nov database for the current group if available."
          (nnml-save-nov)
          ;; b/ Save the active file:
          (nnmail-save-active nnml-group-alist nnml-active-file)
-         (let ((marks (nnml-group-pathname group nnml-marks-file-name server)))
-           (when (file-exists-p marks)
-             (delete-file marks)))
          t)))))
 
 (defun nnml-request-compact (&optional server)
index 98393a6..a9839a0 100644 (file)
@@ -222,27 +222,6 @@ then use this hook to rsh to the remote machine and start a proxy NNTP
 server there that you can connect to.  See also
 `nntp-open-connection-function'")
 
-(defvoo nntp-coding-system-for-read 'binary
-  "*Coding system to read from NNTP.")
-
-(defvoo nntp-coding-system-for-write 'binary
-  "*Coding system to write to NNTP.")
-
-;; Marks
-(defvoo nntp-marks-is-evil nil
-  "*If non-nil, Gnus will never generate and use marks file for nntp groups.
-See `nnml-marks-is-evil' for more information.")
-
-(defvoo nntp-marks-file-name ".marks")
-(defvoo nntp-marks nil)
-(defvar nntp-marks-modtime (gnus-make-hashtable))
-
-(defcustom nntp-marks-directory
-  (nnheader-concat gnus-directory "marks/")
-  "*The directory where marks for nntp groups will be stored."
-  :group 'nntp
-  :type 'directory)
-
 (defcustom nntp-authinfo-file "~/.authinfo"
   ".netrc-like file that holds nntp authinfo passwords."
   :group 'nntp
@@ -1188,43 +1167,6 @@ command whose response triggered the error."
 (deffoo nntp-asynchronous-p ()
   t)
 
-(deffoo nntp-request-set-mark (group actions &optional server)
-  (when (and (not nntp-marks-is-evil)
-            nntp-marks-file-name)
-    (nntp-possibly-create-directory group server)
-    (nntp-open-marks group server)
-    (setq nntp-marks (nnheader-update-marks-actions nntp-marks actions))
-    (nntp-save-marks group server))
-  nil)
-
-(deffoo nntp-request-marks (group info &optional server)
-  (when (and (not nntp-marks-is-evil)
-            nntp-marks-file-name)
-    (nntp-possibly-create-directory group server)
-    (when (nntp-marks-changed-p group server)
-      (nnheader-message 8 "Updating marks for %s..." group)
-      (nntp-open-marks group server)
-      ;; Update info using `nntp-marks'.
-      (mapc (lambda (pred)
-             (unless (memq (cdr pred) gnus-article-unpropagated-mark-lists)
-               (gnus-info-set-marks
-                info
-                (gnus-update-alist-soft
-                 (cdr pred)
-                 (cdr (assq (cdr pred) nntp-marks))
-                 (gnus-info-marks info))
-                t)))
-           gnus-article-mark-lists)
-      (let ((seen (cdr (assq 'read nntp-marks))))
-       (gnus-info-set-read info
-                           (if (and (integerp (car seen))
-                                    (null (cdr seen)))
-                               (list (cons (car seen) (car seen)))
-                             seen)))
-      (nnheader-message 8 "Updating marks for %s...done" group)))
-  nil)
-
-
 
 ;;; Hooky functions.
 
@@ -1354,8 +1296,8 @@ password contained in '~/.nntp-authinfo'."
                   (nntp-kill-buffer ,pbuffer)))))
         (process
          (condition-case err
-             (let ((coding-system-for-read nntp-coding-system-for-read)
-                   (coding-system-for-write nntp-coding-system-for-write)
+             (let ((coding-system-for-read 'binary)
+                   (coding-system-for-write 'binary)
                    (map '((nntp-open-network-stream network)
                           (network-only plain) ; compat
                           (nntp-open-plain-stream plain)
@@ -2164,95 +2106,6 @@ Please refer to the following variables to customize the connection:
        (delete-region (point) (point-max)))
       proc)))
 
-;; Marks handling
-
-(defun nntp-marks-directory (server)
-  (expand-file-name server nntp-marks-directory))
-
-(defvar nntp-server-to-method-cache nil
-  "Alist of servers and select methods.")
-
-(defun nntp-group-pathname (server group &optional file)
-  "Return an absolute file name of FILE for GROUP on SERVER."
-  (let ((method (cdr (assoc server nntp-server-to-method-cache))))
-    (unless method
-      (push (cons server (setq method (or (gnus-server-to-method server)
-                                         (gnus-find-method-for-group group))))
-           nntp-server-to-method-cache))
-    (nnmail-group-pathname
-     (mm-decode-coding-string group
-                             (inline (gnus-group-name-charset method group)))
-     (nntp-marks-directory server)
-     file)))
-
-(defun nntp-possibly-create-directory (group server)
-  (let ((dir (nntp-group-pathname server group))
-       (file-name-coding-system nnmail-pathname-coding-system))
-    (unless (file-exists-p dir)
-      (make-directory (directory-file-name dir) t)
-      (nnheader-message 5 "Creating nntp marks directory %s" dir))))
-
-(autoload 'time-less-p "time-date")
-
-(defun nntp-marks-changed-p (group server)
-  (let ((file (nntp-group-pathname server group nntp-marks-file-name))
-       (file-name-coding-system nnmail-pathname-coding-system))
-    (if (null (gnus-gethash file nntp-marks-modtime))
-       t ;; never looked at marks file, assume it has changed
-      (time-less-p (gnus-gethash file nntp-marks-modtime)
-                  (nth 5 (file-attributes file))))))
-
-(defun nntp-save-marks (group server)
-  (let ((file-name-coding-system nnmail-pathname-coding-system)
-       (file (nntp-group-pathname server group nntp-marks-file-name)))
-    (condition-case err
-       (progn
-         (nntp-possibly-create-directory group server)
-         (with-temp-file file
-           (erase-buffer)
-           (gnus-prin1 nntp-marks)
-           (insert "\n"))
-         (gnus-sethash file
-                       (nth 5 (file-attributes file))
-                       nntp-marks-modtime))
-      (error (or (gnus-yes-or-no-p
-                 (format "Could not write to %s (%s).  Continue? " file err))
-                (error "Cannot write to %s (%s)" file err))))))
-
-(defun nntp-open-marks (group server)
-  (let ((file (nntp-group-pathname server group nntp-marks-file-name))
-       (file-name-coding-system nnmail-pathname-coding-system))
-    (if (file-exists-p file)
-       (condition-case err
-           (with-temp-buffer
-             (gnus-sethash file (nth 5 (file-attributes file))
-                           nntp-marks-modtime)
-             (nnheader-insert-file-contents file)
-             (setq nntp-marks (read (current-buffer)))
-             (dolist (el gnus-article-unpropagated-mark-lists)
-               (setq nntp-marks (gnus-remassoc el nntp-marks))))
-         (error (or (gnus-yes-or-no-p
-                     (format "Error reading nntp marks file %s (%s).  Continuing will use marks from .newsrc.eld.  Continue? " file err))
-                    (error "Cannot read nntp marks file %s (%s)" file err))))
-      ;; User didn't have a .marks file.  Probably first time
-      ;; user of the .marks stuff.  Bootstrap it from .newsrc.eld.
-      (let ((info (gnus-get-info
-                  (gnus-group-prefixed-name
-                   group
-                   (gnus-server-to-method (format "nntp:%s" server)))))
-           (decoded-name (mm-decode-coding-string
-                          group
-                          (gnus-group-name-charset
-                           (gnus-server-to-method server) group))))
-       (nnheader-message 7 "Bootstrapping marks for %s..." decoded-name)
-       (setq nntp-marks (gnus-info-marks info))
-       (push (cons 'read (gnus-info-read info)) nntp-marks)
-       (dolist (el gnus-article-unpropagated-mark-lists)
-         (setq nntp-marks (gnus-remassoc el nntp-marks)))
-       (nntp-save-marks group server)
-       (nnheader-message 7 "Bootstrapping marks for %s...done"
-                         decoded-name)))))
-
 (provide 'nntp)
 
 ;;; nntp.el ends here
index c54fe3e..b2130d5 100644 (file)
 
 (eval-when-compile (require 'cl))
 
-(eval-when-compile
-  (when (null (ignore-errors (require 'ert)))
-    (defmacro* ert-deftest (name () &body docstring-keys-and-body))))
-
-(ignore-errors
-  (require 'ert))
 (eval-and-compile
   (or (ignore-errors (progn
                        (require 'eieio)
@@ -373,111 +367,5 @@ Proposes any entries over the max-hard limit minus size * prune-factor."
                             collect k)))
       (list limit candidates))))
 
-(ert-deftest registry-instantiation-test ()
-  (should (registry-db "Testing")))
-
-(ert-deftest registry-match-test ()
-  (let ((entry '((hello "goodbye" "bye") (blank))))
-
-    (message "Testing :regex matching")
-    (should (registry--match :regex entry '((hello "nye" "bye"))))
-    (should (registry--match :regex entry '((hello "good"))))
-    (should-not (registry--match :regex entry '((hello "nye"))))
-    (should-not (registry--match :regex entry '((hello))))
-
-    (message "Testing :member matching")
-    (should (registry--match :member entry '((hello "bye"))))
-    (should (registry--match :member entry '((hello "goodbye"))))
-    (should-not (registry--match :member entry '((hello "good"))))
-    (should-not (registry--match :member entry '((hello "nye"))))
-    (should-not (registry--match :member entry '((hello)))))
-  (message "Done with matching testing."))
-
-(defun registry-make-testable-db (n &optional name file)
-  (let* ((db (registry-db
-              (or name "Testing")
-              :file (or file "unused")
-              :max-hard n
-              :max-soft 0               ; keep nothing not precious
-              :precious '(extra more-extra)
-              :tracked '(sender subject groups))))
-    (dotimes (i n)
-      (registry-insert db i `((sender "me")
-                              (subject "about you")
-                              (more-extra) ; empty data key should be pruned
-                              ;; first 5 entries will NOT have this extra data
-                              ,@(when (< 5 i) (list (list 'extra "more data")))
-                              (groups ,(number-to-string i)))))
-    db))
-
-(ert-deftest registry-usage-test ()
-  (let* ((n 100)
-         (db (registry-make-testable-db n)))
-    (message "size %d" n)
-    (should (= n (registry-size db)))
-    (message "max-hard test")
-    (should-error (registry-insert db "new" '()))
-    (message "Individual lookup")
-    (should (= 58 (caadr (registry-lookup db '(1 58 99)))))
-    (message "Grouped individual lookup")
-    (should (= 3 (length (registry-lookup db '(1 58 99)))))
-    (when (boundp 'lexical-binding)
-      (message "Individual lookup (breaks before lexbind)")
-      (should (= 58
-                 (caadr (registry-lookup-breaks-before-lexbind db '(1 58 99)))))
-      (message "Grouped individual lookup (breaks before lexbind)")
-      (should (= 3
-                 (length (registry-lookup-breaks-before-lexbind db
-                                                                '(1 58 99))))))
-    (message "Search")
-    (should (= n (length (registry-search db :all t))))
-    (should (= n (length (registry-search db :member '((sender "me"))))))
-    (message "Secondary index search")
-    (should (= n (length (registry-lookup-secondary-value db 'sender "me"))))
-    (should (equal '(74) (registry-lookup-secondary-value db 'groups "74")))
-    (message "Delete")
-    (should (registry-delete db '(1) t))
-    (decf n)
-    (message "Search after delete")
-    (should (= n (length (registry-search db :all t))))
-    (message "Secondary search after delete")
-    (should (= n (length (registry-lookup-secondary-value db 'sender "me"))))
-    ;; (message "Pruning")
-    ;; (let* ((tokeep (registry-search db :member '((extra "more data"))))
-    ;;        (count (- n (length tokeep)))
-    ;;        (pruned (registry-prune db))
-    ;;        (prune-count (length pruned)))
-    ;;   (message "Expecting to prune %d entries and pruned %d"
-    ;;            count prune-count)
-    ;;   (should (and (= count 5)
-    ;;                (= count prune-count))))
-    (message "Done with usage testing.")))
-
-(ert-deftest registry-persistence-test ()
-  (let* ((n 100)
-         (tempfile (make-temp-file "registry-persistence-"))
-         (name "persistence tester")
-         (db (registry-make-testable-db n name tempfile))
-         size back)
-    (message "Saving to %s" tempfile)
-    (eieio-persistent-save db)
-    (setq size (nth 7 (file-attributes tempfile)))
-    (message "Saved to %s: size %d" tempfile size)
-    (should (< 0 size))
-    (with-temp-buffer
-      (insert-file-contents-literally tempfile)
-      (should (looking-at (concat ";; Object "
-                                  name
-                                  "\n;; EIEIO PERSISTENT OBJECT"))))
-    (message "Reading object back")
-    (setq back (eieio-persistent-read tempfile))
-    (should back)
-    (message "Read object back: %d keys, expected %d==%d"
-             (registry-size back) n (registry-size db))
-    (should (= (registry-size back) n))
-    (should (= (registry-size back) (registry-size db)))
-    (delete-file tempfile))
-  (message "Done with persistence testing."))
-
 (provide 'registry)
 ;;; registry.el ends here
index dd0f159..954e974 100644 (file)
@@ -119,6 +119,7 @@ cid: URL as the argument.")
   (let ((map (make-sparse-keymap)))
     (define-key map "a" 'shr-show-alt-text)
     (define-key map "i" 'shr-browse-image)
+    (define-key map "z" 'shr-zoom-image)
     (define-key map "I" 'shr-insert-image)
     (define-key map "u" 'shr-copy-url)
     (define-key map "v" 'shr-browse-url)
@@ -235,6 +236,40 @@ the URL of the image to the kill buffer instead."
                    (list (current-buffer) (1- (point)) (point-marker))
                    t t))))
 
+(defun shr-zoom-image ()
+  "Toggle the image size.
+The size will be rotated between the default size, the original
+size, and full-buffer size."
+  (interactive)
+  (let ((url (get-text-property (point) 'image-url))
+       (size (get-text-property (point) 'image-size))
+       (buffer-read-only nil))
+    (if (not url)
+       (message "No image under point")
+      ;; Delete the old picture.
+      (while (get-text-property (point) 'image-url)
+       (forward-char -1))
+      (forward-char 1)
+      (let ((start (point)))
+       (while (get-text-property (point) 'image-url)
+         (forward-char 1))
+       (forward-char -1)
+       (put-text-property start (point) 'display nil)
+       (when (> (- (point) start) 2)
+         (delete-region start (1- (point)))))
+      (message "Inserting %s..." url)
+      (url-retrieve url 'shr-image-fetched
+                   (list (current-buffer) (1- (point)) (point-marker)
+                         (list (cons 'size
+                                     (cond ((or (eq size 'default)
+                                                (null size))
+                                            'original)
+                                           ((eq size 'original)
+                                            'full)
+                                           ((eq size 'full)
+                                            'default)))))
+                   t))))
+
 ;;; Utility functions.
 
 (defun shr-transform-dom (dom)
@@ -523,7 +558,7 @@ the URL of the image to the kill buffer instead."
                    (expand-file-name (file-name-nondirectory url)
                                      directory)))))
 
-(defun shr-image-fetched (status buffer start end)
+(defun shr-image-fetched (status buffer start end &optional flags)
   (let ((image-buffer (current-buffer)))
     (when (and (buffer-name buffer)
               (not (plist-get status :error)))
@@ -534,30 +569,53 @@ the URL of the image to the kill buffer instead."
          (with-current-buffer buffer
            (save-excursion
              (let ((alt (buffer-substring start end))
+                   (properties (text-properties-at start))
                    (inhibit-read-only t))
                (delete-region start end)
                (goto-char start)
-               (funcall shr-put-image-function data alt)))))))
+               (funcall shr-put-image-function data alt flags)
+               (while properties
+                 (let ((type (pop properties))
+                       (value (pop properties)))
+                   (unless (memq type '(display image-size))
+                     (put-text-property start (point) type value))))))))))
     (kill-buffer image-buffer)))
 
-(defun shr-put-image (data alt)
+(defun shr-put-image (data alt &optional flags)
   "Put image DATA with a string ALT.  Return image."
   (if (display-graphic-p)
-      (let ((image (ignore-errors
-                     (shr-rescale-image data))))
+      (let* ((size (cdr (assq 'size flags)))
+            (start (point))
+            (image (cond
+                    ((eq size 'original)
+                     (create-image data nil t :ascent 100))
+                    ((eq size 'full)
+                     (ignore-errors
+                       (shr-rescale-image data t)))
+                    (t
+                     (ignore-errors
+                       (shr-rescale-image data))))))
         (when image
          ;; When inserting big-ish pictures, put them at the
          ;; beginning of the line.
          (when (and (> (current-column) 0)
                     (> (car (image-size image t)) 400))
            (insert "\n"))
-         (insert-image image (or alt "*"))
+         (if (eq size 'original)
+             (let ((overlays (overlays-at (point))))
+               (insert-sliced-image image (or alt "*") nil 20 1)
+               (dolist (overlay overlays)
+                 (overlay-put overlay 'face 'default)))
+           (insert-image image (or alt "*")))
+         (put-text-property start (point) 'image-size size)
          (when (image-animated-p image)
            (image-animate image nil 60)))
        image)
     (insert alt)))
 
-(defun shr-rescale-image (data)
+(defun shr-rescale-image (data &optional force)
+  "Rescale DATA, if too big, to fit the current buffer.
+If FORCE, rescale the image anyway."
   (let ((image (create-image data nil t :ascent 100)))
     (if (or (not (fboundp 'imagemagick-types))
            (not (get-buffer-window (current-buffer))))
@@ -572,7 +630,8 @@ the URL of the image to the kill buffer instead."
             (window-height (truncate (* shr-max-image-proportion
                                         (- (nth 3 edges) (nth 1 edges)))))
             scaled-image)
-       (when (> height window-height)
+       (when (or force
+                 (> height window-height))
          (setq image (or (create-image data 'imagemagick t
                                        :height window-height
                                        :ascent 100)
diff --git a/lisp/tests/gnustest-registry.el b/lisp/tests/gnustest-registry.el
new file mode 100644 (file)
index 0000000..512fab4
--- /dev/null
@@ -0,0 +1,216 @@
+;;; gnustest-registry.el --- Registry and Gnus registry testing for Gnus
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
+
+;; Author: Ted Zlatanov <tzz@lifelogs.com>
+
+;; This file is not 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
+  (when (null (ignore-errors (require 'ert)))
+    (defmacro* ert-deftest (name () &body docstring-keys-and-body))))
+
+(ignore-errors
+  (require 'ert))
+
+(require 'registry)
+(require 'gnus-registry)
+
+(ert-deftest gnustest-registry-instantiation-test ()
+  (should (registry-db "Testing")))
+
+(ert-deftest gnustest-registry-match-test ()
+  (let ((entry '((hello "goodbye" "bye") (blank))))
+
+    (message "Testing :regex matching")
+    (should (registry--match :regex entry '((hello "nye" "bye"))))
+    (should (registry--match :regex entry '((hello "good"))))
+    (should-not (registry--match :regex entry '((hello "nye"))))
+    (should-not (registry--match :regex entry '((hello))))
+
+    (message "Testing :member matching")
+    (should (registry--match :member entry '((hello "bye"))))
+    (should (registry--match :member entry '((hello "goodbye"))))
+    (should-not (registry--match :member entry '((hello "good"))))
+    (should-not (registry--match :member entry '((hello "nye"))))
+    (should-not (registry--match :member entry '((hello)))))
+  (message "Done with matching testing."))
+
+(defun gnustest-registry-make-testable-db (n &optional name file)
+  (let* ((db (registry-db
+              (or name "Testing")
+              :file (or file "unused")
+              :max-hard n
+              :max-soft 0               ; keep nothing not precious
+              :precious '(extra more-extra)
+              :tracked '(sender subject groups))))
+    (dotimes (i n)
+      (registry-insert db i `((sender "me")
+                              (subject "about you")
+                              (more-extra) ; empty data key should be pruned
+                              ;; first 5 entries will NOT have this extra data
+                              ,@(when (< 5 i) (list (list 'extra "more data")))
+                              (groups ,(number-to-string i)))))
+    db))
+
+(ert-deftest gnustest-registry-usage-test ()
+  (let* ((n 100)
+         (db (gnustest-registry-make-testable-db n)))
+    (message "size %d" n)
+    (should (= n (registry-size db)))
+    (message "max-hard test")
+    (should-error (registry-insert db "new" '()))
+    (message "Individual lookup")
+    (should (= 58 (caadr (registry-lookup db '(1 58 99)))))
+    (message "Grouped individual lookup")
+    (should (= 3 (length (registry-lookup db '(1 58 99)))))
+    (when (boundp 'lexical-binding)
+      (message "Individual lookup (breaks before lexbind)")
+      (should (= 58
+                 (caadr (registry-lookup-breaks-before-lexbind db '(1 58 99)))))
+      (message "Grouped individual lookup (breaks before lexbind)")
+      (should (= 3
+                 (length (registry-lookup-breaks-before-lexbind db
+                                                                '(1 58 99))))))
+    (message "Search")
+    (should (= n (length (registry-search db :all t))))
+    (should (= n (length (registry-search db :member '((sender "me"))))))
+    (message "Secondary index search")
+    (should (= n (length (registry-lookup-secondary-value db 'sender "me"))))
+    (should (equal '(74) (registry-lookup-secondary-value db 'groups "74")))
+    (message "Delete")
+    (should (registry-delete db '(1) t))
+    (decf n)
+    (message "Search after delete")
+    (should (= n (length (registry-search db :all t))))
+    (message "Secondary search after delete")
+    (should (= n (length (registry-lookup-secondary-value db 'sender "me"))))
+    ;; (message "Pruning")
+    ;; (let* ((tokeep (registry-search db :member '((extra "more data"))))
+    ;;        (count (- n (length tokeep)))
+    ;;        (pruned (registry-prune db))
+    ;;        (prune-count (length pruned)))
+    ;;   (message "Expecting to prune %d entries and pruned %d"
+    ;;            count prune-count)
+    ;;   (should (and (= count 5)
+    ;;                (= count prune-count))))
+    (message "Done with usage testing.")))
+
+(ert-deftest gnustest-registry-persistence-test ()
+  (let* ((n 100)
+         (tempfile (make-temp-file "registry-persistence-"))
+         (name "persistence tester")
+         (db (gnustest-registry-make-testable-db n name tempfile))
+         size back)
+    (message "Saving to %s" tempfile)
+    (eieio-persistent-save db)
+    (setq size (nth 7 (file-attributes tempfile)))
+    (message "Saved to %s: size %d" tempfile size)
+    (should (< 0 size))
+    (with-temp-buffer
+      (insert-file-contents-literally tempfile)
+      (should (looking-at (concat ";; Object "
+                                  name
+                                  "\n;; EIEIO PERSISTENT OBJECT"))))
+    (message "Reading object back")
+    (setq back (eieio-persistent-read tempfile))
+    (should back)
+    (message "Read object back: %d keys, expected %d==%d"
+             (registry-size back) n (registry-size db))
+    (should (= (registry-size back) n))
+    (should (= (registry-size back) (registry-size db)))
+    (delete-file tempfile))
+  (message "Done with persistence testing."))
+
+(ert-deftest gnustest-gnus-registry-misc-test ()
+  (should-error (gnus-registry-extract-addresses '("" "")))
+
+  (should (equal '("Ted Zlatanov <tzz@lifelogs.com>"
+                   "noname <ed@you.me>"
+                   "noname <cyd@stupidchicken.com>"
+                   "noname <tzz@lifelogs.com>")
+                 (gnus-registry-extract-addresses
+                  (concat "Ted Zlatanov <tzz@lifelogs.com>, "
+                          "ed <ed@you.me>, " ; "ed" is not a valid name here
+                          "cyd@stupidchicken.com, "
+                          "tzz@lifelogs.com")))))
+
+(ert-deftest gnustest-gnus-registry-usage-test ()
+  (let* ((n 100)
+         (tempfile (make-temp-file "gnus-registry-persist"))
+         (db (gnus-registry-make-db tempfile))
+         (gnus-registry-db db)
+         back size)
+    (message "Adding %d keys to the test Gnus registry" n)
+    (dotimes (i n)
+      (let ((id (number-to-string i)))
+        (gnus-registry-handle-action id
+                                     (if (>= 50 i) "fromgroup" nil)
+                                     "togroup"
+                                     (when (>= 70 i)
+                                       (format "subject %d" (mod i 10)))
+                                     (when (>= 80 i)
+                                       (format "sender %d" (mod i 10))))))
+    (message "Testing Gnus registry size is %d" n)
+    (should (= n (registry-size db)))
+    (message "Looking up individual keys (registry-lookup)")
+    (should (equal (loop for e
+                         in (mapcar 'cadr
+                                    (registry-lookup db '("20" "83" "72")))
+                         collect (assq 'subject e)
+                         collect (assq 'sender e)
+                         collect (assq 'group e))
+                   '((subject "subject 0") (sender "sender 0") (group "togroup")
+                     (subject) (sender) (group "togroup")
+                     (subject) (sender "sender 2") (group "togroup"))))
+
+    (message "Looking up individual keys (gnus-registry-id-key)")
+    (should (equal (gnus-registry-get-id-key "34" 'group) '("togroup")))
+    (should (equal (gnus-registry-get-id-key "34" 'subject) '("subject 4")))
+    (message "Trying to insert a duplicate key")
+    (should-error (gnus-registry-insert db "55" '()))
+    (message "Looking up individual keys (gnus-registry-get-or-make-entry)")
+    (should (gnus-registry-get-or-make-entry "22"))
+    (message "Saving the Gnus registry to %s" tempfile)
+    (should (gnus-registry-save tempfile db))
+    (setq size (nth 7 (file-attributes tempfile)))
+    (message "Saving the Gnus registry to %s: size %d" tempfile size)
+    (should (< 0 size))
+    (with-temp-buffer
+      (insert-file-contents-literally tempfile)
+      (should (looking-at (concat ";; Object "
+                                  "Gnus Registry"
+                                  "\n;; EIEIO PERSISTENT OBJECT"))))
+    (message "Reading Gnus registry back")
+    (setq back (eieio-persistent-read tempfile))
+    (should back)
+    (message "Read Gnus registry back: %d keys, expected %d==%d"
+             (registry-size back) n (registry-size db))
+    (should (= (registry-size back) n))
+    (should (= (registry-size back) (registry-size db)))
+    (delete-file tempfile)
+    (message "Pruning Gnus registry to 0 by setting :max-soft")
+    (oset db :max-soft 0)
+    (registry-prune db)
+    (should (= (registry-size db) 0)))
+  (message "Done with Gnus registry usage testing."))
+
+(provide 'gnustest-registry)
diff --git a/makepub b/makepub
index 4159d0f..58c51cb 100755 (executable)
--- a/makepub
+++ b/makepub
@@ -1,5 +1,5 @@
 #!/bin/bash
-name="No Gnus"
+name="Ma Gnus"
 
 if [ `whoami` != "larsi" ]; then
     echo "This script is for larsi only"
index 69ecc39..c0f7e1f 100644 (file)
@@ -2,16 +2,45 @@
 
        * gnus.texi (Posting Styles): Fix cross-refs to other manual.
 
+2012-02-16  Lars Ingebrigtsen  <larsi@gnus.org>
+
+       * gnus.texi (Various Summary Stuff): Remove mention of
+       `gnus-propagate-marks'.
+
+2012-02-15  Lars Ingebrigtsen  <larsi@gnus.org>
+
+       * gnus.texi: Remove mentions of nnml/nnfolder/nntp backend marks, which
+       no longer exist.
+
 2012-02-13  Lars Ingebrigtsen  <larsi@gnus.org>
 
        * gnus.texi (Customizing the IMAP Connection): Mention
        nnimap-record-commands.
 
+2012-02-08  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+       * gnus.texi (Archived Messages): Document gnus-gcc-self-resent-messages.
+
 2012-02-07  Lars Ingebrigtsen  <larsi@gnus.org>
 
        * gnus.texi (Mail Source Specifiers): Add a pop3 via an SSH tunnel
        example (modified from an example by Michael Albinus).
 
+2012-02-06  Lars Ingebrigtsen  <larsi@gnus.org>
+
+       * message.texi (Mail Variables): Mention the optional user parameter
+       for X-Message-SMTP-Method.
+
+2012-02-02  Lars Ingebrigtsen  <larsi@gnus.org>
+
+       * gnus.texi (Posting Styles): Mention X-Message-SMTP-Method.
+
+       * message.texi (Mail Variables): Document X-Message-SMTP-Method.
+
+2012-01-31  Lars Ingebrigtsen  <larsi@gnus.org>
+
+       * gnus.texi (Key Index): Change encoding to utf-8.
+
 2012-01-30  Philipp Haselwarter  <philipp.haselwarter@gmx.de>  (tiny change)
 
        * gnus.texi (Agent Basics): Fix outdated description of
index 754af15..9194753 100644 (file)
@@ -8,7 +8,7 @@
 @syncodeindex vr cp
 @syncodeindex pg cp
 
-@documentencoding ISO-8859-1
+@documentencoding UTF-8
 
 @copying
 Copyright @copyright{} 1995-2012 Free Software Foundation, Inc.
@@ -47,7 +47,7 @@ developing GNU and promoting software freedom.''
 \begin{document}
 
 % Adjust ../Makefile.in if you change the following line:
-\newcommand{\gnusversionname}{No Gnus v0.20}
+\newcommand{\gnusversionname}{Ma Gnus v0.4}
 \newcommand{\gnuschaptername}{}
 \newcommand{\gnussectionname}{}
 
@@ -358,7 +358,7 @@ spool or your mbox file.  All at the same time, if you want to push your
 luck.
 
 @c Adjust ../Makefile.in if you change the following line:
-This manual corresponds to No Gnus v0.20
+This manual corresponds to Ma Gnus v0.4
 
 @ifnottex
 @insertcopying
@@ -392,7 +392,7 @@ people should be empowered to do what they want by using (or abusing)
 the program.
 
 @c Adjust ../Makefile.in if you change the following line:
-This manual corresponds to No Gnus v0.20
+This manual corresponds to Ma Gnus v0.4
 
 @heading Other related manuals
 @itemize
@@ -663,7 +663,6 @@ Getting News
 * Direct Functions::            Connecting directly to the server.
 * Indirect Functions::          Connecting indirectly to the server.
 * Common Variables::            Understood by several connection functions.
-* NNTP marks::                  Storing marks for @acronym{NNTP} servers.
 
 Getting Mail
 
@@ -907,7 +906,8 @@ New Features
 * Quassia Gnus::                Two times two is four, or Gnus 5.6/5.7.
 * Pterodactyl Gnus::            Pentad also starts with P, AKA Gnus 5.8/5.9.
 * Oort Gnus::                   It's big.  It's far out.  Gnus 5.10/5.11.
-* No Gnus::                     Very punny.
+* No Gnus::                     Very punny.  Gnus 5.12/5.13
+* Ma Gnus::                     Celebrating 25 years of Gnus.
 
 Customization
 
@@ -1066,10 +1066,6 @@ you would typically set this variable to
 (setq gnus-secondary-select-methods '((nnmbox "")))
 @end lisp
 
-Note: the @acronym{NNTP} back end stores marks in marks files
-(@pxref{NNTP marks}).  This feature makes it easy to share marks between
-several Gnus installations, but may slow down things a bit when fetching
-new articles.  @xref{NNTP marks}, for more information.
 
 
 @node The Server is Down
@@ -2884,7 +2880,7 @@ composed messages will be @code{Gcc}'d to the current group.  If
 generated, if @code{(gcc-self . "string")} is present, this string will
 be inserted literally as a @code{gcc} header.  This parameter takes
 precedence over any default @code{Gcc} rules as described later
-(@pxref{Archived Messages}).
+(@pxref{Archived Messages}), with the exception for messages to resend.
 
 @strong{Caveat}: Adding @code{(gcc-self . t)} to the parameter list of
 @code{nntp} groups (or the like) isn't valid.  An @code{nntp} server
@@ -3027,6 +3023,7 @@ like this in the group parameters:
 @example
 (posting-style
   (name "Funky Name")
+  ("X-Message-SMTP-Method" "smtp smtp.example.org 587")
   ("X-My-Header" "Funky Value")
   (signature "Funky Signature"))
 @end example
@@ -4293,12 +4290,11 @@ default is @code{nil} in Emacs, or is the aliasee of the coding system
 named @code{file-name} (a certain coding system of which an alias is
 @code{file-name}) in XEmacs.
 
-The @code{nnml} back end, the @code{nnrss} back end, the @acronym{NNTP}
-marks feature (@pxref{NNTP marks}), the agent, and the cache use
-non-@acronym{ASCII} group names in those files and directories.  This
-variable overrides the value of @code{file-name-coding-system} which
-specifies the coding system used when encoding and decoding those file
-names and directory names.
+The @code{nnml} back end, the @code{nnrss} back end, the agent, and
+the cache use non-@acronym{ASCII} group names in those files and
+directories.  This variable overrides the value of
+@code{file-name-coding-system} which specifies the coding system used
+when encoding and decoding those file names and directory names.
 
 In XEmacs (with the @code{mule} feature), @code{file-name-coding-system}
 is the only means to specify the coding system used to encode and decode
@@ -8981,7 +8977,7 @@ Translate many non-@acronym{ASCII} characters into their
 @acronym{ASCII} equivalents (@code{gnus-article-treat-non-ascii}).
 This is mostly useful if you're on a terminal that has a limited font
 and doesn't show accented characters, ``advanced'' punctuation, and the
-like.  For instance, @samp{»} is translated into @samp{>>}, and so on.
+like.  For instance, @samp{Ã\82»} is translated into @samp{>>}, and so on.
 
 @item W Y f
 @kindex W Y f (Summary)
@@ -10814,12 +10810,6 @@ buffers.  For example:
 
 Also @pxref{Group Parameters}.
 
-@vindex gnus-propagate-marks
-@item gnus-propagate-marks
-If non-@code{nil}, propagate marks to the backends for possible
-storing.  @xref{NNTP marks}, and friends, for a more fine-grained
-sieve.
-
 @end table
 
 
@@ -12669,6 +12659,22 @@ and matches the Gcc group name, attach files as external parts; if it is
 non-@code{nil}, the behavior is the same as @code{all}, but it may be
 changed in the future.
 
+@item gnus-gcc-self-resent-messages
+@vindex gnus-gcc-self-resent-messages
+Like the @code{gcc-self} group parameter, applied only for unmodified
+messages that @code{gnus-summary-resend-message} (@pxref{Summary Mail
+Commands}) resends.  Non-@code{nil} value of this variable takes
+precedence over any existing @code{Gcc} header.
+
+If this is @code{none}, no @code{Gcc} copy will be made.  If this is
+@code{t}, messages resent will be @code{Gcc} copied to the current
+group.  If this is a string, it specifies a group to which resent
+messages will be @code{Gcc} copied.  If this is @code{nil}, @code{Gcc}
+will be done according to existing @code{Gcc} header(s), if any.  If
+this is @code{no-gcc-self}, that is the default, resent messages will be
+@code{Gcc} copied to groups that existing @code{Gcc} header specifies,
+except for the current group.
+
 @end table
 
 
@@ -12800,6 +12806,7 @@ So here's a new example:
          (signature-file "~/.work-signature")
          (address "user@@bar.foo")
          (body "You are fired.\n\nSincerely, your boss.")
+         ("X-Message-SMTP-Method" "smtp smtp.example.org 587")
          (organization "Important Work, Inc"))
         ("nnml:.*"
          (From (with-current-buffer gnus-article-buffer
@@ -12814,6 +12821,13 @@ if you fill many roles.
 You may also use @code{message-alternative-emails} instead.
 @xref{Message Headers, ,Message Headers, message, Message Manual}.
 
+Of particular interest in the ``work-mail'' style is the
+@samp{X-Message-SMTP-Method} header.  It specifies how to send the
+outgoing email.  You may want to sent certain emails through certain
+@acronym{SMTP} servers due to company policies, for instance.
+@xref{Mail Variables, ,Message Variables, message, Message Manual}.
+
+
 @node Drafts
 @section Drafts
 @cindex drafts
@@ -13739,7 +13753,6 @@ don't update their active files often, this can help.
 * Direct Functions::            Connecting directly to the server.
 * Indirect Functions::          Connecting indirectly to the server.
 * Common Variables::            Understood by several connection functions.
-* NNTP marks::                  Storing marks for @acronym{NNTP} servers.
 @end menu
 
 
@@ -14010,53 +14023,6 @@ is @samp{()}.
 
 @end table
 
-@node NNTP marks
-@subsubsection NNTP marks
-@cindex storing NNTP marks
-
-Gnus stores marks (@pxref{Marking Articles}) for @acronym{NNTP}
-servers in marks files.  A marks file records what marks you have set
-in a group and each file is specific to the corresponding server.
-Marks files are stored in @file{~/News/marks}
-(@code{nntp-marks-directory}) under a classic hierarchy resembling
-that of a news server, for example marks for the group
-@samp{gmane.discuss} on the news.gmane.org server will be stored in
-the file @file{~/News/marks/news.gmane.org/gmane/discuss/.marks}.
-
-Marks files are useful because you can copy the @file{~/News/marks}
-directory (using rsync, scp or whatever) to another Gnus installation,
-and it will realize what articles you have read and marked.  The data
-in @file{~/News/marks} has priority over the same data in
-@file{~/.newsrc.eld}.
-
-Note that marks files are very much server-specific: Gnus remembers
-the article numbers so if you don't use the same servers on both
-installations things are most likely to break (most @acronym{NNTP}
-servers do not use the same article numbers as any other server).
-However, if you use servers A, B, C on one installation and servers A,
-D, E on the other, you can sync the marks files for A and then you'll
-get synchronization for that server between the two installations.
-
-Using @acronym{NNTP} marks can possibly incur a performance penalty so
-if Gnus feels sluggish, try setting the @code{nntp-marks-is-evil}
-variable to @code{t}.  Marks will then be stored in @file{~/.newsrc.eld}.
-
-Related variables:
-
-@table @code
-
-@item nntp-marks-is-evil
-@vindex nntp-marks-is-evil
-If non-@code{nil}, this back end will ignore any marks files.  The
-default is @code{nil}.
-
-@item nntp-marks-directory
-@vindex nntp-marks-directory
-The directory where marks for nntp groups will be stored.
-
-@end table
-
-
 @node News Spool
 @subsection News Spool
 @cindex nnspool
@@ -16147,22 +16113,6 @@ splitting.  It has to create lots of files, and it also generates
 @acronym{NOV} databases for the incoming mails.  This makes it possibly the
 fastest back end when it comes to reading mail.
 
-@cindex self contained nnml servers
-@cindex marks
-When the marks file is used (which it is by default), @code{nnml}
-servers have the property that you may backup them using @code{tar} or
-similar, and later be able to restore them into Gnus (by adding the
-proper @code{nnml} server) and have all your marks be preserved.  Marks
-for a group are usually stored in the @code{.marks} file (but see
-@code{nnml-marks-file-name}) within each @code{nnml} group's directory.
-Individual @code{nnml} groups are also possible to backup, use @kbd{G m}
-to restore the group (after restoring the backup into the nnml
-directory).
-
-If for some reason you believe your @file{.marks} files are screwed
-up, you can just delete them all.  Gnus will then correctly regenerate
-them next time it starts.
-
 Virtual server settings:
 
 @table @code
@@ -16200,15 +16150,6 @@ The name of the @acronym{NOV} files.  The default is @file{.overview}.
 @vindex nnml-prepare-save-mail-hook
 Hook run narrowed to an article before saving.
 
-@item nnml-marks-is-evil
-@vindex nnml-marks-is-evil
-If non-@code{nil}, this back end will ignore any @sc{marks} files.  The
-default is @code{nil}.
-
-@item nnml-marks-file-name
-@vindex nnml-marks-file-name
-The name of the @dfn{marks} files.  The default is @file{.marks}.
-
 @item nnml-use-compressed-files
 @vindex nnml-use-compressed-files
 If non-@code{nil}, @code{nnml} will allow using compressed message
@@ -16549,19 +16490,6 @@ separate file.  Each file is in the standard Un*x mbox format.
 @code{nnfolder} will add extra headers to keep track of article
 numbers and arrival dates.
 
-@cindex self contained nnfolder servers
-@cindex marks
-When the marks file is used (which it is by default), @code{nnfolder}
-servers have the property that you may backup them using @code{tar} or
-similar, and later be able to restore them into Gnus (by adding the
-proper @code{nnfolder} server) and have all your marks be preserved.
-Marks for a group are usually stored in a file named as the mbox file
-with @code{.mrk} concatenated to it (but see
-@code{nnfolder-marks-file-suffix}) within the @code{nnfolder}
-directory.  Individual @code{nnfolder} groups are also possible to
-backup, use @kbd{G m} to restore the group (after restoring the backup
-into the @code{nnfolder} directory).
-
 Virtual server settings:
 
 @table @code
@@ -16620,20 +16548,6 @@ The extension for @acronym{NOV} files.  The default is @file{.nov}.
 The directory where the @acronym{NOV} files should be stored.  If
 @code{nil}, @code{nnfolder-directory} is used.
 
-@item nnfolder-marks-is-evil
-@vindex nnfolder-marks-is-evil
-If non-@code{nil}, this back end will ignore any @sc{marks} files.  The
-default is @code{nil}.
-
-@item nnfolder-marks-file-suffix
-@vindex nnfolder-marks-file-suffix
-The extension for @sc{marks} files.  The default is @file{.mrk}.
-
-@item nnfolder-marks-directory
-@vindex nnfolder-marks-directory
-The directory where the @sc{marks} files should be stored.  If
-@code{nil}, @code{nnfolder-directory} is used.
-
 @end table
 
 
@@ -16794,9 +16708,7 @@ undergo treatment such as duplicate checking.
 @code{nnmaildir} stores article marks for a given group in the
 corresponding maildir, in a way designed so that it's easy to manipulate
 them from outside Gnus.  You can tar up a maildir, unpack it somewhere
-else, and still have your marks.  @code{nnml} also stores marks, but
-it's not as easy to work with them from outside Gnus as with
-@code{nnmaildir}.
+else, and still have your marks.
 
 @code{nnmaildir} uses a significant amount of memory to speed things up.
 (It keeps in memory some of the things that @code{nnml} stores in files
@@ -16888,16 +16800,6 @@ adding a server definition pointing to that directory in Gnus.  The
 might interfere with overwriting data, so you may want to shut down Gnus
 before you restore the data.
 
-It is also possible to archive individual @code{nnml},
-@code{nnfolder}, or @code{nnmaildir} groups, while preserving marks.
-For @code{nnml} or @code{nnmaildir}, you copy all files in the group's
-directory.  For @code{nnfolder} you need to copy both the base folder
-file itself (@file{FOO}, say), and the marks file (@file{FOO.mrk} in
-this example).  Restoring the group is done with @kbd{G m} from the Group
-buffer.  The last step makes Gnus notice the new directory.
-@code{nnmaildir} notices the new directory automatically, so @kbd{G m}
-is unnecessary in that case.
-
 @node Web Searches
 @subsection Web Searches
 @cindex nnweb
@@ -20870,7 +20772,7 @@ then this operator will return @code{false}.
 
 @item !
 @itemx not
-@itemx ¬
+@itemx Ã\82¬
 This logical operator only takes a single argument.  It returns the
 logical negation of the value of its argument.
 
@@ -22510,7 +22412,7 @@ and so on.  Create as many faces as you wish.  The same goes for the
 @samp{hello} mouse-highlighted with @code{gnus-mouse-face-3}.
 
 @cindex %<<, %>>, guillemets
-@c @cindex %<<, %>>, %«, %», guillemets
+@c @cindex %<<, %>>, %Ã\82«, %Ã\82», guillemets
 @vindex gnus-balloon-face-0
 Text inside the @samp{%<<} and @samp{%>>} specifiers will get the
 special @code{balloon-help} property set to
@@ -26404,6 +26306,7 @@ renamed it back again to ``Gnus''.  But in mixed case.  ``Gnus'' vs.
 @cindex Pterodactyl Gnus
 @cindex Oort Gnus
 @cindex No Gnus
+@cindex Ma Gnus
 @cindex Gnus versions
 
 The first ``proper'' release of Gnus 5 was done in November 1995 when it
@@ -26432,12 +26335,15 @@ On April 19, 2010 Gnus development was moved to Git.  See
 http://git.gnus.org for details (http://www.gnus.org will be updated
 with the information when possible).
 
+On the January 31th 2012, Ma Gnus was begun.
+
 If you happen upon a version of Gnus that has a prefixed name --
 ``(ding) Gnus'', ``September Gnus'', ``Red Gnus'', ``Quassia Gnus'',
-``Pterodactyl Gnus'', ``Oort Gnus'', ``No Gnus'' -- don't panic.
-Don't let it know that you're frightened.  Back away.  Slowly.  Whatever
-you do, don't run.  Walk away, calmly, until you're out of its reach.
-Find a proper released version of Gnus and snuggle up to that instead.
+``Pterodactyl Gnus'', ``Oort Gnus'', ``No Gnus'', ``Ma Gnus'' -- don't
+panic.  Don't let it know that you're frightened.  Back away.  Slowly.
+Whatever you do, don't run.  Walk away, calmly, until you're out of
+its reach.  Find a proper released version of Gnus and snuggle up to
+that instead.
 
 
 @node Why?
@@ -27040,7 +26946,8 @@ actually are people who are using Gnus.  Who'd'a thunk it!
 * Quassia Gnus::                Two times two is four, or Gnus 5.6/5.7.
 * Pterodactyl Gnus::            Pentad also starts with P, AKA Gnus 5.8/5.9.
 * Oort Gnus::                   It's big.  It's far out.  Gnus 5.10/5.11.
-* No Gnus::                     Very punny.
+* No Gnus::                     Very punny.  Gnus 5.12/5.13.
+* Ma Gnus::                     Celebrating 25 years of Gnus.
 @end menu
 
 These lists are, of course, just @emph{short} overviews of the
@@ -28415,6 +28322,13 @@ New features in No Gnus:
 
 @include gnus-news.texi
 
+@node Ma Gnus
+@subsubsection Ma Gnus
+@cindex Ma Gnus
+
+I'm sure there will be lots of text here.  It's really spelled 真
+Gnus.
+
 @iftex
 
 @page
@@ -28918,7 +28832,7 @@ Gnus will work.
 @item
 Try doing an @kbd{M-x gnus-version}.  If you get something that looks
 like @c
-@samp{No Gnus v0.20} @c Adjust ../Makefile.in if you change this line!
+@samp{Ma Gnus v0.4} @c Adjust ../Makefile.in if you change this line!
 @c
 you have the right files loaded.  Otherwise you have some old @file{.el}
 files lying around.  Delete these.
@@ -30637,5 +30551,5 @@ former).  The manual is unambiguous, but it can be confusing.
 
 @c Local Variables:
 @c mode: texinfo
-@c coding: iso-8859-1
+@c coding: utf-8
 @c End:
index bc5efe1..cdffb04 100644 (file)
@@ -77,7 +77,7 @@ Message mode buffers.
 @c Adjust ../Makefile.in if you change the following lines:
 Message is distributed with Gnus.  The Gnus distribution
 @c
-corresponding to this manual is No Gnus v0.20
+corresponding to this manual is Ma Gnus v0.4
 
 
 @node Interface
@@ -1641,6 +1641,40 @@ To the thing similar to this, there is
 requires the @acronym{POP}-before-@acronym{SMTP} authentication.
 @xref{POP before SMTP, , POP before SMTP, gnus, The Gnus Manual}.
 
+@cindex X-Message-SMTP-Method
+If you have a complex @acronym{SMTP} setup, and want some messages to
+go via one mail server, and other messages to go through another, you
+can use the @samp{X-Message-SMTP-Method} header.  These are the
+supported values:
+
+@table @samp
+@item smtpmail
+
+@example
+X-Message-SMTP-Method: smtp smtp.fsf.org 587
+@end example
+
+This will send the message via @samp{smtp.fsf.org}, using port 587.
+
+@example
+X-Message-SMTP-Method: smtp smtp.fsf.org 587 other-user
+@end example
+
+This is the same as the above, but uses @samp{other-user} as the user
+name when authenticating.  This is handy if you have several
+@acronym{SMTP} accounts on the same server.
+
+@item sendmail
+
+@example
+X-Message-SMTP-Method: sendmail
+@end example
+
+This will send the message via the locally installed sendmail/exim/etc
+installation.
+
+@end table
+
 @item message-mh-deletable-headers
 @vindex message-mh-deletable-headers
 Most versions of MH doesn't like being fed messages that contain the